servant API type is complete

Command/P2PHttp.hs

@@ -12,14 +12,7 @@
 module Command.P2PHttp where
 
 import Command
-import qualified P2P.Protocol as P2P
+import P2P.Http
-import Utility.Base64
-import Utility.MonotonicClock
-
-import Servant
-import Servant.API.WebSocket
-import qualified Data.Text.Encoding as TE
-import qualified Data.ByteString as B
 
 cmd :: Command
 cmd = command "p2phttp" SectionPlumbing
@@ -28,93 +21,3 @@ cmd = command "p2phttp" SectionPlumbing
 
 seek :: CmdParams -> CommandSeek
 seek = error "TODO"
-
-type API
-	= "git-annex" 
-		:> (("key" :> CaptureKey) :<|> ("v3" :> "key" :> CaptureKey))
-		:> CommonParams Optional
-		:> AssociatedFileParam
-		:> OffsetParam
-		:> StreamGet NoFraming OctetStream (SourceIO B.ByteString)
-	:<|> "git-annex" :> "v3" :> "checkpresent"
-		:> KeyParam
-		:> CommonParams Required
-		:> Post '[JSON] CheckPresentResult
-	:<|> "git-annex" :> "v3" :> "lockcontent"
-		:> KeyParam
-		:> CommonParams Required
-		:> WebSocket
-	:<|> "git-annex" :> "v3" :> "remove"
-		:> KeyParam
-		:> CommonParams Required
-		:> Post '[JSON] RemoveResult
-	:<|> "git-annex" :> "v3" :> "remove-before"
-		:> KeyParam
-		:> CommonParams Required
-		:> QueryParam' '[Required] "timestamp" MonotonicTimestamp
-		:> Post '[JSON] RemoveResult
-	:<|> "git-annex" :> "v3" :> "gettimestamp"
-		:> CommonParams Required
-		:> Post '[JSON] GetTimestampResult
-	:<|> "git-annex" :> "v3" :> "put"
-		:> KeyParam
-		:> AssociatedFileParam
-		:> OffsetParam
-		:> Header' '[Required] "X-git-annex-object-size" ObjectSize
-		:> CommonParams Required
-		:> StreamBody NoFraming OctetStream (SourceIO B.ByteString)
-		:> Post '[JSON] PutResult
-
-type CommonParams req
-	= QueryParam' '[req] "clientuuid" B64UUID 
-	:> QueryParam' '[req] "serveruuid" B64UUID
-	:> QueryParams "bypass" B64UUID
-
-type CaptureKey = Capture "key" B64Key
-
-type KeyParam = QueryParam' '[Required] "key"
-
-type AssociatedFileParam = QueryParam "associatedfile" B64FilePath
-	
-type OffsetParam = QueryParam "offset" P2P.Offset
-
-type GetKey
-	= Capture "key" B64Key
-	:> CommonParams Optional
-	:> AssociatedFileParam
-	:> OffsetParam
-	:> StreamGet NoFraming OctetStream (SourceIO B.ByteString)
-
-newtype ObjectSize = ObjectSize Integer
-
-newtype CheckPresentResult = CheckPresentResult Bool
-
-newtype RemoveResult = RemoveResult Bool
-
-newtype GetTimestampResult = GetTimestmapResult MonotonicTimestamp
-
-newtype PutResult = PutResult Bool
-
--- Keys, UUIDs, and filenames are base64 encoded since Servant uses 
--- Text and so needs UTF-8.
-newtype B64Key = B64Key Key
-newtype B64UUID = B64UUID UUID
-newtype B64FilePath = B64FilePath RawFilePath
-
-instance FromHttpApiData B64Key where
-	parseUrlPiece t = case fromB64Maybe (TE.encodeUtf8 t) of
-		Nothing -> Left "unable to base64 decode key"
-		Just b -> maybe (Left "key parse error") (Right . B64Key)
-			(deserializeKey' b)
-
-instance FromHttpApiData B64UUID where
-	parseUrlPiece t = case fromB64Maybe (TE.encodeUtf8 t) of
-		Nothing -> Left "unable to base64 decode UUID"
-		Just b -> case toUUID b of
-			u@(UUID _) -> Right (B64UUID u)
-			NoUUID -> Left "empty UUID"
-
-instance FromHttpApiData B64FilePath where
-	parseUrlPiece t = case fromB64Maybe (TE.encodeUtf8 t) of
-		Nothing -> Left "unable to base64 decode filename"
-		Just b -> Right (B64FilePath b)

P2P/Http.hs

@@ -0,0 +1,167 @@
+{- P2P protocol over HTTP
+ -
+ - https://git-annex.branchable.com/design/p2p_protocol_over_http/
+ -
+ - Copyright 2024 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module P2P.Http where
+
+import Annex.Common
+import qualified P2P.Protocol as P2P
+import Utility.Base64
+import Utility.MonotonicClock
+
+import Servant
+import Servant.API.WebSocket
+import qualified Data.Text.Encoding as TE
+import qualified Data.ByteString as B
+
+type P2PAPI
+	= "git-annex" :> "key" :> CaptureKey :> GetAPI '[]
+	:<|> "git-annex" :> "v3" :> "key" :> CaptureKey
+		:> GetAPI '[DataLengthHeader]
+	:<|> "git-annex" :> "v2" :> "key" :> CaptureKey
+		:> GetAPI '[DataLengthHeader]
+	:<|> "git-annex" :> "v1" :> "key" :> CaptureKey
+		:> GetAPI '[DataLengthHeader]
+	:<|> "git-annex" :> "v0" :> "key" :> CaptureKey
+		:> GetAPI '[]
+	:<|> "git-annex" :> "v3" :> "checkpresent" :> CheckPresentAPI
+	:<|> "git-annex" :> "v2" :> "checkpresent" :> CheckPresentAPI
+	:<|> "git-annex" :> "v1" :> "checkpresent" :> CheckPresentAPI
+	:<|> "git-annex" :> "v0" :> "checkpresent" :> CheckPresentAPI
+	:<|> "git-annex" :> "v3" :> "lockcontent" :> LockContentAPI
+	:<|> "git-annex" :> "v2" :> "lockcontent" :> LockContentAPI
+	:<|> "git-annex" :> "v1" :> "lockcontent" :> LockContentAPI
+	:<|> "git-annex" :> "v0" :> "lockcontent" :> LockContentAPI
+	:<|> "git-annex" :> "v3" :> "remove" :> RemoveAPI RemoveResultPlus
+	:<|> "git-annex" :> "v2" :> "remove" :> RemoveAPI RemoveResultPlus
+	:<|> "git-annex" :> "v1" :> "remove" :> RemoveAPI RemoveResult
+	:<|> "git-annex" :> "v0" :> "remove" :> RemoveAPI RemoveResult
+	:<|> "git-annex" :> "v3" :> "remove-before" :> RemoveBeforeAPI
+	:<|> "git-annex" :> "v3" :> "gettimestamp" :> GetTimestampAPI
+	:<|> "git-annex" :> "v3" :> "put" :> DataLengthHeader
+		:> PutAPI PutResultPlus
+	:<|> "git-annex" :> "v2" :> "put" :> DataLengthHeader
+		:> PutAPI PutResultPlus
+	:<|> "git-annex" :> "v1" :> "put" :> DataLengthHeader
+		:> PutAPI PutResult
+	:<|> "git-annex" :> "v0" :> "put"
+		:> PutAPI PutResult
+	:<|> "git-annex" :> "v3" :> "putoffset"
+		:> PutOffsetAPI PutOffsetResultPlus
+	:<|> "git-annex" :> "v2" :> "putoffset"
+		:> PutOffsetAPI PutOffsetResultPlus
+	:<|> "git-annex" :> "v1" :> "putoffset"
+		:> PutOffsetAPI PutOffsetResult
+
+type GetAPI headers
+	= CommonParams Optional
+	:> AssociatedFileParam
+	:> OffsetParam
+	:> StreamGet NoFraming OctetStream
+		(Headers headers (SourceIO B.ByteString))
+
+type CheckPresentAPI
+	= KeyParam
+	:> CommonParams Required
+	:> Post '[JSON] CheckPresentResult
+		
+type LockContentAPI
+	= KeyParam
+	:> CommonParams Required
+	:> WebSocket
+
+type RemoveAPI result
+	= KeyParam
+	:> CommonParams Required
+	:> Post '[JSON] result
+		
+type RemoveBeforeAPI
+	= KeyParam
+	:> CommonParams Required
+	:> QueryParam' '[Required] "timestamp" MonotonicTimestamp
+	:> Post '[JSON] RemoveResult
+		
+type GetTimestampAPI
+	= CommonParams Required
+	:> Post '[JSON] GetTimestampResult
+		
+type PutAPI result
+	= KeyParam
+	:> CommonParams Required
+	:> AssociatedFileParam
+	:> OffsetParam
+	:> Header' '[Required] "X-git-annex-data-length" DataLength
+	:> CommonParams Required
+	:> StreamBody NoFraming OctetStream (SourceIO B.ByteString)
+	:> Post '[JSON] result
+
+type PutOffsetAPI result
+	= KeyParam
+	:> CommonParams Required
+	:> Post '[JSON] result
+
+type CommonParams req
+	= QueryParam' '[req] "clientuuid" B64UUID 
+	:> QueryParam' '[req] "serveruuid" B64UUID
+	:> QueryParams "bypass" B64UUID
+
+type CaptureKey = Capture "key" B64Key
+
+type KeyParam = QueryParam' '[Required] "key"
+
+type AssociatedFileParam = QueryParam "associatedfile" B64FilePath
+	
+type OffsetParam = QueryParam "offset" P2P.Offset
+
+type DataLengthHeader = Header "X-git-annex-data-length" Integer
+
+newtype DataLength = DataLength Integer
+
+newtype CheckPresentResult = CheckPresentResult Bool
+
+newtype RemoveResult = RemoveResult Bool
+
+data RemoveResultPlus = RemoveResultPlus Bool [UUID]
+
+newtype GetTimestampResult = GetTimestmapResult MonotonicTimestamp
+
+newtype PutResult = PutResult Bool
+
+data PutResultPlus = PutResultPlus Bool [UUID]
+
+newtype PutOffsetResult = PutOffsetResult P2P.Offset
+
+data PutOffsetResultPlus = PutOffsetResultPlus P2P.Offset [UUID]
+
+-- Keys, UUIDs, and filenames are base64 encoded since Servant uses 
+-- Text and so needs UTF-8.
+newtype B64Key = B64Key Key
+newtype B64UUID = B64UUID UUID
+newtype B64FilePath = B64FilePath RawFilePath
+
+instance FromHttpApiData B64Key where
+	parseUrlPiece t = case fromB64Maybe (TE.encodeUtf8 t) of
+		Nothing -> Left "unable to base64 decode key"
+		Just b -> maybe (Left "key parse error") (Right . B64Key)
+			(deserializeKey' b)
+
+instance FromHttpApiData B64UUID where
+	parseUrlPiece t = case fromB64Maybe (TE.encodeUtf8 t) of
+		Nothing -> Left "unable to base64 decode UUID"
+		Just b -> case toUUID b of
+			u@(UUID _) -> Right (B64UUID u)
+			NoUUID -> Left "empty UUID"
+
+instance FromHttpApiData B64FilePath where
+	parseUrlPiece t = case fromB64Maybe (TE.encodeUtf8 t) of
+		Nothing -> Left "unable to base64 decode filename"
+		Just b -> Right (B64FilePath b)

doc/design/p2p_protocol_over_http/draft1.mdwn

@@ -63,7 +63,7 @@ Any request may also optionally include these parameters:
   This parameter can be given multiple times to list several cluster
   gateway UUIDs.
 
-  This parameter is only available for v3 and above.
+  This parameter is only available for v2 and above.
 
 [Internally, git-annex can use these common parameters, plus the protocol
 version, to create a P2P session. The P2P session is driven through
@@ -79,7 +79,7 @@ It is not part of the P2P protocol per se, but is provided to let
 other clients than git-annex easily download the content of keys from the
 http server.
 
-This behaves almost the same as `GET /git-annex/v3/key/$key`, although its
+This behaves almost the same as `GET /git-annex/v0/key/$key`, although its
 behavior may change in later versions.
 
 When the key is not present on the server, this returns a 404 Not Found.

git-annex.cabal

@@ -324,6 +324,7 @@ Executable git-annex
     CPP-Options: -DWITH_SERVANT
     Other-Modules:
       Command.P2PHttp
+      P2P.Http
 
   if (os(windows))
     Build-Depends: