fix build without servant

P2P/Http/Client.hs

@@ -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
+	:: Key
-	-> ProtocolVersion
-	-> B64Key
-	-> B64UUID ServerSide
-	-> B64UUID ClientSide
-	-> [B64UUID Bypass]
 	-> Timestamp
-	-> Maybe Auth
+	-> ClientAction RemoveResultPlus
-	-> IO RemoveResultPlus
+#ifdef WITH_SERVANT
-clientRemoveBefore clientenv (ProtocolVersion ver) key su cu bypass ts auth =
+clientRemoveBefore k ts clientenv (ProtocolVersion ver) su cu bypass auth =
-	withClientM (cli su key cu bypass ts auth) clientenv $ \case
+	liftIO $ withClientM (cli su (B64Key k) cu bypass ts auth) clientenv return
-		Left err -> throwM err
-		Right res -> return res
   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
+	liftIO $ withClientM (cli su cu bypass auth) clientenv return
-		Left err -> throwM err
-		Right res -> return res
   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

P2P/Http/Types.hs

@@ -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

P2P/Http/Url.hs

@@ -66,15 +66,6 @@ parseP2PHttpUrl us
 			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
 		auth <- uriAuthority u
@@ -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

git-annex.cabal

@@ -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