1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
|
{- git-annex command
-
- Copyright 2024 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
module Command.ExtendCluster where
import Command
import qualified Annex
import Types.Cluster
import Config
import Types.GitConfig
import qualified Remote
import qualified Command.UpdateCluster
import qualified Data.Map as M
cmd :: Command
cmd = command "extendcluster" SectionSetup "add an gateway to a cluster"
(paramPair paramRemote paramName) (withParams seek)
seek :: CmdParams -> CommandSeek
seek (remotename:clustername:[]) = Remote.byName (Just clusterremotename) >>= \case
Just clusterremote -> Remote.byName (Just remotename) >>= \case
Just gatewayremote ->
case mkClusterUUID (Remote.uuid clusterremote) of
Just cu -> do
commandAction $ start cu clustername gatewayremote
Command.UpdateCluster.seek []
Nothing -> giveup $ clusterremotename
++ " is not a cluster remote."
Nothing -> giveup $ "No remote named " ++ remotename ++ " exists."
Nothing -> giveup $ "Expected to find a cluster remote named "
++ clusterremotename
++ " that is accessed via " ++ remotename
++ ", but there is no such remote. Perhaps you need to"
++ "git fetch from " ++ remotename
++ ", or git-annex updatecluster needs to be run there?"
where
clusterremotename = remotename ++ "-" ++ clustername
seek _ = giveup "Expected two parameters, gateway and clustername."
start :: ClusterUUID -> String -> Remote -> CommandStart
start cu clustername gatewayremote = starting "extendcluster" ai si $ do
myclusters <- annexClusters <$> Annex.getGitConfig
let setcus f = setConfig f (fromUUID (fromClusterUUID cu))
unless (M.member clustername myclusters) $ do
setcus $ annexConfig ("cluster." <> encodeBS clustername)
setcus $ mkRemoteConfigKey gatewayremote $
remoteGitConfigKey ClusterGatewayField
next $ return True
where
ai = ActionItemOther (Just (UnquotedString clustername))
si = SeekInput [clustername]
|
