diff --git a/Command/P2PHttp.hs b/Command/P2PHttp.hs index 8b25cf8246..21a85b20c0 100644 --- 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 5acf1f25f9..aeb3d131bf 100644 --- 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