From 751b8e0baf4f2e7384a0cc66a3d3c8d15877b9e8 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 9 Jul 2024 09:08:42 -0400
Subject: [PATCH] implemented serveCheckPresent

Still need a way to run Proto though
---
 P2P/Http.hs                     | 13 ++++++++-----
 P2P/Http/State.hs               | 10 ++++++++++
 doc/todo/git-annex_proxies.mdwn |  2 +-
 3 files changed, 19 insertions(+), 6 deletions(-)

diff --git a/P2P/Http.hs b/P2P/Http.hs
index c58921435f..09cd1e3e6a 100644
--- a/P2P/Http.hs
+++ b/P2P/Http.hs
@@ -21,7 +21,6 @@ module P2P.Http (
 import Annex.Common
 import P2P.Http.Types
 import P2P.Http.State
-import Annex.UUID (genUUID)
 import qualified P2P.Protocol as P2P
 
 import Servant
@@ -29,9 +28,7 @@ import Servant.Client.Streaming
 import qualified Servant.Types.SourceT as S
 import Network.HTTP.Client (defaultManagerSettings, newManager)
 import qualified Data.ByteString as B
-import qualified Data.Map as M
 import Control.Concurrent
-import Control.Concurrent.Async
 import Control.Concurrent.STM
 
 type P2PHttpAPI
@@ -169,7 +166,14 @@ serveCheckPresent
 	-> B64UUID ServerSide
 	-> [B64UUID Bypass]
 	-> Handler CheckPresentResult
-serveCheckPresent = undefined
+serveCheckPresent st (B64Key k) cu su bypass = do
+	res <- liftIO $ inP2PConnection st cu su bypass $ P2P.checkPresent k
+	case res of
+		Right (Right b) -> return (CheckPresentResult b)
+		Right (Left err) ->
+			throwError $ err500 { errBody = encodeBL err }
+		Left err ->
+			throwError $ err500 { errBody = encodeBL err }
 
 clientCheckPresent
 	:: P2P.ProtocolVersion
@@ -520,7 +524,6 @@ testClientLock = do
 		[]
 		keeplocked
 
-
 type ClientUUID req = QueryParam' '[req] "clientuuid" (B64UUID ClientSide)
 
 type ServerUUID req = QueryParam' '[req] "serveruuid" (B64UUID ServerSide)
diff --git a/P2P/Http/State.hs b/P2P/Http/State.hs
index 5c888c1ab8..36ef235fc8 100644
--- a/P2P/Http/State.hs
+++ b/P2P/Http/State.hs
@@ -14,6 +14,7 @@ module P2P.Http.State where
 import Annex.Common
 import P2P.Http.Types
 import Annex.UUID (genUUID)
+import qualified P2P.Protocol as P2P
 
 import qualified Data.Map as M
 import Control.Concurrent.Async
@@ -27,6 +28,15 @@ mkP2PHttpServerState :: IO P2PHttpServerState
 mkP2PHttpServerState = P2PHttpServerState
 	<$> newTMVarIO mempty
 
+inP2PConnection
+	:: P2PHttpServerState
+	-> B64UUID ClientSide
+	-> B64UUID ServerSide
+	-> [B64UUID Bypass]
+	-> P2P.Proto a
+	-> IO (Either String a)
+inP2PConnection st cu su bypass a = undefined
+
 data Locker = Locker
 	{ lockerThread :: Async ()
 	, lockerVar :: TMVar Bool
diff --git a/doc/todo/git-annex_proxies.mdwn b/doc/todo/git-annex_proxies.mdwn
index 3caf27023e..f616f3558e 100644
--- a/doc/todo/git-annex_proxies.mdwn
+++ b/doc/todo/git-annex_proxies.mdwn
@@ -31,7 +31,7 @@ Planned schedule of work:
 * I have a file `servant.hs` in the httpproto branch that works through some of the
   bytestring streaming issues.
 
-* A Locker should expire the lock on its own after 10 minutes.
+* A Locker should expire the lock on its own after 10 minutes initially.
 
 * Since each held lock needs a connection to a proxy, the Locker
   could reference count, and avoid holding more than one lock per key.