mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

more p2p progress meters

Browse source 
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
Download patch file Download diff file Expand all files Collapse all files

16
P2P/Protocol.hs
View file

@ -167,7 +167,7 @@ data NetF c
| SendBytes Len L.ByteString MeterUpdate c
-- ^ Sends exactly Len bytes of data. (Any more or less will
-- confuse the receiver.)
| ReceiveBytes Len (L.ByteString -> c)
| ReceiveBytes Len MeterUpdate (L.ByteString -> c)
-- ^ Lazily reads bytes from peer. Stops once Len are read,
-- or if connection is lost, and in either case returns the bytes
-- that were read. This allows resuming interrupted transfers.
@ -273,8 +273,8 @@ remove key = do
net $ sendMessage (REMOVE key)
checkSuccess
get :: FilePath -> Key -> AssociatedFile -> Proto Bool
get dest key af = receiveContent sizer storer (\offset -> GET offset af key)
get :: FilePath -> Key -> AssociatedFile -> MeterUpdate -> Proto Bool
get dest key af p = receiveContent p sizer storer (\offset -> GET offset af key)
where
sizer = fileSize dest
storer = storeContentTo dest
@ -364,7 +364,7 @@ serveAuthed myuuid = void $ serverLoop handler
else do
let sizer = tmpContentSize key
let storer = storeContent key af
ok <- receiveContent sizer storer PUT_FROM
ok <- receiveContent nullMeterUpdate sizer storer PUT_FROM
when ok $
local $ setPresent key myuuid
return ServerContinue
@ -385,8 +385,8 @@ sendContent key af offset p = do
net $ sendBytes len content p
checkSuccess
receiveContent :: Local Len -> (Offset -> Len -> L.ByteString -> Local Bool) -> (Offset -> Message) -> Proto Bool
receiveContent sizer storer mkmsg = do
receiveContent :: MeterUpdate -> Local Len -> (Offset -> Len -> L.ByteString -> Local Bool) -> (Offset -> Message) -> Proto Bool
receiveContent p sizer storer mkmsg = do
Len n <- local sizer
let offset = Offset n
net $ sendMessage (mkmsg offset)
@ -394,7 +394,7 @@ receiveContent sizer storer mkmsg = do
case r of
DATA len -> do
ok <- local . storer offset len
=<< net (receiveBytes len)
=<< net (receiveBytes len p)
sendSuccess ok
return ok
_ -> do
@ -447,7 +447,7 @@ relayFromPeer = do
r <- receiveMessage
case r of
CONNECTDONE exitcode -> return $ RelayDone exitcode
DATA len -> RelayFromPeer <$> receiveBytes len
DATA len -> RelayFromPeer <$> receiveBytes len nullMeterUpdate
_ -> do
sendMessage $ ERROR "expected DATA or CONNECTDONE"
return $ RelayDone $ ExitFailure 1