started servant implementation of HTTP P2P protocol

diff --git a/BuildFlags.hs b/BuildFlags.hs
index c02814f1798166a22325b52ce92c988b47d71036..8526be4b99746865b94caabc49d4f5678e8d8d80 100644 (file)
--- a/BuildFlags.hs
+++ b/BuildFlags.hs
@@ -52,6 +52,11 @@ buildFlags = filter (not . null)
 #ifdef WITH_MAGICMIME
        , "MagicMime"
 #endif
+#ifdef WITH_SERVANT
+       , "Servant"
+#else
+#warning Building without servant, no git-annex p2phttp.
+#endif
 #ifdef WITH_BENCHMARK
        , "Benchmark"
 #endif

diff --git a/CHANGELOG b/CHANGELOG
index c14e78ed55b487223ea78e44224a0f05cf7ada65..2fedf040f40ba6c0b9ecf4616a228360a03e0a84 100644 (file)
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -5,6 +5,8 @@ git-annex (10.20240702) UNRELEASED; urgency=medium
   * Avoid potential data loss in situations where git-annex-shell or
     git-annex remotedaemon is killed while locking a key to prevent its
     removal.
+  * New HTTP API that is equivilant to the P2P protocol.
+  * Added a build flag for servant, enabling git-annex p2phttp.
   * Added a dependency on clock.
 
  -- Joey Hess <id@joeyh.name>  Tue, 02 Jul 2024 12:14:53 -0400

