implement remove-before

The reason to use removeBeforeRemoteEndTime is twofold.

First, removeBefore sends two protocol commands. Currently, the HTTP
protocol runner only supports sending a single command per invocation.

Secondly, the http server gets a monotonic timestamp from the client. So
translating back to a POSIXTime would be annoying.

The timestamp flow with a proxy will be:

- client gets timestamp, which gets the monotonic timestamp from the
  proxied remote via the proxy. The timestamp is currently not
  proxied when there is a single proxy.
- client calls remove-before
- http server calls removeBeforeRemoteEndTime which sends REMOVE-BEFORE
  to the proxied remote.
This commit is contained in:
Joey Hess 2024-07-10 10:03:26 -04:00
parent e9cba0a580
commit 7c588a5791
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
4 changed files with 65 additions and 38 deletions

View file

@ -16,6 +16,8 @@ import P2P.Http
import qualified P2P.Protocol as P2P
import Annex.Url
import Utility.Env
import Utility.ThreadScheduler
import Utility.MonotonicClock
import qualified Network.Wai.Handler.Warp as Warp
import Servant
@ -71,7 +73,7 @@ seek o = startConcurrency commandStages $ do
-- XXX remove this
when (isNothing (portOption o)) $ do
liftIO $ putStrLn "test begins"
testRemove
testRemoveBefore
giveup "TEST DONE"
withLocalP2PConnections $ \acquireconn -> liftIO $ do
authenv <- getAuthEnv
@ -149,7 +151,7 @@ testCheckPresent = do
burl <- liftIO $ parseBaseUrl "http://localhost:8080/"
res <- liftIO $ clientCheckPresent (mkClientEnv mgr burl)
(P2P.ProtocolVersion 3)
(B64Key (fromJust $ deserializeKey ("WORM-s30-m1720547401--foo" :: String)))
(B64Key (fromJust $ deserializeKey ("WORM-s30-m1720617630--bar" :: String)))
(B64UUID (toUUID ("cu" :: String)))
(B64UUID (toUUID ("f11773f0-11e1-45b2-9805-06db16768efe" :: String)))
[]
@ -168,3 +170,20 @@ testRemove = do
Nothing
liftIO $ print res
testRemoveBefore = do
mgr <- httpManager <$> getUrlOptions
burl <- liftIO $ parseBaseUrl "http://localhost:8080/"
MonotonicTimestamp t <- liftIO currentMonotonicTimestamp
--liftIO $ threadDelaySeconds (Seconds 10)
let ts = MonotonicTimestamp (t + 10)
liftIO $ print ("running with timestamp", ts)
res <- liftIO $ clientRemoveBefore (mkClientEnv mgr burl)
(P2P.ProtocolVersion 3)
(B64Key (fromJust $ deserializeKey ("WORM-s30-m1720617630--bar" :: String)))
(B64UUID (toUUID ("cu" :: String)))
(B64UUID (toUUID ("f11773f0-11e1-45b2-9805-06db16768efe" :: String)))
[]
(Timestamp ts)
Nothing
liftIO $ print res