implemented serveCheckPresent
Still need a way to run Proto though
This commit is contained in:
parent
9a592f946f
commit
751b8e0baf
3 changed files with 19 additions and 6 deletions
13
P2P/Http.hs
13
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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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.
|
||||
|
|
Loading…
Reference in a new issue