diff --git a/CmdLine/GitAnnex.hs b/CmdLine/GitAnnex.hs
index 8e0a1375315a2eba5c80dec9d60d6028d851009b..afa41f4dd083658b678695190b815feac3bab75a 100644 (file)
--- a/CmdLine/GitAnnex.hs
+++ b/CmdLine/GitAnnex.hs
@@ -1,6 +1,6 @@
 {- git-annex main program
  -
- - Copyright 2010-2022 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2024 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -118,6 +118,9 @@ import qualified Command.Upgrade
 import qualified Command.Forget
 import qualified Command.OldKeys
 import qualified Command.P2P
+#ifdef WITH_SERVANT
+import qualified Command.P2PHttp
+#endif
 import qualified Command.Proxy
 import qualified Command.DiffDriver
 import qualified Command.Smudge
@@ -245,6 +248,9 @@ cmds testoptparser testrunner mkbenchmarkgenerator = map addGitAnnexCommonOption
        , Command.Forget.cmd
        , Command.OldKeys.cmd
        , Command.P2P.cmd
+#ifdef WITH_SERVANT
+       , Command.P2PHttp.cmd
+#endif
        , Command.Proxy.cmd
        , Command.DiffDriver.cmd
        , Command.Smudge.cmd

diff --git a/Command/P2PHttp.hs b/Command/P2PHttp.hs
new file mode 100644 (file)
index 0000000..2acf529
--- /dev/null
+++ b/Command/P2PHttp.hs
@@ -0,0 +1,120 @@
+{- git-annex command
+ -
+ - Copyright 2024 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+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
+
+cmd :: Command
+cmd = command "p2phttp" SectionPlumbing
+       "communicate in P2P protocol over http"
+       paramNothing (withParams seek)
+
+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/doc/design/p2p_protocol_over_http/draft1.mdwn b/doc/design/p2p_protocol_over_http/draft1.mdwn
index 656fc08ceedb31ca001217688ee5101997f04f44..7ad9bc5c92e76f13391fd8be21ac4f6445ab2446 100644 (file)
--- a/doc/design/p2p_protocol_over_http/draft1.mdwn
+++ b/doc/design/p2p_protocol_over_http/draft1.mdwn
@@ -2,6 +2,18 @@
 
 Draft 1 of a complete [[P2P_protocol]] over HTTP.
 
+## base64 encoding of keys, uuids, and filenames
+
+A git-annex key can contain text in any encoding. So can a filename,
+and it's even possible, though unlikely, that the UUID of a git-annex
+repository might.
+
+But this protocol requires that UTF-8 be used throughout, except 
+where bodies use `Content-Type: application/octet-stream`.
+
+So, all git-annex keys, uuids, and filenames in this protocol are
+base64 encoded.
+
 ## authentication
 
 A git-annex protocol endpoint can optionally operate in readonly mode without
@@ -227,7 +239,7 @@ Example:
 
     > POST /git-annex/v3/put?key=SHA1--foo&associatedfile=bar&clientuuid=79a5a1f4-07e8-11ef-873d-97f93ca91925&serveruuid=ecf6d4ca-07e8-11ef-8990-9b8c1f696bf6 HTTP/1.1
     > Content-Type: application/octet-stream
-    > X-git-annex-object-size: 3
+    > X-git-annex-data-length: 3
     > 
     > foo
     < {"stored": true}

diff --git a/doc/git-annex-p2phttp.mdwn b/doc/git-annex-p2phttp.mdwn
new file mode 100644 (file)
index 0000000..f4758ed
--- /dev/null
+++ b/doc/git-annex-p2phttp.mdwn
@@ -0,0 +1,31 @@
+# NAME
+
+git-annex-p2phttp - HTTP server for git-annex P2P protocol
+
+# SYNOPSIS
+
+git-annex p2phttp [params ...]
+
+# DESCRIPTION
+
+This allows a git-annex repository to be accessed over HTTP.
+It is the git-annex equivilant of git-http-backend(1), for serving
+a repository over HTTP with write access for authenticated users.
+
+# SEE ALSO
+
+[[git-annex]](1)
+
+git-http-backend(1)
+
+[[git-annex-shell]](1)
+
+<https://git-annex.branchable.com/design/p2p_protocol_over_http/>
+
+# AUTHOR
+
+Joey Hess <id@joeyh.name>
+
+<http://git-annex.branchable.com/>
+
+Warning: Automatically converted into a man page by mdwn2man. Edit with care

diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index 51438ef7d97bf1c808d258569734c8672a249146..1bb178dc00b50888af0ad19c49691a83dc2afe9c 100644 (file)
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -212,6 +212,13 @@ content from the key-value store.
 
   See [[git-annex-webapp]](1) for details.
 
+* `p2phttp`
+
+  Allows a git-annex repository to be accessed over HTTP using git-annex
+  p2p protocol.
+
+  See [[git-annex-p2phttp]](1) for details.
+
 * `remotedaemon`
 
   Persistant communication with remotes.

diff --git a/git-annex.cabal b/git-annex.cabal
index d52580e24b30b327dd6f0cc10c889fd5495baadd..b0b05d4334cca5230439a0fae4ec7a31182dae62 100644 (file)
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -173,6 +173,9 @@ Flag MagicMime
 Flag Crypton
   Description: Use the crypton library rather than the no longer maintained cryptonite
 
+Flag Servant
+  Description: Use the servant library, enabling git-annex p2phttp
+
 Flag Benchmark
   Description: Enable benchmarking
   Default: True
@@ -312,6 +315,16 @@ Executable git-annex
   else
     Build-Depends: cryptonite (>= 0.23)
 
+  if flag(Servant)
+    Build-Depends:
+      servant-server,
+      servant-client,
+      servant-websockets,
+      websockets
+    CPP-Options: -DWITH_SERVANT
+    Other-Modules:
+      Command.P2PHttp
+
   if (os(windows))
     Build-Depends:
       Win32 ((>= 2.6.1.0 && < 2.12.0.0) || >= 2.13.4.0),

diff --git a/stack.yaml b/stack.yaml
index 077028faa531976ffcc357499d9c7ae874d62263..6b56dc547ea42db8d65b3b2d3c458c7383c0ec98 100644 (file)
--- a/stack.yaml
+++ b/stack.yaml
@@ -10,6 +10,7 @@ flags:
     debuglocks: false
     benchmark: true
     crypton: true
+    servant: true
 packages:
 - '.'
 resolver: lts-22.9