fix build without servant
authorJoey Hess <joeyh@joeyh.name>
Wed, 24 Jul 2024 19:12:16 +0000 (15:12 -0400)
committerJoey Hess <joeyh@joeyh.name>
Wed, 24 Jul 2024 19:13:02 +0000 (15:13 -0400)
P2P/Http/Client.hs
P2P/Http/Types.hs
P2P/Http/Url.hs
git-annex.cabal

index 9fb35d067e787380bc9832a754ee11f773feaf82..2de5c907c40c4e005ba55923db36037c1ad5f900 100644 (file)
@@ -18,21 +18,22 @@ module P2P.Http.Client (
 ) where
 
 import Types
-import Annex.Url
+import P2P.Http.Types
+import P2P.Protocol hiding (Offset, Bypass, auth, FileSize)
+import Utility.Metered
+import Utility.FileSize
+import Types.NumCopies
 
 #ifdef WITH_SERVANT
 import qualified Annex
 import Annex.UUID
+import Annex.Url
 import Types.Remote
-import Types.NumCopies
 import P2P.Http
 import P2P.Http.Url
-import P2P.Http.Types
 import Annex.Common
-import P2P.Protocol hiding (Offset, Bypass, auth)
 import Annex.Concurrent
 import Utility.Url (BasicAuth(..))
-import Utility.Metered
 import Utility.HumanTime
 import qualified Git.Credential as Git
 
@@ -42,7 +43,6 @@ import qualified Servant.Types.SourceT as S
 import Network.HTTP.Types.Status
 import Network.HTTP.Client
 import qualified Data.ByteString as B
-import qualified Data.ByteString.Lazy as L
 import qualified Data.ByteString.Lazy.Internal as LI
 import qualified Data.Map as M
 import Data.Time.Clock.POSIX
@@ -51,6 +51,7 @@ import Control.Concurrent.Async
 import Control.Concurrent
 import System.IO.Unsafe
 #endif
+import qualified Data.ByteString.Lazy as L
 
 type ClientAction a
 #ifdef WITH_SERVANT
@@ -143,11 +144,10 @@ p2pHttpClient rmt fallback clientaction =
                                        M.insert (Git.CredentialBaseURL credentialbaseurl) cred cc
                Nothing -> noop
 #else
-runP2PHttpClient rmt fallback () = fallback
+p2pHttpClient _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
        :: Key
        -> AssociatedFile
@@ -157,6 +157,7 @@ clientGet
        -> Maybe FileSize
        -- ^ Size of existing file, when resuming.
        -> ClientAction Validity
+#ifdef WITH_SERVANT
 clientGet k af consumer startsz clientenv (ProtocolVersion ver) su cu bypass auth = liftIO $ do
        let offset = fmap (Offset . fromIntegral) startsz
        withClientM (cli (B64Key k) cu bypass baf offset auth) clientenv $ \case
@@ -188,7 +189,7 @@ clientGet k af consumer startsz clientenv (ProtocolVersion ver) su cu bypass aut
        
        baf = associatedFileToB64FilePath af
 #else
-clientGet _ _ _ = ()
+clientGet _ _ _ = ()
 #endif
 
 clientCheckPresent :: Key -> ClientAction Bool
@@ -211,11 +212,11 @@ clientCheckPresent key clientenv (ProtocolVersion ver) su cu bypass auth =
 clientCheckPresent _ = ()
 #endif
 
-#ifdef WITH_SERVANT
 clientRemove
        :: Maybe SafeDropProof
        -> Key
        -> ClientAction RemoveResultPlus
+#ifdef WITH_SERVANT
 clientRemove proof k clientenv (ProtocolVersion ver) su cu bypass auth =
        liftIO $ withClientM cli clientenv return
   where
@@ -235,21 +236,13 @@ clientRemove proof k clientenv (ProtocolVersion ver) su cu bypass auth =
 clientRemove _ _ = ()
 #endif
 
-#ifdef WITH_SERVANT
 clientRemoveBefore
-       :: ClientEnv
-       -> ProtocolVersion
-       -> B64Key
-       -> B64UUID ServerSide
-       -> B64UUID ClientSide
-       -> [B64UUID Bypass]
+       :: Key
        -> Timestamp
-       -> Maybe Auth
-       -> IO RemoveResultPlus
-clientRemoveBefore clientenv (ProtocolVersion ver) key su cu bypass ts auth =
-       withClientM (cli su key cu bypass ts auth) clientenv $ \case
-               Left err -> throwM err
-               Right res -> return res
+       -> ClientAction RemoveResultPlus
+#ifdef WITH_SERVANT
+clientRemoveBefore k ts clientenv (ProtocolVersion ver) su cu bypass auth =
+       liftIO $ withClientM (cli su (B64Key k) cu bypass ts auth) clientenv return
   where
        cli = case ver of
                3 -> flip v3 V3
@@ -259,21 +252,14 @@ clientRemoveBefore clientenv (ProtocolVersion ver) key su cu bypass ts auth =
                _ :<|> _ :<|> _ :<|> _ :<|>
                _ :<|> _ :<|> _ :<|> _ :<|>
                v3 :<|> _ = client p2pHttpAPI
+#else
+clientRemoveBefore _ _ = ()
 #endif
 
+clientGetTimestamp :: ClientAction GetTimestampResult
 #ifdef WITH_SERVANT
-clientGetTimestamp
-       :: ClientEnv
-       -> ProtocolVersion
-       -> B64UUID ServerSide
-       -> B64UUID ClientSide
-       -> [B64UUID Bypass]
-       -> Maybe Auth
-       -> IO GetTimestampResult
 clientGetTimestamp clientenv (ProtocolVersion ver) su cu bypass auth = 
-       withClientM (cli su cu bypass auth) clientenv $ \case
-               Left err -> throwM err
-               Right res -> return res
+       liftIO $ withClientM (cli su cu bypass auth) clientenv return
   where
        cli = case ver of
                3 -> flip v3 V3
@@ -284,9 +270,10 @@ clientGetTimestamp clientenv (ProtocolVersion ver) su cu bypass auth =
                _ :<|> _ :<|> _ :<|> _ :<|>
                _ :<|>
                v3 :<|> _ = client p2pHttpAPI
+#else
+clientGetTimestamp = ()
 #endif
 
-#ifdef WITH_SERVANT
 clientPut
        :: MeterUpdate
        -> Key
@@ -297,6 +284,7 @@ clientPut
        -> Annex Bool
        -- ^ Called after sending the file to check if it's valid.
        -> ClientAction PutResultPlus
+#ifdef WITH_SERVANT
 clientPut meterupdate k moffset af contentfile contentfilesize validitycheck clientenv (ProtocolVersion ver) su cu bypass auth = do
        checkv <- liftIO newEmptyTMVarIO
        checkresultv <- liftIO newEmptyTMVarIO
@@ -383,10 +371,10 @@ clientPut meterupdate k moffset af contentfile contentfilesize validitycheck cli
 clientPut _ _ _ _ _ _ _ = ()
 #endif
 
-#ifdef WITH_SERVANT
 clientPutOffset
        :: Key
        -> ClientAction PutOffsetResultPlus
+#ifdef WITH_SERVANT
 clientPutOffset k clientenv (ProtocolVersion ver) su cu bypass auth
        | ver == 0 = return (Right (PutOffsetResultPlus (Offset 0)))
        | otherwise = liftIO $ withClientM cli clientenv return
@@ -410,10 +398,10 @@ clientPutOffset k clientenv (ProtocolVersion ver) su cu bypass auth
 clientPutOffset _ = ()
 #endif
 
-#ifdef WITH_SERVANT
 clientLockContent
        :: Key
        -> ClientAction LockResult
+#ifdef WITH_SERVANT
 clientLockContent k clientenv (ProtocolVersion ver) su cu bypass auth = 
        liftIO $ withClientM (cli (B64Key k) cu bypass auth) clientenv return
   where
@@ -436,7 +424,6 @@ clientLockContent k clientenv (ProtocolVersion ver) su cu bypass auth =
 clientLockContent _ = ()
 #endif
 
-#ifdef WITH_SERVANT
 clientKeepLocked
        :: LockID
        -> UUID
@@ -446,6 +433,7 @@ clientKeepLocked
        -- server. The lock will remain held until the callback returns,
        -- and then will be dropped.
        -> ClientAction a
+#ifdef WITH_SERVANT
 clientKeepLocked lckid remoteuuid unablelock callback clientenv (ProtocolVersion ver) su cu bypass auth = do
        readyv <- liftIO newEmptyTMVarIO
        keeplocked <- liftIO newEmptyTMVarIO
index 963cd918a96288bc5049de256bcdcdda2cd44709..0471d07e2429147f1b62629f63a2efa0652be751 100644 (file)
@@ -11,6 +11,7 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE CPP #-}
 
 module P2P.Http.Types where
 
@@ -18,14 +19,16 @@ import Annex.Common
 import qualified P2P.Protocol as P2P
 import Utility.MonotonicClock
 
+#ifdef WITH_SERVANT
 import Servant
+import Data.Aeson hiding (Key)
+import Text.Read (readMaybe)
+#endif
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as TE
 import qualified Data.ByteString as B
 import Codec.Binary.Base64Url as B64
 import Data.Char
-import Text.Read (readMaybe)
-import Data.Aeson hiding (Key)
 import Control.DeepSeq
 import GHC.Generics (Generic)
 
@@ -144,6 +147,8 @@ newtype UnlockRequest = UnlockRequest Bool
 data Auth = Auth B.ByteString B.ByteString
        deriving (Show, Generic, NFData, Eq, Ord)
 
+#ifdef WITH_SERVANT
+
 instance ToHttpApiData Auth where
        toHeader (Auth u p) = "Basic " <> B64.encode (u <> ":" <> p)
        toUrlPiece = TE.decodeUtf8Lenient . toHeader
@@ -390,3 +395,4 @@ instance PlusClass PutOffsetResultPlus PutOffsetResult where
        plus (PutOffsetResult o) = PutOffsetResultPlus o
        plus PutOffsetResultAlreadyHave = PutOffsetResultAlreadyHavePlus []
 
+#endif
index 6d308741c928c8d2862cd76276dfd2cd720c563b..1cc18a921409b11b9159728ddc87db3b1974bf5d 100644 (file)
@@ -65,15 +65,6 @@ parseP2PHttpUrl us
                case UUID.fromString p of
                        Nothing -> Nothing
                        Just _ -> return (UUID (encodeBS p)) 
-       
-       -- The servant server uses urls that start with "/git-annex/",
-       -- and so the servant client adds that to the base url. So remove
-       -- it from the url that the user provided. However, it may not be
-       -- present, eg if some other server is speaking the git-annex
-       -- protocol. The UUID is also removed from the end of the url.
-       basepath u = case drop 1 $ reverse $ P.splitDirectories (uriPath u) of
-               ("git-annex":"/":rest) -> P.joinPath (reverse rest)
-               rest -> P.joinPath (reverse rest)
 
 #ifdef WITH_SERVANT
        mkbaseurl s u = do
@@ -87,6 +78,15 @@ parseP2PHttpUrl us
                        , baseUrlPath = basepath u
                        , baseUrlPort = port
                        }
+       
+       -- The servant server uses urls that start with "/git-annex/",
+       -- and so the servant client adds that to the base url. So remove
+       -- it from the url that the user provided. However, it may not be
+       -- present, eg if some other server is speaking the git-annex
+       -- protocol. The UUID is also removed from the end of the url.
+       basepath u = case drop 1 $ reverse $ P.splitDirectories (uriPath u) of
+               ("git-annex":"/":rest) -> P.joinPath (reverse rest)
+               rest -> P.joinPath (reverse rest)
 #endif
 
 p2pHttpUrlWithoutUUID :: String -> String
index 452ab2489e9bd7f024bf3f82f7e109bcb48c733a..47f53613724edb75dbc0a0a37a708edbb75c5efd 100644 (file)
@@ -329,7 +329,6 @@ Executable git-annex
       P2P.Http
       P2P.Http.Server
       P2P.Http.State
-      P2P.Http.Types
 
   if (os(windows))
     Build-Depends:
@@ -897,6 +896,7 @@ Executable git-annex
     P2P.Address
     P2P.Annex
     P2P.Auth
+    P2P.Http.Types
     P2P.Http.Client
     P2P.Http.Url
     P2P.IO