servant API type is complete

diff --git a/Command/P2PHttp.hs b/Command/P2PHttp.hs
index 2acf529f670e4fd7c1fcd11c01c72683e6c0ea00..7eb7270e3aedc5be76b4796e26ee655e5d5b67ca 100644 (file)
--- a/Command/P2PHttp.hs
+++ b/Command/P2PHttp.hs
@@ -12,14 +12,7 @@
 module Command.P2PHttp where
 
 import Command
-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
+import P2P.Http
 
 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)

diff --git a/P2P/Http.hs b/P2P/Http.hs
new file mode 100644 (file)
index 0000000..bb4cd3d
--- /dev/null
+++ 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)

diff --git a/doc/design/p2p_protocol_over_http/draft1.mdwn b/doc/design/p2p_protocol_over_http/draft1.mdwn
index 551cfd769b5831e0a933463fa03fa8d1669e1123..6841c66cc737c43926fd142ff25c007125b1cce3 100644 (file)
--- a/doc/design/p2p_protocol_over_http/draft1.mdwn
+++ 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.

diff --git a/git-annex.cabal b/git-annex.cabal
index b0b05d4334cca5230439a0fae4ec7a31182dae62..9d17fabfa6a15f3d77e37db7990563603608f229 100644 (file)
--- a/git-annex.cabal
+++ b/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: