finished clientGet validity checking

This commit is contained in:
Joey Hess 2024-07-22 16:31:39 -04:00
parent 48eb6671e4
commit 8d36e597f1
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38

View file

@ -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