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

improve p2p protocol implementation

Browse source 
Tested it in ghci a little now.
This commit is contained in:
Joey Hess 2016-11-20 16:42:18 -04:00
parent 74691ddf0e
commit 9cf9ee73f5
No known key found for this signature in database
GPG key ID: C910D9222512E3C7
3 changed files with 25 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

6
Remote/Helper/P2P.hs
View file

@ -134,6 +134,7 @@ data NetF c
| ReceiveMessage (Message -> c)
| SendBytes Len L.ByteString c
| ReceiveBytes Len (L.ByteString -> c)
| CheckAuthToken UUID AuthToken (Bool -> c)
| Relay RelayHandle
(RelayData -> Net (Maybe ExitCode))
(ExitCode -> c)
@ -173,7 +174,6 @@ data LocalF c
-- Note: The ByteString may not contain the entire remaining content
-- of the key. Only once the key file size == Len has the whole
-- content been transferred.
| CheckAuthToken UUID AuthToken (Bool -> c)
| SetPresent Key UUID c
| CheckContentPresent Key (Bool -> c)
-- ^ Checks if the whole content of the key is locally present.
@ -203,6 +203,7 @@ runNet (ReceiveMessage _) [] = [("not enough Messages provided", Nothing)]
runNet (ReceiveMessage next) (m:ms) = ("<", Just m):runPure (next m) ms
runNet (SendBytes _ _ next) ms = ("> bytes", Nothing):runPure next ms
runNet (ReceiveBytes _ next) ms = ("< bytes", Nothing):runPure (next L.empty) ms
runNet (CheckAuthToken _ _ next) ms = runPure (next True) ms
runNet (Relay _ _ next) ms = runPure (next ExitSuccess) ms
runNet (RelayService _ _ next) ms = runPure (next ExitSuccess) ms
runNet (WriteRelay _ _ next) ms = runPure next ms
@ -211,7 +212,6 @@ runLocal :: Show r => LocalF (Proto r) -> [Message] -> [(String, Maybe Message)]
runLocal (KeyFileSize _ next) ms = runPure (next (Len 100)) ms
runLocal (ReadKeyFile _ _ next) ms = runPure (next L.empty) ms
runLocal (WriteKeyFile _ _ _ _ next) ms = runPure (next True) ms
runLocal (CheckAuthToken _ _ next) ms = runPure (next True) ms
runLocal (SetPresent _ _ next) ms = runPure next ms
runLocal (CheckContentPresent _ next) ms = runPure (next False) ms
runLocal (RemoveKeyFile _ next) ms = runPure (next True) ms
@ -298,7 +298,7 @@ serve myuuid = go Nothing
r <- net receiveMessage
case r of
AUTH theiruuid authtoken -> do
ok <- local $ checkAuthToken theiruuid authtoken
ok <- net $ checkAuthToken theiruuid authtoken
if ok
then do
net $ sendMessage (AUTH_SUCCESS myuuid)