implemented serveCheckPresent

Still need a way to run Proto though
This commit is contained in:
Joey Hess 2024-07-09 09:08:42 -04:00
parent 9a592f946f
commit 751b8e0baf
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 19 additions and 6 deletions

View file

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

View file

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

View file

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