more p2p progress meters

Display progress meter on send and receive from remote.

Added a new hGetMetered that can read an exact number of bytes (or
less), updating a meter as it goes.

This commit was sponsored by Andreas on Patreon.
This commit is contained in:
Joey Hess 2016-12-07 14:25:01 -04:00
parent f3a3dc14ec
commit ad5ef51040
No known key found for this signature in database
GPG key ID: C910D9222512E3C7
5 changed files with 45 additions and 27 deletions

View file

@ -119,8 +119,8 @@ runNet conn runner f = case f of
case v of
Right True -> runner next
_ -> return Nothing
ReceiveBytes (Len n) next -> do
v <- liftIO $ tryNonAsync $ L.hGet (connIhdl conn) (fromIntegral n)
ReceiveBytes len p next -> do
v <- liftIO $ tryNonAsync $ receiveExactly len (connIhdl conn) p
case v of
Left _e -> return Nothing
Right b -> runner (next b)
@ -155,9 +155,12 @@ runNet conn runner f = case f of
-- If too few bytes are sent, the only option is to give up on this
-- connection. False is returned to indicate this problem.
sendExactly :: Len -> L.ByteString -> Handle -> MeterUpdate -> IO Bool
sendExactly (Len l) b h p = do
sent <- meteredWrite' p h (L.take (fromIntegral l) b)
return (fromBytesProcessed sent == l)
sendExactly (Len n) b h p = do
sent <- meteredWrite' p h (L.take (fromIntegral n) b)
return (fromBytesProcessed sent == n)
receiveExactly :: Len -> Handle -> MeterUpdate -> IO L.ByteString
receiveExactly (Len n) h p = hGetMetered h (Just n) p
runRelay :: RunProto IO -> RelayHandle -> RelayHandle -> IO (Maybe ExitCode)
runRelay runner (RelayHandle hout) (RelayHandle hin) = bracket setup cleanup go