implemented serveCheckPresent

Still need a way to run Proto though

diff --git a/P2P/Http.hs b/P2P/Http.hs
index c58921435f9885c623b83dc56d7a850c899e5138..09cd1e3e6a1486670cfad7e79f3aa6d3e7e0e4eb 100644 (file)
--- 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 5c888c1ab8c0fa7f1e16b9ff38e64302ec82118a..36ef235fc8baf4a364af44b61a101d89aa548a1a 100644 (file)
--- 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 3caf27023e5a8ff24d3a2d807b83c6fe92d4fb46..f616f3558e5307c9f5e6b261b3821781e08beab7 100644 (file)
--- 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.