diff options
Diffstat (limited to 'Remote')
| -rw-r--r-- | Remote/Bup.hs | 17 | ||||
| -rw-r--r-- | Remote/Directory.hs | 6 | ||||
| -rw-r--r-- | Remote/Git.hs | 19 | ||||
| -rw-r--r-- | Remote/Helper/Special.hs | 10 | ||||
| -rw-r--r-- | Remote/Hook.hs | 9 | ||||
| -rw-r--r-- | Remote/Rsync.hs | 13 | ||||
| -rw-r--r-- | Remote/S3real.hs | 7 | ||||
| -rw-r--r-- | Remote/Web.hs | 2 |
8 files changed, 35 insertions, 48 deletions
diff --git a/Remote/Bup.hs b/Remote/Bup.hs index 3e621ce56..b8d7cd317 100644 --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -102,15 +102,13 @@ bupSplitParams r buprepo k src = do store :: Git.Repo -> BupRepo -> Key -> Annex Bool store r buprepo k = do - g <- gitRepo - let src = gitAnnexLocation g k + src <- fromRepo $ gitAnnexLocation k params <- bupSplitParams r buprepo k (File src) liftIO $ boolSystem "bup" params storeEncrypted :: Git.Repo -> BupRepo -> (Cipher, Key) -> Key -> Annex Bool storeEncrypted r buprepo (cipher, enck) k = do - g <- gitRepo - let src = gitAnnexLocation g k + src <- fromRepo $ gitAnnexLocation k params <- bupSplitParams r buprepo enck (Param "-") liftIO $ catchBool $ withEncryptedHandle cipher (L.readFile src) $ \h -> @@ -147,7 +145,7 @@ checkPresent r bupr k showAction $ "checking " ++ Git.repoDescribe r ok <- onBupRemote bupr boolSystem "git" params return $ Right ok - | otherwise = liftIO $ try $ boolSystem "git" $ Git.gitCommandLine bupr params + | otherwise = liftIO $ try $ boolSystem "git" $ Git.gitCommandLine params bupr where params = [ Params "show-ref --quiet --verify" @@ -165,9 +163,10 @@ storeBupUUID u buprepo = do >>! error "ssh failed" else liftIO $ do r' <- Git.configRead r - let olduuid = Git.configGet r' "annex.uuid" "" - when (olduuid == "") $ Git.run r' "config" - [Param "annex.uuid", Param v] + let olduuid = Git.configGet "annex.uuid" "" r' + when (olduuid == "") $ + Git.run "config" + [Param "annex.uuid", Param v] r' where v = fromUUID u @@ -194,7 +193,7 @@ getBupUUID r u | otherwise = liftIO $ do ret <- try $ Git.configRead r case ret of - Right r' -> return (toUUID $ Git.configGet r' "annex.uuid" "", r') + Right r' -> return (toUUID $ Git.configGet "annex.uuid" "" r', r') Left _ -> return (NoUUID, r) {- Converts a bup remote path spec into a Git.Repo. There are some diff --git a/Remote/Directory.hs b/Remote/Directory.hs index e8cf05a0e..8e306e228 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -70,15 +70,13 @@ dirKey d k = d </> hashDirMixed k </> f </> f store :: FilePath -> Key -> Annex Bool store d k = do - g <- gitRepo - let src = gitAnnexLocation g k + src <- fromRepo $ gitAnnexLocation k let dest = dirKey d k liftIO $ catchBool $ storeHelper dest $ copyFileExternal src dest storeEncrypted :: FilePath -> (Cipher, Key) -> Key -> Annex Bool storeEncrypted d (cipher, enck) k = do - g <- gitRepo - let src = gitAnnexLocation g k + src <- fromRepo $ gitAnnexLocation k let dest = dirKey d enck liftIO $ catchBool $ storeHelper dest $ encrypt src dest where diff --git a/Remote/Git.hs b/Remote/Git.hs index 4c76e8ce6..75f0ac757 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -35,19 +35,16 @@ remote = RemoteType { list :: Annex [Git.Repo] list = do - g <- gitRepo - let c = Git.configMap g - mapM (tweakurl c) $ Git.remotes g + c <- fromRepo Git.configMap + mapM (tweakurl c) =<< fromRepo Git.remotes where annexurl n = "remote." ++ n ++ ".annexurl" tweakurl c r = do let n = fromJust $ Git.repoRemoteName r case M.lookup (annexurl n) c of Nothing -> return r - Just url -> do - g <- gitRepo - r' <- liftIO $ Git.genRemote g url - return $ Git.repoRemoteNameSet r' n + Just url -> Git.repoRemoteNameSet n <$> + inRepo (Git.genRemote url) gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex) gen r u _ = do @@ -178,7 +175,7 @@ copyFromRemote :: Git.Repo -> Key -> FilePath -> Annex Bool copyFromRemote r key file | not $ Git.repoIsUrl r = do params <- rsyncParams r - rsyncOrCopyFile params (gitAnnexLocation r key) file + rsyncOrCopyFile params (gitAnnexLocation key r) file | Git.repoIsSsh r = rsyncHelper =<< rsyncParamsRemote r True key file | Git.repoIsHttp r = liftIO $ Url.download (keyUrl r key) file | otherwise = error "copying from non-ssh, non-http repo not supported" @@ -187,8 +184,7 @@ copyFromRemote r key file copyToRemote :: Git.Repo -> Key -> Annex Bool copyToRemote r key | not $ Git.repoIsUrl r = do - g <- gitRepo - let keysrc = gitAnnexLocation g key + keysrc <- fromRepo $ gitAnnexLocation key params <- rsyncParams r -- run copy from perspective of remote liftIO $ onLocal r $ do @@ -197,8 +193,7 @@ copyToRemote r key Annex.Content.saveState return ok | Git.repoIsSsh r = do - g <- gitRepo - let keysrc = gitAnnexLocation g key + keysrc <- fromRepo $ gitAnnexLocation key rsyncHelper =<< rsyncParamsRemote r False key keysrc | otherwise = error "copying to non-ssh repo not supported" diff --git a/Remote/Helper/Special.hs b/Remote/Helper/Special.hs index 38f24eb37..6cea17034 100644 --- a/Remote/Helper/Special.hs +++ b/Remote/Helper/Special.hs @@ -23,16 +23,16 @@ findSpecialRemotes s = do return $ map construct $ remotepairs g where remotepairs r = M.toList $ M.filterWithKey match $ Git.configMap r - construct (k,_) = Git.repoRemoteNameFromKey Git.repoFromUnknown k + construct (k,_) = Git.repoRemoteNameFromKey k Git.repoFromUnknown match k _ = startswith "remote." k && endswith (".annex-"++s) k {- Sets up configuration for a special remote in .git/config. -} gitConfigSpecialRemote :: UUID -> RemoteConfig -> String -> String -> Annex () gitConfigSpecialRemote u c k v = do - g <- gitRepo - liftIO $ do - Git.run g "config" [Param (configsetting $ "annex-"++k), Param v] - Git.run g "config" [Param (configsetting "annex-uuid"), Param $ fromUUID u] + set ("annex-"++k) v + set ("annex-uuid") (fromUUID u) where + set a b = inRepo $ Git.run "config" + [Param (configsetting a), Param b] remotename = fromJust (M.lookup "name" c) configsetting s = "remote." ++ remotename ++ "." ++ s diff --git a/Remote/Hook.hs b/Remote/Hook.hs index 8b6a6cecf..06568a3cb 100644 --- a/Remote/Hook.hs +++ b/Remote/Hook.hs @@ -98,14 +98,13 @@ runHook hooktype hook k f a = maybe (return False) run =<< lookupHook hooktype h store :: String -> Key -> Annex Bool store h k = do - g <- gitRepo - runHook h "store" k (Just $ gitAnnexLocation g k) $ return True + src <- fromRepo $ gitAnnexLocation k + runHook h "store" k (Just src) $ return True storeEncrypted :: String -> (Cipher, Key) -> Key -> Annex Bool storeEncrypted h (cipher, enck) k = withTmp enck $ \tmp -> do - g <- gitRepo - let f = gitAnnexLocation g k - liftIO $ withEncryptedContent cipher (L.readFile f) $ \s -> L.writeFile tmp s + src <- fromRepo $ gitAnnexLocation k + liftIO $ withEncryptedContent cipher (L.readFile src) $ L.writeFile tmp runHook h "store" enck (Just tmp) $ return True retrieve :: String -> Key -> FilePath -> Annex Bool diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index e79762a38..0dfad7293 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -90,15 +90,12 @@ rsyncKeyDir :: RsyncOpts -> Key -> String rsyncKeyDir o k = rsyncUrl o </> hashDirMixed k </> shellEscape (keyFile k) store :: RsyncOpts -> Key -> Annex Bool -store o k = do - g <- gitRepo - rsyncSend o k (gitAnnexLocation g k) +store o k = rsyncSend o k =<< fromRepo (gitAnnexLocation k) storeEncrypted :: RsyncOpts -> (Cipher, Key) -> Key -> Annex Bool storeEncrypted o (cipher, enck) k = withTmp enck $ \tmp -> do - g <- gitRepo - let f = gitAnnexLocation g k - liftIO $ withEncryptedContent cipher (L.readFile f) $ \s -> L.writeFile tmp s + src <- fromRepo $ gitAnnexLocation k + liftIO $ withEncryptedContent cipher (L.readFile src) $ L.writeFile tmp rsyncSend o enck tmp retrieve :: RsyncOpts -> Key -> FilePath -> Annex Bool @@ -151,9 +148,9 @@ partialParams = Params "--no-inplace --partial --partial-dir=.rsync-partial" - up trees for rsync. -} withRsyncScratchDir :: (FilePath -> Annex Bool) -> Annex Bool withRsyncScratchDir a = do - g <- gitRepo pid <- liftIO getProcessID - let tmp = gitAnnexTmpDir g </> "rsynctmp" </> show pid + t <- fromRepo gitAnnexTmpDir + let tmp = t </> "rsynctmp" </> show pid nuke tmp liftIO $ createDirectoryIfMissing True tmp res <- a tmp diff --git a/Remote/S3real.hs b/Remote/S3real.hs index 1281c2786..b201b5aad 100644 --- a/Remote/S3real.hs +++ b/Remote/S3real.hs @@ -112,8 +112,8 @@ s3Setup u c = handlehost $ M.lookup "host" c store :: Remote Annex -> Key -> Annex Bool store r k = s3Action r False $ \(conn, bucket) -> do - g <- gitRepo - res <- liftIO $ storeHelper (conn, bucket) r k $ gitAnnexLocation g k + dest <- fromRepo $ gitAnnexLocation k + res <- liftIO $ storeHelper (conn, bucket) r k dest s3Bool res storeEncrypted :: Remote Annex -> (Cipher, Key) -> Key -> Annex Bool @@ -121,8 +121,7 @@ storeEncrypted r (cipher, enck) k = s3Action r False $ \(conn, bucket) -> -- To get file size of the encrypted content, have to use a temp file. -- (An alternative would be chunking to to a constant size.) withTmp enck $ \tmp -> do - g <- gitRepo - let f = gitAnnexLocation g k + f <- fromRepo $ gitAnnexLocation k liftIO $ withEncryptedContent cipher (L.readFile f) $ \s -> L.writeFile tmp s res <- liftIO $ storeHelper (conn, bucket) r enck tmp s3Bool res diff --git a/Remote/Web.hs b/Remote/Web.hs index 393932d47..da7f38472 100644 --- a/Remote/Web.hs +++ b/Remote/Web.hs @@ -27,7 +27,7 @@ remote = RemoteType { -- (If the web should cease to exist, remove this module and redistribute -- a new release to the survivors by carrier pigeon.) list :: Annex [Git.Repo] -list = return [Git.repoRemoteNameSet Git.repoFromUnknown "web"] +list = return [Git.repoRemoteNameSet "web" Git.repoFromUnknown] gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex (Remote Annex) gen r _ _ = |