summaryrefslogtreecommitdiff
path: root/Remote
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-09-27 19:52:36 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-09-27 19:52:36 -0400
commitcbf810a421901e76ee2d3e18592fb4d39de851a6 (patch)
tree222eb2bedae5ddd3703d611a5b31a5b396dca75f /Remote
parent7d1b396cc863fb93869b7358dcfe1908985a21b8 (diff)
clean up some ugly code
Diffstat (limited to 'Remote')
-rw-r--r--Remote/GCrypt.hs37
1 files changed, 20 insertions, 17 deletions
diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index 5a66cbdeb..b09943052 100644
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -14,6 +14,7 @@ module Remote.GCrypt (
import qualified Data.Map as M
import qualified Data.ByteString.Lazy as L
+import Control.Exception.Extensible
import Common.Annex
import Types.Remote
@@ -374,22 +375,24 @@ coreGCryptId = "core.gcrypt-id"
- (Also returns a version of input repo with its config read.) -}
getGCryptId :: Bool -> Git.Repo -> Annex (Maybe Git.GCrypt.GCryptId, Git.Repo)
getGCryptId fast r
- | Git.repoIsLocal r = extract
- =<< liftIO (catchDefaultIO r $ Git.Config.read r)
- | not fast = do
- fromshell <- Ssh.onRemote r (Git.Config.fromPipe r, Left undefined) "configlist" [] []
- case fromshell of
- Right (r', _) -> extract r'
- Left _ -> do
- (rsynctransport, rsyncurl, _) <- rsyncTransport r
- fromrsync <- liftIO $ do
- withTmpFile "tmpconfig" $ \tmpconfig _ -> do
- void $ rsync $ rsynctransport ++
- [ Param $ rsyncurl ++ "/config"
- , Param tmpconfig
- ]
- Git.Config.fromFile r tmpconfig
- extract $ either (const r) fst fromrsync
+ | Git.repoIsLocal r = extract <$>
+ liftIO (catchMaybeIO $ Git.Config.read r)
+ | not fast = extract . liftM fst <$> getM (eitherToMaybe <$>)
+ [ Ssh.onRemote r (Git.Config.fromPipe r, Left undefined) "configlist" [] []
+ , getConfigViaRsync r
+ ]
| otherwise = return (Nothing, r)
where
- extract r' = return (Git.Config.getMaybe coreGCryptId r', r')
+ extract Nothing = (Nothing, r)
+ extract (Just r') = (Git.Config.getMaybe coreGCryptId r', r')
+
+getConfigViaRsync :: Git.Repo -> Annex (Either SomeException (Git.Repo, String))
+getConfigViaRsync r = do
+ (rsynctransport, rsyncurl, _) <- rsyncTransport r
+ liftIO $ do
+ withTmpFile "tmpconfig" $ \tmpconfig _ -> do
+ void $ rsync $ rsynctransport ++
+ [ Param $ rsyncurl ++ "/config"
+ , Param tmpconfig
+ ]
+ Git.Config.fromFile r tmpconfig