implement clientRemove

Tested removal.

diff --git a/Command/P2PHttp.hs b/Command/P2PHttp.hs
index 8b25cf824674bb2fc8bb1fb4c48dde270b131cb8..21a85b20c02224d4e4a34cccec36e09f396b9bf8 100644 (file)
--- a/Command/P2PHttp.hs
+++ b/Command/P2PHttp.hs
@@ -71,7 +71,7 @@ seek o = startConcurrency commandStages $ do
        -- XXX remove this
        when (isNothing (portOption o)) $ do
                liftIO $ putStrLn "test begins"
-               testCheckPresent
+               testRemove
                giveup "TEST DONE" 
        withLocalP2PConnections $ \acquireconn -> liftIO $ do
                authenv <- getAuthEnv
@@ -155,3 +155,16 @@ testCheckPresent = do
                []
                Nothing
        liftIO $ print res
+
+testRemove = do
+       mgr <- httpManager <$> getUrlOptions
+       burl <- liftIO $ parseBaseUrl "http://localhost:8080/"
+       res <- liftIO $ clientRemove (mkClientEnv mgr burl)
+               (P2P.ProtocolVersion 3)
+               (B64Key (fromJust $ deserializeKey ("WORM-s30-m1720547401--foo" :: String)))
+               (B64UUID (toUUID ("cu" :: String)))
+               (B64UUID (toUUID ("f11773f0-11e1-45b2-9805-06db16768efe" :: String)))
+               []
+               Nothing
+       liftIO $ print res
+

diff --git a/P2P/Http.hs b/P2P/Http.hs
index 5acf1f25f90d5748bbfa75371ed547cd7c30e6a6..aeb3d131bf77d6cd63690c6c48bce20d38c5c24b 100644 (file)
--- a/P2P/Http.hs
+++ b/P2P/Http.hs
@@ -240,20 +240,26 @@ serveRemove st resultmangle apiver (B64Key k) cu su bypass sec auth = do
                        err500 { errBody = encodeBL err }
 
 clientRemove
-       :: ProtocolVersion
+       :: ClientEnv
+       -> ProtocolVersion
        -> B64Key
        -> B64UUID ClientSide
        -> B64UUID ServerSide
        -> [B64UUID Bypass]
        -> Maybe Auth
-       -> ClientM RemoveResultPlus
-clientRemove (ProtocolVersion ver) k cu su bypass auth = case ver of
-       3 -> v3 V3 k cu su bypass auth
-       2 -> v2 V2 k cu su bypass auth
-       1 -> plus <$> v1 V1 k cu su bypass auth
-       0 -> plus <$> v0 V0 k cu su bypass auth
-       _ -> error "unsupported protocol version"
+       -> IO RemoveResultPlus
+clientRemove clientenv (ProtocolVersion ver) key cu su bypass auth =
+       withClientM cli clientenv $ \case
+               Left err -> throwM err
+               Right res -> return res
   where
+       cli = case ver of
+               3 -> v3 V3 key cu su bypass auth
+               2 -> v2 V2 key cu su bypass auth
+               1 -> plus <$> v1 V1 key cu su bypass auth
+               0 -> plus <$> v0 V0 key cu su bypass auth
+               _ -> error "unsupported protocol version"
+       
        _ :<|> _ :<|> _ :<|> _ :<|>
                _ :<|> _ :<|> _ :<|> _ :<|>
                v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI