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

rename

Browse source
This commit is contained in:
Joey Hess 2016-11-17 22:10:28 -04:00
parent b121078b35
commit 236ff111a7
No known key found for this signature in database
GPG key ID: C910D9222512E3C7
1 changed files with 8 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
Remote/Helper/P2P.hs
View file

@ -61,7 +61,7 @@ data Message
-- | Free monad for implementing actions that use the protocol. -- | Free monad for implementing actions that use the protocol.
data ProtoF next data ProtoF next
= SendMessage Message next = SendMessage Message next
| GetMessage (Message -> next) | ReceiveMessage (Message -> next)
| SendBytes Len L.ByteString next | SendBytes Len L.ByteString next
| ReceiveBytes Len (L.ByteString -> next) | ReceiveBytes Len (L.ByteString -> next)
-- ^ Lazily reads bytes from peer. Stops once Len are read, -- ^ Lazily reads bytes from peer. Stops once Len are read,
@ -94,8 +94,8 @@ $(makeFree ''ProtoF)
runPure :: Show r => Proto r -> [Message] -> [(String, Maybe Message)] runPure :: Show r => Proto r -> [Message] -> [(String, Maybe Message)]
runPure (Pure r) _ = [("result: " ++ show r, Nothing)] runPure (Pure r) _ = [("result: " ++ show r, Nothing)]
runPure (Free (SendMessage m next)) ms = (">", Just m):runPure next ms runPure (Free (SendMessage m next)) ms = (">", Just m):runPure next ms
runPure (Free (GetMessage _)) [] = [("not enough Messages provided", Nothing)] runPure (Free (ReceiveMessage _)) [] = [("not enough Messages provided", Nothing)]
runPure (Free (GetMessage next)) (m:ms) = ("<", Just m):runPure (next m) ms runPure (Free (ReceiveMessage next)) (m:ms) = ("<", Just m):runPure (next m) ms
runPure (Free (SendBytes _ _ next)) ms = ("> bytes", Nothing):runPure next ms runPure (Free (SendBytes _ _ next)) ms = ("> bytes", Nothing):runPure next ms
runPure (Free (ReceiveBytes _ next)) ms = ("< bytes", Nothing):runPure (next L.empty) ms runPure (Free (ReceiveBytes _ next)) ms = ("< bytes", Nothing):runPure (next L.empty) ms
runPure (Free (KeyFileSize _ next)) ms = runPure (next (Len 100)) ms runPure (Free (KeyFileSize _ next)) ms = runPure (next (Len 100)) ms
@ -116,7 +116,7 @@ protoDump' (s, Just m) = s ++ " " ++ unwords (Proto.formatMessage m)
auth :: UUID -> AuthToken -> Proto (Maybe UUID) auth :: UUID -> AuthToken -> Proto (Maybe UUID)
auth myuuid t = do auth myuuid t = do
sendMessage (AUTH myuuid t) sendMessage (AUTH myuuid t)
r <- getMessage r <- receiveMessage
case r of case r of
AUTH_SUCCESS theiruuid -> return $ Just theiruuid AUTH_SUCCESS theiruuid -> return $ Just theiruuid
AUTH_FAILURE -> return Nothing AUTH_FAILURE -> return Nothing
@ -140,7 +140,7 @@ get key = receiveContent key (`GET` key)
put :: Key -> Proto Bool put :: Key -> Proto Bool
put key = do put key = do
sendMessage (PUT key) sendMessage (PUT key)
r <- getMessage r <- receiveMessage
case r of case r of
PUT_FROM offset -> sendContent key offset PUT_FROM offset -> sendContent key offset
ALREADY_HAVE -> return True ALREADY_HAVE -> return True
@ -164,7 +164,7 @@ serve :: UUID -> Proto ()
serve myuuid = go Nothing serve myuuid = go Nothing
where where
go autheduuid = do go autheduuid = do
r <- getMessage r <- receiveMessage
case r of case r of
AUTH theiruuid authtoken -> do AUTH theiruuid authtoken -> do
ok <- checkAuthToken theiruuid authtoken ok <- checkAuthToken theiruuid authtoken
@ -210,7 +210,7 @@ receiveContent key mkmsg = do
Len n <- keyFileSize key Len n <- keyFileSize key
let offset = Offset n let offset = Offset n
sendMessage (mkmsg offset) sendMessage (mkmsg offset)
r <- getMessage r <- receiveMessage
case r of case r of
DATA len -> do DATA len -> do
ok <- writeKeyFile key offset len =<< receiveBytes len ok <- writeKeyFile key offset len =<< receiveBytes len
@ -222,7 +222,7 @@ receiveContent key mkmsg = do
checkSuccess :: Proto Bool checkSuccess :: Proto Bool
checkSuccess = do checkSuccess = do
ack <- getMessage ack <- receiveMessage
case ack of case ack of
SUCCESS -> return True SUCCESS -> return True
FAILURE -> return False FAILURE -> return False