diff options
Diffstat (limited to 'Remote')
-rw-r--r-- | Remote/Bup.hs | 4 | ||||
-rw-r--r-- | Remote/Ddar.hs | 4 | ||||
-rw-r--r-- | Remote/Directory.hs | 4 | ||||
-rw-r--r-- | Remote/External.hs | 4 | ||||
-rw-r--r-- | Remote/GCrypt.hs | 4 | ||||
-rw-r--r-- | Remote/Git.hs | 11 | ||||
-rw-r--r-- | Remote/Glacier.hs | 12 | ||||
-rw-r--r-- | Remote/Hook.hs | 4 | ||||
-rw-r--r-- | Remote/Rsync.hs | 4 | ||||
-rw-r--r-- | Remote/S3.hs | 12 | ||||
-rw-r--r-- | Remote/Tahoe.hs | 4 | ||||
-rw-r--r-- | Remote/WebDAV.hs | 4 |
12 files changed, 37 insertions, 34 deletions
diff --git a/Remote/Bup.hs b/Remote/Bup.hs index 75b379558..9bdb22edd 100644 --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -90,8 +90,8 @@ gen r u c gc = do { chunkConfig = NoChunks } -bupSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) -bupSetup mu _ c gc = do +bupSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) +bupSetup _ mu _ c gc = do u <- maybe (liftIO genUUID) return mu -- verify configuration is sane diff --git a/Remote/Ddar.hs b/Remote/Ddar.hs index dcb16f5dd..603eccd5e 100644 --- a/Remote/Ddar.hs +++ b/Remote/Ddar.hs @@ -82,8 +82,8 @@ gen r u c gc = do { chunkConfig = NoChunks } -ddarSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) -ddarSetup mu _ c gc = do +ddarSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) +ddarSetup _ mu _ c gc = do u <- maybe (liftIO genUUID) return mu -- verify configuration is sane diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 248e5d49f..2452c42e2 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -77,8 +77,8 @@ gen r u c gc = do where dir = fromMaybe (giveup "missing directory") $ remoteAnnexDirectory gc -directorySetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) -directorySetup mu _ c gc = do +directorySetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) +directorySetup _ mu _ c gc = do u <- maybe (liftIO genUUID) return mu -- verify configuration is sane let dir = fromMaybe (giveup "Specify directory=") $ diff --git a/Remote/External.hs b/Remote/External.hs index 7091a657c..b66e102a4 100644 --- a/Remote/External.hs +++ b/Remote/External.hs @@ -109,8 +109,8 @@ gen r u c gc rmt externaltype = fromMaybe (giveup "missing externaltype") (remoteAnnexExternalType gc) -externalSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) -externalSetup mu _ c gc = do +externalSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) +externalSetup _ mu _ c gc = do u <- maybe (liftIO genUUID) return mu let externaltype = fromMaybe (giveup "Specify externaltype=") $ M.lookup "externaltype" c diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs index 78ab6ed79..78b1eed3c 100644 --- a/Remote/GCrypt.hs +++ b/Remote/GCrypt.hs @@ -169,8 +169,8 @@ noCrypto = giveup "cannot use gcrypt remote without encryption enabled" unsupportedUrl :: a unsupportedUrl = giveup "using non-ssh remote repo url with gcrypt is not supported" -gCryptSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) -gCryptSetup mu _ c gc = go $ M.lookup "gitrepo" c +gCryptSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) +gCryptSetup _ mu _ c gc = go $ M.lookup "gitrepo" c where remotename = fromJust (M.lookup "name" c) go Nothing = giveup "Specify gitrepo=" diff --git a/Remote/Git.hs b/Remote/Git.hs index 5eb6fbc9e..a0b590654 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -96,8 +96,8 @@ list autoinit = do - No attempt is made to make the remote be accessible via ssh key setup, - etc. -} -gitSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) -gitSetup Nothing _ c _ = do +gitSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) +gitSetup Init mu _ c _ = do let location = fromMaybe (giveup "Specify location=url") $ Url.parseURIRelaxed =<< M.lookup "location" c g <- Annex.gitRepo @@ -105,8 +105,10 @@ gitSetup Nothing _ c _ = do [r] -> getRepoUUID r [] -> giveup "could not find existing git remote with specified location" _ -> giveup "found multiple git remotes with specified location" - return (c, u) -gitSetup (Just u) _ c _ = do + if isNothing mu || mu == Just u + then return (c, u) + else error "git remote did not have specified uuid" +gitSetup Enable (Just u) _ c _ = do inRepo $ Git.Command.run [ Param "remote" , Param "add" @@ -114,6 +116,7 @@ gitSetup (Just u) _ c _ = do , Param $ fromMaybe (giveup "no location") (M.lookup "location" c) ] return (c, u) +gitSetup Enable Nothing _ _ _ = error "unable to enable git remote with no specified uuid" {- It's assumed to be cheap to read the config of non-URL remotes, so this is - done each time git-annex is run in a way that uses remotes. diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs index 77a907b97..c2f9bcf12 100644 --- a/Remote/Glacier.hs +++ b/Remote/Glacier.hs @@ -78,16 +78,16 @@ gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost { chunkConfig = NoChunks } -glacierSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) -glacierSetup mu mcreds c gc = do +glacierSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) +glacierSetup ss mu mcreds c gc = do u <- maybe (liftIO genUUID) return mu - glacierSetup' (isJust mu) u mcreds c gc -glacierSetup' :: Bool -> UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) -glacierSetup' enabling u mcreds c gc = do + glacierSetup' ss u mcreds c gc +glacierSetup' :: SetupStage -> UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) +glacierSetup' ss u mcreds c gc = do (c', encsetup) <- encryptionSetup c gc c'' <- setRemoteCredPair encsetup c' gc (AWS.creds u) mcreds let fullconfig = c'' `M.union` defaults - unless enabling $ + when (ss == Init) $ genVault fullconfig gc u gitConfigSpecialRemote u fullconfig "glacier" "true" return (fullconfig, u) diff --git a/Remote/Hook.hs b/Remote/Hook.hs index 6abffe117..0ebbf9139 100644 --- a/Remote/Hook.hs +++ b/Remote/Hook.hs @@ -70,8 +70,8 @@ gen r u c gc = do where hooktype = fromMaybe (giveup "missing hooktype") $ remoteAnnexHookType gc -hookSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) -hookSetup mu _ c gc = do +hookSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) +hookSetup _ mu _ c gc = do u <- maybe (liftIO genUUID) return mu let hooktype = fromMaybe (giveup "Specify hooktype=") $ M.lookup "hooktype" c diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index 22ef0b2cf..dbaf2acc9 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -137,8 +137,8 @@ rsyncTransport gc url loginopt = maybe [] (\l -> ["-l",l]) login fromNull as xs = if null xs then as else xs -rsyncSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) -rsyncSetup mu _ c gc = do +rsyncSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) +rsyncSetup _ mu _ c gc = do u <- maybe (liftIO genUUID) return mu -- verify configuration is sane let url = fromMaybe (giveup "Specify rsyncurl=") $ diff --git a/Remote/S3.hs b/Remote/S3.hs index 43d07230e..341b66d1a 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -106,12 +106,12 @@ gen r u c gc = do , checkUrl = Nothing } -s3Setup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) -s3Setup mu mcreds c gc = do +s3Setup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) +s3Setup ss mu mcreds c gc = do u <- maybe (liftIO genUUID) return mu - s3Setup' (isNothing mu) u mcreds c gc -s3Setup' :: Bool -> UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) -s3Setup' new u mcreds c gc + s3Setup' ss u mcreds c gc +s3Setup' :: SetupStage -> UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) +s3Setup' ss u mcreds c gc | configIA c = archiveorg | otherwise = defaulthost where @@ -133,7 +133,7 @@ s3Setup' new u mcreds c gc (c', encsetup) <- encryptionSetup c gc c'' <- setRemoteCredPair encsetup c' gc (AWS.creds u) mcreds let fullconfig = c'' `M.union` defaults - when new $ + when (ss == Init) $ genBucket fullconfig gc u use fullconfig diff --git a/Remote/Tahoe.hs b/Remote/Tahoe.hs index c29cfb438..e4686f2f2 100644 --- a/Remote/Tahoe.hs +++ b/Remote/Tahoe.hs @@ -91,8 +91,8 @@ gen r u c gc = do , checkUrl = Nothing } -tahoeSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) -tahoeSetup mu _ c _ = do +tahoeSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) +tahoeSetup _ mu _ c _ = do furl <- fromMaybe (fromMaybe missingfurl $ M.lookup furlk c) <$> liftIO (getEnv "TAHOE_FURL") u <- maybe (liftIO genUUID) return mu diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs index 14947f1e9..2c4d24c35 100644 --- a/Remote/WebDAV.hs +++ b/Remote/WebDAV.hs @@ -86,8 +86,8 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost } chunkconfig = getChunkConfig c -webdavSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) -webdavSetup mu mcreds c gc = do +webdavSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) +webdavSetup _ mu mcreds c gc = do u <- maybe (liftIO genUUID) return mu url <- case M.lookup "url" c of Nothing -> giveup "Specify url=" |