Remote.Git retrieveKeyFile works with annex+http urls
This includes a bugfix to serveGet, it hung at the end.
This commit is contained in:
parent
a2d1844292
commit
7bd616e169
8 changed files with 67 additions and 189 deletions
|
@ -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
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue