avoid needing ifdefs when using P2P.Http.Client
This commit is contained in:
parent
b4d749cc91
commit
ad945896c9
2 changed files with 35 additions and 20 deletions
|
@ -44,6 +44,7 @@ import System.IO.Unsafe
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
type ClientAction a
|
type ClientAction a
|
||||||
|
#ifdef WITH_SERVANT
|
||||||
= ClientEnv
|
= ClientEnv
|
||||||
-> ProtocolVersion
|
-> ProtocolVersion
|
||||||
-> B64UUID ServerSide
|
-> B64UUID ServerSide
|
||||||
|
@ -51,13 +52,14 @@ type ClientAction a
|
||||||
-> [B64UUID Bypass]
|
-> [B64UUID Bypass]
|
||||||
-> Maybe Auth
|
-> Maybe Auth
|
||||||
-> Annex (Either ClientError a)
|
-> Annex (Either ClientError a)
|
||||||
|
#else
|
||||||
|
= ()
|
||||||
|
#endif
|
||||||
|
|
||||||
p2pHttpClient
|
p2pHttpClient
|
||||||
:: Remote
|
:: Remote
|
||||||
-> (String -> Annex a)
|
-> (String -> Annex a)
|
||||||
#ifdef WITH_SERVANT
|
|
||||||
-> ClientAction a
|
-> ClientAction a
|
||||||
#endif
|
|
||||||
-> Annex a
|
-> Annex a
|
||||||
#ifdef WITH_SERVANT
|
#ifdef WITH_SERVANT
|
||||||
p2pHttpClient rmt fallback clientaction =
|
p2pHttpClient rmt fallback clientaction =
|
||||||
|
@ -132,11 +134,11 @@ p2pHttpClient rmt fallback clientaction =
|
||||||
M.insert (Git.CredentialBaseURL credentialbaseurl) cred cc
|
M.insert (Git.CredentialBaseURL credentialbaseurl) cred cc
|
||||||
Nothing -> noop
|
Nothing -> noop
|
||||||
#else
|
#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
|
#endif
|
||||||
|
|
||||||
#ifdef WITH_SERVANT
|
#ifdef WITH_SERVANT
|
||||||
|
|
||||||
clientGet
|
clientGet
|
||||||
:: ClientEnv
|
:: ClientEnv
|
||||||
-> ProtocolVersion
|
-> 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
|
withClientM (cli k cu bypass af mo auth) clientenv $ \case
|
||||||
Left err -> throwM err
|
Left err -> throwM err
|
||||||
Right respheaders -> do
|
Right respheaders -> do
|
||||||
b <- S.unSourceT (getResponse respheaders) gatherByteString
|
b <- S.unSourceT (getResponse respheaders) gather
|
||||||
liftIO $ withBinaryFile (fromRawFilePath dest) WriteMode $ \h -> do
|
liftIO $ withBinaryFile (fromRawFilePath dest) WriteMode $ \h -> do
|
||||||
case startsz of
|
case startsz of
|
||||||
Just startsz' | startsz' /= 0 ->
|
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
|
v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI
|
||||||
|
|
||||||
gatherByteString :: S.StepT IO B.ByteString -> IO L.ByteString
|
gather = unsafeInterleaveIO . gather'
|
||||||
gatherByteString = unsafeInterleaveIO . go
|
gather' S.Stop = return LI.Empty
|
||||||
where
|
gather' (S.Error err) = giveup err
|
||||||
go S.Stop = return LI.Empty
|
gather' (S.Skip s) = gather' s
|
||||||
go (S.Error err) = giveup err
|
gather' (S.Effect ms) = ms >>= gather'
|
||||||
go (S.Skip s) = go s
|
gather' (S.Yield v s) = LI.Chunk v <$> unsafeInterleaveIO (gather' s)
|
||||||
go (S.Effect ms) = ms >>= go
|
#endif
|
||||||
go (S.Yield v s) = LI.Chunk v <$> unsafeInterleaveIO (go s)
|
|
||||||
|
|
||||||
clientCheckPresent :: Key -> ClientAction Bool
|
clientCheckPresent :: Key -> ClientAction Bool
|
||||||
|
#ifdef WITH_SERVANT
|
||||||
clientCheckPresent key clientenv (ProtocolVersion ver) su cu bypass auth =
|
clientCheckPresent key clientenv (ProtocolVersion ver) su cu bypass auth =
|
||||||
liftIO $ withClientM (cli su (B64Key key) cu bypass auth) clientenv $ \case
|
liftIO $ withClientM (cli su (B64Key key) cu bypass auth) clientenv $ \case
|
||||||
Left err -> return (Left err)
|
Left err -> return (Left err)
|
||||||
|
@ -207,7 +209,11 @@ clientCheckPresent key clientenv (ProtocolVersion ver) su cu bypass auth =
|
||||||
|
|
||||||
_ :<|> _ :<|> _ :<|> _ :<|>
|
_ :<|> _ :<|> _ :<|> _ :<|>
|
||||||
v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI
|
v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI
|
||||||
|
#else
|
||||||
|
clientCheckPresent _ = ()
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#ifdef WITH_SERVANT
|
||||||
clientRemove
|
clientRemove
|
||||||
:: ClientEnv
|
:: ClientEnv
|
||||||
-> ProtocolVersion
|
-> ProtocolVersion
|
||||||
|
@ -232,7 +238,9 @@ clientRemove clientenv (ProtocolVersion ver) key su cu bypass auth =
|
||||||
_ :<|> _ :<|> _ :<|> _ :<|>
|
_ :<|> _ :<|> _ :<|> _ :<|>
|
||||||
_ :<|> _ :<|> _ :<|> _ :<|>
|
_ :<|> _ :<|> _ :<|> _ :<|>
|
||||||
v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI
|
v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#ifdef WITH_SERVANT
|
||||||
clientRemoveBefore
|
clientRemoveBefore
|
||||||
:: ClientEnv
|
:: ClientEnv
|
||||||
-> ProtocolVersion
|
-> ProtocolVersion
|
||||||
|
@ -256,7 +264,9 @@ clientRemoveBefore clientenv (ProtocolVersion ver) key su cu bypass ts auth =
|
||||||
_ :<|> _ :<|> _ :<|> _ :<|>
|
_ :<|> _ :<|> _ :<|> _ :<|>
|
||||||
_ :<|> _ :<|> _ :<|> _ :<|>
|
_ :<|> _ :<|> _ :<|> _ :<|>
|
||||||
v3 :<|> _ = client p2pHttpAPI
|
v3 :<|> _ = client p2pHttpAPI
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#ifdef WITH_SERVANT
|
||||||
clientGetTimestamp
|
clientGetTimestamp
|
||||||
:: ClientEnv
|
:: ClientEnv
|
||||||
-> ProtocolVersion
|
-> ProtocolVersion
|
||||||
|
@ -279,7 +289,9 @@ clientGetTimestamp clientenv (ProtocolVersion ver) su cu bypass auth =
|
||||||
_ :<|> _ :<|> _ :<|> _ :<|>
|
_ :<|> _ :<|> _ :<|> _ :<|>
|
||||||
_ :<|>
|
_ :<|>
|
||||||
v3 :<|> _ = client p2pHttpAPI
|
v3 :<|> _ = client p2pHttpAPI
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#ifdef WITH_SERVANT
|
||||||
clientPut
|
clientPut
|
||||||
:: ClientEnv
|
:: ClientEnv
|
||||||
-> ProtocolVersion
|
-> ProtocolVersion
|
||||||
|
@ -374,7 +386,9 @@ clientPut clientenv (ProtocolVersion ver) k su cu bypass auth moffset af content
|
||||||
_ :<|>
|
_ :<|>
|
||||||
_ :<|>
|
_ :<|>
|
||||||
v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI
|
v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#ifdef WITH_SERVANT
|
||||||
clientPutOffset
|
clientPutOffset
|
||||||
:: ClientEnv
|
:: ClientEnv
|
||||||
-> ProtocolVersion
|
-> ProtocolVersion
|
||||||
|
@ -404,7 +418,9 @@ clientPutOffset clientenv (ProtocolVersion ver) k su cu bypass auth
|
||||||
_ :<|>
|
_ :<|>
|
||||||
_ :<|> _ :<|> _ :<|> _ :<|>
|
_ :<|> _ :<|> _ :<|> _ :<|>
|
||||||
v3 :<|> v2 :<|> v1 :<|> _ = client p2pHttpAPI
|
v3 :<|> v2 :<|> v1 :<|> _ = client p2pHttpAPI
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#ifdef WITH_SERVANT
|
||||||
clientLockContent
|
clientLockContent
|
||||||
:: ClientEnv
|
:: ClientEnv
|
||||||
-> ProtocolVersion
|
-> ProtocolVersion
|
||||||
|
@ -434,7 +450,9 @@ clientLockContent clientenv (ProtocolVersion ver) k su cu bypass auth =
|
||||||
_ :<|> _ :<|> _ :<|> _ :<|>
|
_ :<|> _ :<|> _ :<|> _ :<|>
|
||||||
_ :<|> _ :<|> _ :<|>
|
_ :<|> _ :<|> _ :<|>
|
||||||
v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI
|
v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#ifdef WITH_SERVANT
|
||||||
clientKeepLocked
|
clientKeepLocked
|
||||||
:: ClientEnv
|
:: ClientEnv
|
||||||
-> ProtocolVersion
|
-> ProtocolVersion
|
||||||
|
@ -487,4 +505,3 @@ clientKeepLocked clientenv (ProtocolVersion ver) lckid su cu bypass auth a = do
|
||||||
v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI
|
v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
-- ^ WITH_SERVANT
|
|
||||||
|
|
|
@ -437,10 +437,7 @@ inAnnex' repo rmt st@(State connpool duc _ _ _) key
|
||||||
| Git.repoIsUrl repo = checkremote
|
| Git.repoIsUrl repo = checkremote
|
||||||
| otherwise = checklocal
|
| otherwise = checklocal
|
||||||
where
|
where
|
||||||
checkp2phttp = p2pHttpClient rmt giveup
|
checkp2phttp = p2pHttpClient rmt giveup (clientCheckPresent key)
|
||||||
#ifdef WITH_SERVANT
|
|
||||||
(clientCheckPresent key)
|
|
||||||
#endif
|
|
||||||
checkhttp = do
|
checkhttp = do
|
||||||
gc <- Annex.getGitConfig
|
gc <- Annex.getGitConfig
|
||||||
Url.withUrlOptionsPromptingCreds $ \uo ->
|
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
|
| not $ Git.repoIsUrl repo = guardUsable repo (giveup "cannot access remote") $ do
|
||||||
u <- getUUID
|
u <- getUUID
|
||||||
hardlink <- wantHardLink
|
hardlink <- wantHardLink
|
||||||
let bwlimit = remoteAnnexBwLimitDownload (gitconfig r)
|
|
||||||
<|> remoteAnnexBwLimit (gitconfig r)
|
|
||||||
-- run copy from perspective of remote
|
-- run copy from perspective of remote
|
||||||
onLocalFast st $ Annex.Content.prepSendAnnex' key Nothing >>= \case
|
onLocalFast st $ Annex.Content.prepSendAnnex' key Nothing >>= \case
|
||||||
Just (object, _sz, check) -> do
|
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)))
|
(Ssh.runProto r connpool (return (False, UnVerified)))
|
||||||
key file dest meterupdate vc
|
key file dest meterupdate vc
|
||||||
| otherwise = giveup "copying from non-ssh, non-http remote not supported"
|
| 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 ())
|
copyFromRemoteCheap :: State -> Git.Repo -> Maybe (Key -> AssociatedFile -> FilePath -> Annex ())
|
||||||
#ifndef mingw32_HOST_OS
|
#ifndef mingw32_HOST_OS
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue