finished clientGet validity checking
This commit is contained in:
parent
48eb6671e4
commit
8d36e597f1
1 changed files with 18 additions and 13 deletions
31
P2P/Http.hs
31
P2P/Http.hs
|
@ -272,26 +272,31 @@ clientGet
|
||||||
-> RawFilePath
|
-> RawFilePath
|
||||||
-> IO Validity
|
-> IO Validity
|
||||||
clientGet clientenv (ProtocolVersion ver) k su cu bypass af auth dest = do
|
clientGet clientenv (ProtocolVersion ver) k su cu bypass af auth dest = do
|
||||||
sz <- tryWhenExists $ getFileSize dest
|
startsz <- tryWhenExists $ getFileSize dest
|
||||||
let mo = fmap (Offset . fromIntegral) sz
|
let mo = fmap (Offset . fromIntegral) startsz
|
||||||
withClientM (cli k cu bypass af mo auth) clientenv $ \case
|
withClientM (cli k cu bypass af mo auth) clientenv $ \case
|
||||||
Left err -> throwM err
|
Left err -> throwM err
|
||||||
Right respheaders -> do
|
Right respheaders -> do
|
||||||
let dl = case lookupResponseHeader @DataLengthHeader' respheaders of
|
|
||||||
Header h -> h
|
|
||||||
_ -> error "missing data length header"
|
|
||||||
liftIO $ print ("datalength", dl :: DataLength)
|
|
||||||
b <- S.unSourceT (getResponse respheaders) gatherByteString
|
b <- S.unSourceT (getResponse respheaders) gatherByteString
|
||||||
liftIO $ withBinaryFile (fromRawFilePath dest) WriteMode $ \h -> do
|
liftIO $ withBinaryFile (fromRawFilePath dest) WriteMode $ \h -> do
|
||||||
case sz of
|
case startsz of
|
||||||
Just sz' | sz' /= 0 ->
|
Just startsz' | startsz' /= 0 ->
|
||||||
hSeek h AbsoluteSeek sz'
|
hSeek h AbsoluteSeek startsz'
|
||||||
_ -> noop
|
_ -> noop
|
||||||
L.writeFile (fromRawFilePath dest) b
|
len <- go 0 h (L.toChunks b)
|
||||||
-- TODO compare dl with the number of bytes written
|
let DataLength dl = case lookupResponseHeader @DataLengthHeader' respheaders of
|
||||||
-- to the file
|
Header hdr -> hdr
|
||||||
return Valid
|
_ -> error "missing data length header"
|
||||||
|
if dl == len
|
||||||
|
then return Valid
|
||||||
|
else return Invalid
|
||||||
where
|
where
|
||||||
|
go n _ [] = return n
|
||||||
|
go n h (b:bs) = do
|
||||||
|
let !n' = n + fromIntegral (B.length b)
|
||||||
|
B.hPut h b
|
||||||
|
go n' h bs
|
||||||
|
|
||||||
cli =case ver of
|
cli =case ver of
|
||||||
3 -> v3 su V3
|
3 -> v3 su V3
|
||||||
2 -> v2 su V2
|
2 -> v2 su V2
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue