From ad945896c9e49c084e4f8c689f045fc7d92ca123 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 24 Jul 2024 08:33:59 -0400 Subject: [PATCH] avoid needing ifdefs when using P2P.Http.Client --- P2P/Http/Client.hs | 45 +++++++++++++++++++++++++++++++-------------- Remote/Git.hs | 10 ++++------ 2 files changed, 35 insertions(+), 20 deletions(-) diff --git a/P2P/Http/Client.hs b/P2P/Http/Client.hs index f62ab2a59a..5a94f3613e 100644 --- a/P2P/Http/Client.hs +++ b/P2P/Http/Client.hs @@ -44,6 +44,7 @@ import System.IO.Unsafe #endif type ClientAction a +#ifdef WITH_SERVANT = ClientEnv -> ProtocolVersion -> B64UUID ServerSide @@ -51,13 +52,14 @@ type ClientAction a -> [B64UUID Bypass] -> Maybe Auth -> Annex (Either ClientError a) +#else + = () +#endif p2pHttpClient :: Remote -> (String -> Annex a) -#ifdef WITH_SERVANT -> ClientAction a -#endif -> Annex a #ifdef WITH_SERVANT p2pHttpClient rmt fallback clientaction = @@ -132,11 +134,11 @@ p2pHttpClient rmt fallback clientaction = M.insert (Git.CredentialBaseURL credentialbaseurl) cred cc Nothing -> noop #else -runP2PHttpClient rmt fallback = fallback "This remote uses an annex+http url, but this version of git-annex is not build with support for that." +runP2PHttpClient rmt fallback () = fallback + "This remote uses an annex+http url, but this version of git-annex is not build with support for that." #endif #ifdef WITH_SERVANT - clientGet :: ClientEnv -> ProtocolVersion @@ -154,7 +156,7 @@ clientGet clientenv (ProtocolVersion ver) k su cu bypass af auth dest = do withClientM (cli k cu bypass af mo auth) clientenv $ \case Left err -> throwM err Right respheaders -> do - b <- S.unSourceT (getResponse respheaders) gatherByteString + b <- S.unSourceT (getResponse respheaders) gather liftIO $ withBinaryFile (fromRawFilePath dest) WriteMode $ \h -> do case startsz of Just startsz' | startsz' /= 0 -> @@ -183,16 +185,16 @@ clientGet clientenv (ProtocolVersion ver) k su cu bypass af auth dest = do v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI -gatherByteString :: S.StepT IO B.ByteString -> IO L.ByteString -gatherByteString = unsafeInterleaveIO . go - where - go S.Stop = return LI.Empty - go (S.Error err) = giveup err - go (S.Skip s) = go s - go (S.Effect ms) = ms >>= go - go (S.Yield v s) = LI.Chunk v <$> unsafeInterleaveIO (go s) + gather = unsafeInterleaveIO . gather' + gather' S.Stop = return LI.Empty + gather' (S.Error err) = giveup err + gather' (S.Skip s) = gather' s + gather' (S.Effect ms) = ms >>= gather' + gather' (S.Yield v s) = LI.Chunk v <$> unsafeInterleaveIO (gather' s) +#endif clientCheckPresent :: Key -> ClientAction Bool +#ifdef WITH_SERVANT clientCheckPresent key clientenv (ProtocolVersion ver) su cu bypass auth = liftIO $ withClientM (cli su (B64Key key) cu bypass auth) clientenv $ \case Left err -> return (Left err) @@ -207,7 +209,11 @@ clientCheckPresent key clientenv (ProtocolVersion ver) su cu bypass auth = _ :<|> _ :<|> _ :<|> _ :<|> v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI +#else +clientCheckPresent _ = () +#endif +#ifdef WITH_SERVANT clientRemove :: ClientEnv -> ProtocolVersion @@ -232,7 +238,9 @@ clientRemove clientenv (ProtocolVersion ver) key su cu bypass auth = _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI +#endif +#ifdef WITH_SERVANT clientRemoveBefore :: ClientEnv -> ProtocolVersion @@ -256,7 +264,9 @@ clientRemoveBefore clientenv (ProtocolVersion ver) key su cu bypass ts auth = _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> v3 :<|> _ = client p2pHttpAPI +#endif +#ifdef WITH_SERVANT clientGetTimestamp :: ClientEnv -> ProtocolVersion @@ -279,7 +289,9 @@ clientGetTimestamp clientenv (ProtocolVersion ver) su cu bypass auth = _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> v3 :<|> _ = client p2pHttpAPI +#endif +#ifdef WITH_SERVANT clientPut :: ClientEnv -> ProtocolVersion @@ -374,7 +386,9 @@ clientPut clientenv (ProtocolVersion ver) k su cu bypass auth moffset af content _ :<|> _ :<|> v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI +#endif +#ifdef WITH_SERVANT clientPutOffset :: ClientEnv -> ProtocolVersion @@ -404,7 +418,9 @@ clientPutOffset clientenv (ProtocolVersion ver) k su cu bypass auth _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> v3 :<|> v2 :<|> v1 :<|> _ = client p2pHttpAPI +#endif +#ifdef WITH_SERVANT clientLockContent :: ClientEnv -> ProtocolVersion @@ -434,7 +450,9 @@ clientLockContent clientenv (ProtocolVersion ver) k su cu bypass auth = _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI +#endif +#ifdef WITH_SERVANT clientKeepLocked :: ClientEnv -> ProtocolVersion @@ -487,4 +505,3 @@ clientKeepLocked clientenv (ProtocolVersion ver) lckid su cu bypass auth a = do v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI #endif --- ^ WITH_SERVANT diff --git a/Remote/Git.hs b/Remote/Git.hs index c1e4046c64..822f232578 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -437,10 +437,7 @@ inAnnex' repo rmt st@(State connpool duc _ _ _) key | Git.repoIsUrl repo = checkremote | otherwise = checklocal where - checkp2phttp = p2pHttpClient rmt giveup -#ifdef WITH_SERVANT - (clientCheckPresent key) -#endif + checkp2phttp = p2pHttpClient rmt giveup (clientCheckPresent key) checkhttp = do gc <- Annex.getGitConfig Url.withUrlOptionsPromptingCreds $ \uo -> @@ -551,8 +548,6 @@ copyFromRemote'' repo r st@(State connpool _ _ _ _) key file dest meterupdate vc | not $ Git.repoIsUrl repo = guardUsable repo (giveup "cannot access remote") $ do u <- getUUID hardlink <- wantHardLink - let bwlimit = remoteAnnexBwLimitDownload (gitconfig r) - <|> remoteAnnexBwLimit (gitconfig r) -- run copy from perspective of remote onLocalFast st $ Annex.Content.prepSendAnnex' key Nothing >>= \case Just (object, _sz, check) -> do @@ -574,6 +569,9 @@ copyFromRemote'' repo r st@(State connpool _ _ _ _) key file dest meterupdate vc (Ssh.runProto r connpool (return (False, UnVerified))) key file dest meterupdate vc | otherwise = giveup "copying from non-ssh, non-http remote not supported" + where + bwlimit = remoteAnnexBwLimitDownload (gitconfig r) + <|> remoteAnnexBwLimit (gitconfig r) copyFromRemoteCheap :: State -> Git.Repo -> Maybe (Key -> AssociatedFile -> FilePath -> Annex ()) #ifndef mingw32_HOST_OS -- 2.39.5