diff options
author | 2013-01-01 13:52:47 -0400 | |
---|---|---|
committer | 2013-01-01 13:58:14 -0400 | |
commit | 18a3a186e9cdb69ee503d961d8285a341d818c48 (patch) | |
tree | d415a97f6c65e2268c948c6c2425d1b94b16df92 /Remote | |
parent | b6e3e7516dfdc054b9e1a281b2e49b392d235ee2 (diff) |
type based git config handling for remotes
Still a couple of places that use git config ad-hoc, but this is most of it
done.
Diffstat (limited to 'Remote')
-rw-r--r-- | Remote/Bup.hs | 63 | ||||
-rw-r--r-- | Remote/Directory.hs | 10 | ||||
-rw-r--r-- | Remote/Git.hs | 124 | ||||
-rw-r--r-- | Remote/Glacier.hs | 5 | ||||
-rw-r--r-- | Remote/Helper/Hooks.hs | 14 | ||||
-rw-r--r-- | Remote/Helper/Ssh.hs | 6 | ||||
-rw-r--r-- | Remote/Hook.hs | 10 | ||||
-rw-r--r-- | Remote/List.hs | 9 | ||||
-rw-r--r-- | Remote/Rsync.hs | 26 | ||||
-rw-r--r-- | Remote/S3.hs | 5 | ||||
-rw-r--r-- | Remote/Web.hs | 5 | ||||
-rw-r--r-- | Remote/WebDAV.hs | 5 |
12 files changed, 147 insertions, 135 deletions
diff --git a/Remote/Bup.hs b/Remote/Bup.hs index e14185017..2f71e516d 100644 --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -38,35 +38,41 @@ remote = RemoteType { setup = bupSetup } -gen :: Git.Repo -> UUID -> RemoteConfig -> Annex Remote -gen r u c = do - buprepo <- getRemoteConfig r "buprepo" (error "missing buprepo") - cst <- remoteCost r (if bupLocal buprepo then semiCheapRemoteCost else expensiveRemoteCost) +gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote +gen r u c gc = do bupr <- liftIO $ bup2GitRemote buprepo + cst <- remoteCost gc $ + if bupLocal buprepo + then semiCheapRemoteCost + else expensiveRemoteCost (u', bupr') <- getBupUUID bupr u + let new = Remote + { uuid = u' + , cost = cst + , name = Git.repoDescribe r + , storeKey = store new buprepo + , retrieveKeyFile = retrieve buprepo + , retrieveKeyFileCheap = retrieveCheap buprepo + , removeKey = remove + , hasKey = checkPresent r bupr' + , hasKeyCheap = bupLocal buprepo + , whereisKey = Nothing + , config = c + , repo = r + , gitconfig = gc + , localpath = if bupLocal buprepo && not (null buprepo) + then Just buprepo + else Nothing + , remotetype = remote + , readonly = False + } return $ encryptableRemote c - (storeEncrypted r buprepo) + (storeEncrypted new buprepo) (retrieveEncrypted buprepo) - Remote - { uuid = u' - , cost = cst - , name = Git.repoDescribe r - , storeKey = store r buprepo - , retrieveKeyFile = retrieve buprepo - , retrieveKeyFileCheap = retrieveCheap buprepo - , removeKey = remove - , hasKey = checkPresent r bupr' - , hasKeyCheap = bupLocal buprepo - , whereisKey = Nothing - , config = c - , repo = r - , localpath = if bupLocal buprepo && not (null buprepo) - then Just buprepo - else Nothing - , remotetype = remote - , readonly = False - } + new + where + buprepo = fromMaybe (error "missing buprepo") $ remoteAnnexBupRepo gc bupSetup :: UUID -> RemoteConfig -> Annex RemoteConfig bupSetup u c = do @@ -106,21 +112,20 @@ pipeBup params inh outh = do ExitSuccess -> return True _ -> return False -bupSplitParams :: Git.Repo -> BupRepo -> Key -> [CommandParam] -> Annex [CommandParam] +bupSplitParams :: Remote -> BupRepo -> Key -> [CommandParam] -> Annex [CommandParam] bupSplitParams r buprepo k src = do - o <- getRemoteConfig r "bup-split-options" "" - let os = map Param $ words o + let os = map Param $ remoteAnnexBupSplitOptions $ gitconfig r showOutput -- make way for bup output return $ bupParams "split" buprepo (os ++ [Param "-n", Param (bupRef k)] ++ src) -store :: Git.Repo -> BupRepo -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool +store :: Remote -> BupRepo -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool store r buprepo k _f _p = do src <- inRepo $ gitAnnexLocation k params <- bupSplitParams r buprepo k [File src] liftIO $ boolSystem "bup" params -storeEncrypted :: Git.Repo -> BupRepo -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool +storeEncrypted :: Remote -> BupRepo -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool storeEncrypted r buprepo (cipher, enck) k _p = do src <- inRepo $ gitAnnexLocation k params <- bupSplitParams r buprepo enck [] diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 946df6111..12875770f 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -33,10 +33,9 @@ remote = RemoteType { setup = directorySetup } -gen :: Git.Repo -> UUID -> RemoteConfig -> Annex Remote -gen r u c = do - dir <- getRemoteConfig r "directory" (error "missing directory") - cst <- remoteCost r cheapRemoteCost +gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote +gen r u c gc = do + cst <- remoteCost gc cheapRemoteCost let chunksize = chunkSize c return $ encryptableRemote c (storeEncrypted dir chunksize) @@ -54,10 +53,13 @@ gen r u c = do whereisKey = Nothing, config = M.empty, repo = r, + gitconfig = gc, localpath = Just dir, readonly = False, remotetype = remote } + where + dir = fromMaybe (error "missing directory") $ remoteAnnexDirectory gc directorySetup :: UUID -> RemoteConfig -> Annex RemoteConfig directorySetup u c = do diff --git a/Remote/Git.hs b/Remote/Git.hs index db73247a1..9b0617652 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -19,6 +19,7 @@ import Utility.CopyFile import Utility.Rsync import Remote.Helper.Ssh import Types.Remote +import Types.GitConfig import qualified Git import qualified Git.Config import qualified Git.Construct @@ -73,10 +74,11 @@ list = do - cached UUID value. -} configRead :: Git.Repo -> Annex Git.Repo configRead r = do - notignored <- repoNotIgnored r + g <- fromRepo id + let c = extractRemoteGitConfig g (Git.repoDescribe r) u <- getRepoUUID r - case (repoCheap r, notignored, u) of - (_, False, _) -> return r + case (repoCheap r, remoteAnnexIgnore c, u) of + (_, True, _) -> return r (True, _, _) -> tryGitConfigRead r (False, _, NoUUID) -> tryGitConfigRead r _ -> return r @@ -84,29 +86,32 @@ configRead r = do repoCheap :: Git.Repo -> Bool repoCheap = not . Git.repoIsUrl -gen :: Git.Repo -> UUID -> RemoteConfig -> Annex Remote -gen r u _ = new <$> remoteCost r defcst +gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote +gen r u _ gc = go <$> remoteCost gc defcst where defcst = if repoCheap r then cheapRemoteCost else expensiveRemoteCost - new cst = Remote - { uuid = u - , cost = cst - , name = Git.repoDescribe r - , storeKey = copyToRemote r - , retrieveKeyFile = copyFromRemote r - , retrieveKeyFileCheap = copyFromRemoteCheap r - , removeKey = dropKey r - , hasKey = inAnnex r - , hasKeyCheap = repoCheap r - , whereisKey = Nothing - , config = M.empty - , localpath = if Git.repoIsLocal r || Git.repoIsLocalUnknown r - then Just $ Git.repoPath r - else Nothing - , repo = r - , readonly = Git.repoIsHttp r - , remotetype = remote - } + go cst = new + where + new = Remote + { uuid = u + , cost = cst + , name = Git.repoDescribe r + , storeKey = copyToRemote new + , retrieveKeyFile = copyFromRemote new + , retrieveKeyFileCheap = copyFromRemoteCheap new + , removeKey = dropKey new + , hasKey = inAnnex r + , hasKeyCheap = repoCheap r + , whereisKey = Nothing + , config = M.empty + , localpath = if Git.repoIsLocal r || Git.repoIsLocalUnknown r + then Just $ Git.repoPath r + else Nothing + , repo = r + , gitconfig = gc + , readonly = Git.repoIsHttp r + , remotetype = remote + } {- Checks relatively inexpensively if a repository is available for use. -} repoAvail :: Git.Repo -> Annex Bool @@ -236,10 +241,10 @@ keyUrls r key = map tourl (annexLocations key) where tourl l = Git.repoLocation r ++ "/" ++ l -dropKey :: Git.Repo -> Key -> Annex Bool +dropKey :: Remote -> Key -> Annex Bool dropKey r key - | not $ Git.repoIsUrl r = - guardUsable r False $ commitOnCleanup r $ liftIO $ onLocal r $ do + | not $ Git.repoIsUrl (repo r) = + guardUsable (repo r) False $ commitOnCleanup r $ liftIO $ onLocal (repo r) $ do ensureInitialized whenM (Annex.Content.inAnnex key) $ do Annex.Content.lockContent key $ @@ -247,29 +252,29 @@ dropKey r key logStatus key InfoMissing Annex.Content.saveState True return True - | Git.repoIsHttp r = error "dropping from http repo not supported" - | otherwise = commitOnCleanup r $ onRemote r (boolSystem, False) "dropkey" + | Git.repoIsHttp (repo r) = error "dropping from http repo not supported" + | otherwise = commitOnCleanup r $ onRemote (repo r) (boolSystem, False) "dropkey" [ Params "--quiet --force" , Param $ key2file key ] [] {- Tries to copy a key's content from a remote's annex to a file. -} -copyFromRemote :: Git.Repo -> Key -> AssociatedFile -> FilePath -> Annex Bool +copyFromRemote :: Remote -> Key -> AssociatedFile -> FilePath -> Annex Bool copyFromRemote r key file dest - | not $ Git.repoIsUrl r = guardUsable r False $ do - params <- rsyncParams r + | not $ Git.repoIsUrl (repo r) = guardUsable (repo r) False $ do + let params = rsyncParams r u <- getUUID -- run copy from perspective of remote - liftIO $ onLocal r $ do + liftIO $ onLocal (repo r) $ do ensureInitialized Annex.Content.sendAnnex key $ \object -> upload u key file noRetry $ rsyncOrCopyFile params object dest - | Git.repoIsSsh r = feedprogressback $ \feeder -> + | Git.repoIsSsh (repo r) = feedprogressback $ \feeder -> rsyncHelper (Just feeder) =<< rsyncParamsRemote r True key dest file - | Git.repoIsHttp r = Annex.Content.downloadUrl (keyUrls r key) dest + | Git.repoIsHttp (repo r) = Annex.Content.downloadUrl (keyUrls (repo r) key) dest | otherwise = error "copying from non-ssh, non-http repo not supported" where {- Feed local rsync's progress info back to the remote, @@ -289,7 +294,7 @@ copyFromRemote r key file dest u <- getUUID let fields = (Fields.remoteUUID, fromUUID u) : maybe [] (\f -> [(Fields.associatedFile, f)]) file - Just (cmd, params) <- git_annex_shell r "transferinfo" + Just (cmd, params) <- git_annex_shell (repo r) "transferinfo" [Param $ key2file key] fields v <- liftIO $ newEmptySV tid <- liftIO $ forkIO $ void $ tryIO $ do @@ -310,12 +315,12 @@ copyFromRemote r key file dest let feeder = writeSV v bracketIO noop (const $ tryIO $ killThread tid) (a feeder) -copyFromRemoteCheap :: Git.Repo -> Key -> FilePath -> Annex Bool +copyFromRemoteCheap :: Remote -> Key -> FilePath -> Annex Bool copyFromRemoteCheap r key file - | not $ Git.repoIsUrl r = guardUsable r False $ do - loc <- liftIO $ gitAnnexLocation key r + | not $ Git.repoIsUrl (repo r) = guardUsable (repo r) False $ do + loc <- liftIO $ gitAnnexLocation key (repo r) liftIO $ catchBoolIO $ createSymbolicLink loc file >> return True - | Git.repoIsSsh r = + | Git.repoIsSsh (repo r) = ifM (Annex.Content.preseedTmp key file) ( copyFromRemote r key Nothing file , return False @@ -323,18 +328,20 @@ copyFromRemoteCheap r key file | otherwise = return False {- Tries to copy a key's content to a remote's annex. -} -copyToRemote :: Git.Repo -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool +copyToRemote :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool copyToRemote r key file p - | not $ Git.repoIsUrl r = guardUsable r False $ commitOnCleanup r $ copylocal - | Git.repoIsSsh r = commitOnCleanup r $ Annex.Content.sendAnnex key $ \object -> - rsyncHelper (Just p) =<< rsyncParamsRemote r False key object file + | not $ Git.repoIsUrl (repo r) = + guardUsable (repo r) False $ commitOnCleanup r $ copylocal + | Git.repoIsSsh (repo r) = commitOnCleanup r $ + Annex.Content.sendAnnex key $ \object -> + rsyncHelper (Just p) =<< rsyncParamsRemote r False key object file | otherwise = error "copying to non-ssh repo not supported" where copylocal = Annex.Content.sendAnnex key $ \object -> do - params <- rsyncParams r + let params = rsyncParams r u <- getUUID -- run copy from perspective of remote - liftIO $ onLocal r $ ifM (Annex.Content.inAnnex key) + liftIO $ onLocal (repo r) $ ifM (Annex.Content.inAnnex key) ( return False , do ensureInitialized @@ -382,18 +389,18 @@ rsyncOrCopyFile rsyncparams src dest p = {- Generates rsync parameters that ssh to the remote and asks it - to either receive or send the key's content. -} -rsyncParamsRemote :: Git.Repo -> Bool -> Key -> FilePath -> AssociatedFile -> Annex [CommandParam] +rsyncParamsRemote :: Remote -> Bool -> Key -> FilePath -> AssociatedFile -> Annex [CommandParam] rsyncParamsRemote r sending key file afile = do u <- getUUID let fields = (Fields.remoteUUID, fromUUID u) : maybe [] (\f -> [(Fields.associatedFile, f)]) afile - Just (shellcmd, shellparams) <- git_annex_shell r + Just (shellcmd, shellparams) <- git_annex_shell (repo r) (if sending then "sendkey" else "recvkey") [ Param $ key2file key ] fields -- Convert the ssh command into rsync command line. let eparam = rsyncShell (Param shellcmd:shellparams) - o <- rsyncParams r + let o = rsyncParams r if sending then return $ o ++ rsyncopts eparam dummy (File file) else return $ o ++ rsyncopts eparam (File file) dummy @@ -410,25 +417,22 @@ rsyncParamsRemote r sending key file afile = do - even though this hostname will never be used. -} dummy = Param "dummy:" -rsyncParams :: Git.Repo -> Annex [CommandParam] -rsyncParams r = do - o <- getRemoteConfig r "rsync-options" "" - return $ options ++ map Param (words o) - where - -- --inplace to resume partial files - options = [Params "-p --progress --inplace"] +-- --inplace to resume partial files +rsyncParams :: Remote -> [CommandParam] +rsyncParams r = [Params "-p --progress --inplace"] ++ + map Param (remoteAnnexRsyncOptions $ gitconfig r) -commitOnCleanup :: Git.Repo -> Annex a -> Annex a +commitOnCleanup :: Remote -> Annex a -> Annex a commitOnCleanup r a = go `after` a where - go = Annex.addCleanup (Git.repoLocation r) cleanup + go = Annex.addCleanup (Git.repoLocation $ repo r) cleanup cleanup - | not $ Git.repoIsUrl r = liftIO $ onLocal r $ + | not $ Git.repoIsUrl (repo r) = liftIO $ onLocal (repo r) $ doQuietSideAction $ Annex.Branch.commit "update" | otherwise = void $ do Just (shellcmd, shellparams) <- - git_annex_shell r "commit" [] [] + git_annex_shell (repo r) "commit" [] [] -- Throw away stderr, since the remote may not -- have a new enough git-annex shell to diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs index 05cdf8978..04b70e2f1 100644 --- a/Remote/Glacier.hs +++ b/Remote/Glacier.hs @@ -37,8 +37,8 @@ remote = RemoteType { setup = glacierSetup } -gen :: Git.Repo -> UUID -> RemoteConfig -> Annex Remote -gen r u c = new <$> remoteCost r veryExpensiveRemoteCost +gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote +gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost where new cst = encryptableRemote c (storeEncrypted this) @@ -58,6 +58,7 @@ gen r u c = new <$> remoteCost r veryExpensiveRemoteCost whereisKey = Nothing, config = c, repo = r, + gitconfig = gc, localpath = Nothing, readonly = False, remotetype = remote diff --git a/Remote/Helper/Hooks.hs b/Remote/Helper/Hooks.hs index 91190d841..bdeb653eb 100644 --- a/Remote/Helper/Hooks.hs +++ b/Remote/Helper/Hooks.hs @@ -13,15 +13,16 @@ import Common.Annex import Types.Remote import qualified Annex import Annex.LockPool -import Config import Annex.Perms {- Modifies a remote's access functions to first run the - annex-start-command hook, and trigger annex-stop-command on shutdown. - This way, the hooks are only run when a remote is actively being used. -} -addHooks :: Remote -> Annex Remote -addHooks r = addHooks' r <$> lookupHook r "start" <*> lookupHook r "stop" +addHooks :: Remote -> Remote +addHooks r = addHooks' r + (remoteAnnexStartCommand $ gitconfig r) + (remoteAnnexStopCommand $ gitconfig r) addHooks' :: Remote -> Maybe String -> Maybe String -> Remote addHooks' r Nothing Nothing = r addHooks' r starthook stophook = r' @@ -83,10 +84,3 @@ runHooks r starthook stophook a = do Left _ -> noop Right _ -> run stophook liftIO $ closeFd fd - -lookupHook :: Remote -> String -> Annex (Maybe String) -lookupHook r n = go =<< getRemoteConfig (repo r) hookname "" - where - go "" = return Nothing - go command = return $ Just command - hookname = n ++ "-command" diff --git a/Remote/Helper/Ssh.hs b/Remote/Helper/Ssh.hs index b6da80ec6..135b5c144 100644 --- a/Remote/Helper/Ssh.hs +++ b/Remote/Helper/Ssh.hs @@ -10,17 +10,19 @@ module Remote.Helper.Ssh where import Common.Annex import qualified Git import qualified Git.Url -import Config import Annex.UUID import Annex.Ssh import Fields +import Types.GitConfig {- Generates parameters to ssh to a repository's host and run a command. - Caller is responsible for doing any neccessary shellEscaping of the - passed command. -} sshToRepo :: Git.Repo -> [CommandParam] -> Annex [CommandParam] sshToRepo repo sshcmd = do - opts <- map Param . words <$> getRemoteConfig repo "ssh-options" "" + g <- fromRepo id + let c = extractRemoteGitConfig g (Git.repoDescribe repo) + let opts = map Param $ remoteAnnexSshOptions c params <- sshParams (Git.Url.hostuser repo, Git.Url.port repo) opts return $ params ++ sshcmd diff --git a/Remote/Hook.hs b/Remote/Hook.hs index 8f9aaafd6..c9edda133 100644 --- a/Remote/Hook.hs +++ b/Remote/Hook.hs @@ -29,10 +29,9 @@ remote = RemoteType { setup = hookSetup } -gen :: Git.Repo -> UUID -> RemoteConfig -> Annex Remote -gen r u c = do - hooktype <- getRemoteConfig r "hooktype" (error "missing hooktype") - cst <- remoteCost r expensiveRemoteCost +gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote +gen r u c gc = do + cst <- remoteCost gc expensiveRemoteCost return $ encryptableRemote c (storeEncrypted hooktype) (retrieveEncrypted hooktype) @@ -50,9 +49,12 @@ gen r u c = do config = M.empty, localpath = Nothing, repo = r, + gitconfig = gc, readonly = False, remotetype = remote } + where + hooktype = fromMaybe (error "missing hooktype") $ remoteAnnexHookType gc hookSetup :: UUID -> RemoteConfig -> Annex RemoteConfig hookSetup u c = do diff --git a/Remote/List.hs b/Remote/List.hs index 4622f1e99..1cfbab872 100644 --- a/Remote/List.hs +++ b/Remote/List.hs @@ -15,8 +15,8 @@ import Common.Annex import qualified Annex import Logs.Remote import Types.Remote +import Types.GitConfig import Annex.UUID -import Config import Remote.Helper.Hooks import qualified Git import qualified Git.Config @@ -81,7 +81,10 @@ remoteListRefresh = do remoteGen :: (M.Map UUID RemoteConfig) -> RemoteType -> Git.Repo -> Annex Remote remoteGen m t r = do u <- getRepoUUID r - addHooks =<< generate t r u (fromMaybe M.empty $ M.lookup u m) + g <- fromRepo id + let gc = extractRemoteGitConfig g (Git.repoDescribe r) + let c = fromMaybe M.empty $ M.lookup u m + addHooks <$> generate t r u c gc {- Updates a local git Remote, re-reading its git config. -} updateRemote :: Remote -> Annex Remote @@ -97,7 +100,7 @@ updateRemote remote = do {- All remotes that are not ignored. -} enabledRemoteList :: Annex [Remote] -enabledRemoteList = filterM (repoNotIgnored . repo) =<< remoteList +enabledRemoteList = filter (not . remoteAnnexIgnore . gitconfig) <$> remoteList {- Checks if a remote is a special remote -} specialRemote :: Remote -> Bool diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index 4c61d8e62..b05753830 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -38,10 +38,9 @@ remote = RemoteType { setup = rsyncSetup } -gen :: Git.Repo -> UUID -> RemoteConfig -> Annex Remote -gen r u c = do - o <- genRsyncOpts r c - cst <- remoteCost r expensiveRemoteCost +gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote +gen r u c gc = do + cst <- remoteCost gc expensiveRemoteCost return $ encryptableRemote c (storeEncrypted o) (retrieveEncrypted o) @@ -58,27 +57,24 @@ gen r u c = do , whereisKey = Nothing , config = M.empty , repo = r + , gitconfig = gc , localpath = if rsyncUrlIsPath $ rsyncUrl o then Just $ rsyncUrl o else Nothing , readonly = False , remotetype = remote } - -genRsyncOpts :: Git.Repo -> RemoteConfig -> Annex RsyncOpts -genRsyncOpts r c = do - url <- getRemoteConfig r "rsyncurl" (error "missing rsyncurl") - opts <- map Param . filter safe . words - <$> getRemoteConfig r "rsync-options" "" - let escape = M.lookup "shellescape" c /= Just "no" - return $ RsyncOpts url opts escape where - safe o + o = RsyncOpts url opts escape + url = fromMaybe (error "missing rsyncurl") $ remoteAnnexRsyncUrl gc + opts = map Param $ filter safe $ remoteAnnexRsyncOptions gc + escape = M.lookup "shellescape" c /= Just "no" + safe opt -- Don't allow user to pass --delete to rsync; -- that could cause it to delete other keys -- in the same hash bucket as a key it sends. - | o == "--delete" = False - | o == "--delete-excluded" = False + | opt == "--delete" = False + | opt == "--delete-excluded" = False | otherwise = True rsyncSetup :: UUID -> RemoteConfig -> Annex RemoteConfig diff --git a/Remote/S3.hs b/Remote/S3.hs index 345d93872..0c0737841 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -37,8 +37,8 @@ remote = RemoteType { setup = s3Setup } -gen :: Git.Repo -> UUID -> RemoteConfig -> Annex Remote -gen r u c = new <$> remoteCost r expensiveRemoteCost +gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote +gen r u c gc = new <$> remoteCost gc expensiveRemoteCost where new cst = encryptableRemote c (storeEncrypted this) @@ -58,6 +58,7 @@ gen r u c = new <$> remoteCost r expensiveRemoteCost whereisKey = Nothing, config = c, repo = r, + gitconfig = gc, localpath = Nothing, readonly = False, remotetype = remote diff --git a/Remote/Web.hs b/Remote/Web.hs index f1eee7feb..f984137a9 100644 --- a/Remote/Web.hs +++ b/Remote/Web.hs @@ -35,8 +35,8 @@ list = do r <- liftIO $ Git.Construct.remoteNamed "web" Git.Construct.fromUnknown return [r] -gen :: Git.Repo -> UUID -> RemoteConfig -> Annex Remote -gen r _ _ = +gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote +gen r _ _ gc = return Remote { uuid = webUUID, cost = expensiveRemoteCost, @@ -49,6 +49,7 @@ gen r _ _ = hasKeyCheap = False, whereisKey = Just getUrls, config = M.empty, + gitconfig = gc, localpath = Nothing, repo = r, readonly = True, diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs index 70faa7539..752e0d7ff 100644 --- a/Remote/WebDAV.hs +++ b/Remote/WebDAV.hs @@ -43,8 +43,8 @@ remote = RemoteType { setup = webdavSetup } -gen :: Git.Repo -> UUID -> RemoteConfig -> Annex Remote -gen r u c = new <$> remoteCost r expensiveRemoteCost +gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote +gen r u c gc = new <$> remoteCost gc expensiveRemoteCost where new cst = encryptableRemote c (storeEncrypted this) @@ -64,6 +64,7 @@ gen r u c = new <$> remoteCost r expensiveRemoteCost whereisKey = Nothing, config = c, repo = r, + gitconfig = gc, localpath = Nothing, readonly = False, remotetype = remote |