clientPut seeking to offset
This commit is contained in:
parent
a01426b713
commit
b240a11b79
3 changed files with 19 additions and 15 deletions
|
@ -177,16 +177,16 @@ testPut = do
|
||||||
burl <- liftIO $ parseBaseUrl "http://localhost:8080/"
|
burl <- liftIO $ parseBaseUrl "http://localhost:8080/"
|
||||||
res <- clientPut (mkClientEnv mgr burl)
|
res <- clientPut (mkClientEnv mgr burl)
|
||||||
(P2P.ProtocolVersion 3)
|
(P2P.ProtocolVersion 3)
|
||||||
(B64Key (fromJust $ deserializeKey ("WORM-s30-m1720547401--foo")))
|
(B64Key (fromJust $ deserializeKey ("SHA256E-s1048576000--b460ca923520db561d01b99483e9e2fe65ff9dfbdd52c17acba6ac4e874e27d5")))
|
||||||
(B64UUID (toUUID ("f11773f0-11e1-45b2-9805-06db16768efe" :: String)))
|
(B64UUID (toUUID ("f11773f0-11e1-45b2-9805-06db16768efe" :: String)))
|
||||||
(B64UUID (toUUID ("cu" :: String)))
|
(B64UUID (toUUID ("cu" :: String)))
|
||||||
[]
|
[]
|
||||||
Nothing
|
Nothing
|
||||||
Nothing
|
(Just (Offset 584754208))
|
||||||
(AssociatedFile (Just "foo"))
|
(AssociatedFile (Just "foo"))
|
||||||
"foocontent"
|
"bigfile3content"
|
||||||
30
|
1048576000
|
||||||
(liftIO (print "validity check") >> return False)
|
(liftIO (print "validity check") >> return True)
|
||||||
liftIO $ print res
|
liftIO $ print res
|
||||||
|
|
||||||
testRemove = do
|
testRemove = do
|
||||||
|
|
22
P2P/Http.hs
22
P2P/Http.hs
|
@ -547,7 +547,7 @@ servePut st resultmangle su apiver (DataLength len) (B64Key k) cu bypass baf mof
|
||||||
tooshortv <- liftIO newEmptyTMVarIO
|
tooshortv <- liftIO newEmptyTMVarIO
|
||||||
content <- liftIO $ S.unSourceT stream (gather validityv tooshortv)
|
content <- liftIO $ S.unSourceT stream (gather validityv tooshortv)
|
||||||
res <- withP2PConnection' apiver st cu su bypass sec auth WriteAction
|
res <- withP2PConnection' apiver st cu su bypass sec auth WriteAction
|
||||||
(\st -> st { connectionWaitVar = False }) $ \conn ->
|
(\cst -> cst { connectionWaitVar = False }) $ \conn ->
|
||||||
liftIO (protoaction conn content validitycheck)
|
liftIO (protoaction conn content validitycheck)
|
||||||
`finally` checktooshort conn tooshortv
|
`finally` checktooshort conn tooshortv
|
||||||
case res of
|
case res of
|
||||||
|
@ -645,7 +645,11 @@ clientPut clientenv (ProtocolVersion ver) k su cu bypass auth moffset af content
|
||||||
liftIO $ atomically $ takeTMVar checkv
|
liftIO $ atomically $ takeTMVar checkv
|
||||||
validitycheck >>= liftIO . atomically . putTMVar checkresultv
|
validitycheck >>= liftIO . atomically . putTMVar checkresultv
|
||||||
checkerthread <- liftIO . async =<< forkState checker
|
checkerthread <- liftIO . async =<< forkState checker
|
||||||
liftIO (withClientM (cli (stream checkv checkresultv)) clientenv return) >>= \case
|
v <- liftIO $ withBinaryFile contentfile ReadMode $ \h -> do
|
||||||
|
when (offset /= 0) $
|
||||||
|
hSeek h AbsoluteSeek offset
|
||||||
|
withClientM (cli (stream h checkv checkresultv)) clientenv return
|
||||||
|
case v of
|
||||||
Left err -> do
|
Left err -> do
|
||||||
void $ liftIO $ atomically $ tryPutTMVar checkv ()
|
void $ liftIO $ atomically $ tryPutTMVar checkv ()
|
||||||
join $ liftIO (wait checkerthread)
|
join $ liftIO (wait checkerthread)
|
||||||
|
@ -654,9 +658,8 @@ clientPut clientenv (ProtocolVersion ver) k su cu bypass auth moffset af content
|
||||||
join $ liftIO (wait checkerthread)
|
join $ liftIO (wait checkerthread)
|
||||||
return res
|
return res
|
||||||
where
|
where
|
||||||
stream checkv checkresultv = S.SourceT $ \a -> do
|
stream h checkv checkresultv = S.SourceT $ \a -> do
|
||||||
-- TODO seek to offset when requested
|
bl <- L.hGetContents h
|
||||||
bl <- L.readFile contentfile
|
|
||||||
v <- newMVar (0, filter (not . B.null) (L.toChunks bl))
|
v <- newMVar (0, filter (not . B.null) (L.toChunks bl))
|
||||||
a (go v)
|
a (go v)
|
||||||
where
|
where
|
||||||
|
@ -692,9 +695,12 @@ clientPut clientenv (ProtocolVersion ver) k su cu bypass auth moffset af content
|
||||||
AssociatedFile (Just f) -> Just (B64FilePath f)
|
AssociatedFile (Just f) -> Just (B64FilePath f)
|
||||||
|
|
||||||
len = DataLength nlen
|
len = DataLength nlen
|
||||||
nlen = case moffset of
|
|
||||||
Nothing -> contentfilesize
|
nlen = contentfilesize - offset
|
||||||
Just (Offset o) -> contentfilesize - fromIntegral o
|
|
||||||
|
offset = case moffset of
|
||||||
|
Nothing -> 0
|
||||||
|
Just (Offset o) -> fromIntegral o
|
||||||
|
|
||||||
cli src = case ver of
|
cli src = case ver of
|
||||||
3 -> v3 su V3 len k cu bypass baf moffset src auth
|
3 -> v3 su V3 len k cu bypass baf moffset src auth
|
||||||
|
|
|
@ -28,8 +28,6 @@ Planned schedule of work:
|
||||||
|
|
||||||
## work notes
|
## work notes
|
||||||
|
|
||||||
* clientPut needs to seek to the requested offset in the file.
|
|
||||||
|
|
||||||
* Implement: servePutOffset, serveLockContent
|
* Implement: servePutOffset, serveLockContent
|
||||||
|
|
||||||
* A Locker should expire the lock on its own after 10 minutes initially.
|
* A Locker should expire the lock on its own after 10 minutes initially.
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue