Remote.Git retrieveKeyFile works with annex+http urls

This includes a bugfix to serveGet, it hung at the end.
This commit is contained in:
Joey Hess 2024-07-24 09:45:14 -04:00
parent a2d1844292
commit 7bd616e169
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
8 changed files with 67 additions and 189 deletions

View file

@ -13,18 +13,13 @@ module Command.P2PHttp where
import Command
import P2P.Http.Server
import P2P.Http.Client
import P2P.Http.Url
import qualified P2P.Protocol as P2P
import Annex.Url
import Utility.Env
import Utility.MonotonicClock
import Servant
import qualified Network.Wai.Handler.Warp as Warp
import qualified Network.Wai.Handler.WarpTLS as Warp
import Servant
import Servant.Client.Streaming
import Control.Concurrent.STM
import Network.Socket (PortNumber)
import qualified Data.Map as M
import Data.String
@ -161,138 +156,3 @@ getAuthEnv = do
case M.lookup user permmap of
Nothing -> (auth, P2P.ServeReadWrite)
Just perms -> (auth, perms)
testLocking = do
mgr <- httpManager <$> getUrlOptions
burl <- liftIO $ parseBaseUrl "http://localhost:8080/"
let k = B64Key (fromJust $ deserializeKey ("SHA256E-s6--5891b5b522d5df086d0ff0b110fbd9d21bb4fc7163af34d08286a2e846f6be03" :: String))
res <- liftIO $ clientLockContent (mkClientEnv mgr burl)
(P2P.ProtocolVersion 3)
k
(B64UUID (toUUID ("f11773f0-11e1-45b2-9805-06db16768efe" :: String)))
(B64UUID (toUUID ("cu" :: String)))
[]
Nothing
case res of
LockResult True (Just lckid) ->
liftIO $ clientKeepLocked (mkClientEnv mgr burl)
(P2P.ProtocolVersion 3)
lckid
(B64UUID (toUUID ("f11773f0-11e1-45b2-9805-06db16768efe" :: String)))
(B64UUID (toUUID ("cu" :: String)))
[]
Nothing $ \keeplocked -> do
print "running, press enter to drop lock"
_ <- getLine
atomically $ writeTMVar keeplocked False
_ -> liftIO $ print ("lockin failed", res)
testLockContent = do
mgr <- httpManager <$> getUrlOptions
burl <- liftIO $ parseBaseUrl "http://localhost:8080/"
res <- liftIO $ clientLockContent (mkClientEnv mgr burl)
(P2P.ProtocolVersion 3)
(B64Key (fromJust $ deserializeKey ("SHA256E-s6--5891b5b522d5df086d0ff0b110fbd9d21bb4fc7163af34d08286a2e846f6be03" :: String)))
(B64UUID (toUUID ("f11773f0-11e1-45b2-9805-06db16768efe" :: String)))
(B64UUID (toUUID ("cu" :: String)))
[]
Nothing
liftIO $ print res
testKeepLocked = do
mgr <- httpManager <$> getUrlOptions
burl <- liftIO $ parseBaseUrl "http://localhost:8080/"
liftIO $ clientKeepLocked (mkClientEnv mgr burl)
(P2P.ProtocolVersion 3)
(B64UUID (toUUID ("lck" :: String)))
(B64UUID (toUUID ("f11773f0-11e1-45b2-9805-06db16768efe" :: String)))
(B64UUID (toUUID ("cu" :: String)))
[]
Nothing $ \keeplocked -> do
print "running, press enter to drop lock"
_ <- getLine
atomically $ writeTMVar keeplocked False
testGet = do
mgr <- httpManager <$> getUrlOptions
burl <- liftIO $ parseBaseUrl "http://localhost:8080/"
res <- liftIO $ clientGet (mkClientEnv mgr burl)
(P2P.ProtocolVersion 3)
(B64Key (fromJust $ deserializeKey ("SHA256E-s1048576000--e3b67ce72aa2571c799d6419e3e36828461ac1c78f8ef300c7f9c8ae671c517f" :: String)))
(B64UUID (toUUID ("f11773f0-11e1-45b2-9805-06db16768efe" :: String)))
(B64UUID (toUUID ("cu" :: String)))
[]
Nothing
Nothing
"outfile"
liftIO $ print res
testPut = do
mgr <- httpManager <$> getUrlOptions
burl <- liftIO $ parseBaseUrl "http://localhost:8080/"
res <- clientPut (mkClientEnv mgr burl)
(P2P.ProtocolVersion 3)
(B64Key (fromJust $ deserializeKey ("SHA256E-s1048576000--b460ca923520db561d01b99483e9e2fe65ff9dfbdd52c17acba6ac4e874e27d5")))
(B64UUID (toUUID ("f11773f0-11e1-45b2-9805-06db16768efe" :: String)))
(B64UUID (toUUID ("cu" :: String)))
[]
Nothing
Nothing
(AssociatedFile (Just "foo"))
"emptyfile"
0
(liftIO (print "validity check") >> return False)
liftIO $ print res
testPutOffset = do
mgr <- httpManager <$> getUrlOptions
burl <- liftIO $ parseBaseUrl "http://localhost:8080/"
res <- liftIO $ clientPutOffset (mkClientEnv mgr burl)
(P2P.ProtocolVersion 3)
(B64Key (fromJust $ deserializeKey ("SHA256E-s1048576000--b460ca923520db561d01b99483e9e2fe65ff9dfbdd52c17acba6ac4e874e27d5")))
(B64UUID (toUUID ("f11773f0-11e1-45b2-9805-06db16768efe" :: String)))
(B64UUID (toUUID ("cu" :: String)))
[]
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 ("f11773f0-11e1-45b2-9805-06db16768efe" :: String)))
(B64UUID (toUUID ("cu" :: String)))
[]
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 ("f11773f0-11e1-45b2-9805-06db16768efe" :: String)))
(B64UUID (toUUID ("cu" :: String)))
[]
(Timestamp ts)
Nothing
liftIO $ print res
testGetTimestamp = do
mgr <- httpManager <$> getUrlOptions
burl <- liftIO $ parseBaseUrl "http://localhost:8080/"
res <- liftIO $ clientGetTimestamp (mkClientEnv mgr burl)
(P2P.ProtocolVersion 3)
(B64UUID (toUUID ("f11773f0-11e1-45b2-9805-06db16768efe" :: String)))
(B64UUID (toUUID ("cu" :: String)))
[]
Nothing
liftIO $ print res