diff options
| author |  Joey Hess <joeyh@joeyh.name> | 2016-11-20 16:42:18 -0400 |
|---|---|---|
| committer | Joey Hess <joeyh@joeyh.name> | 2016-11-20 16:42:18 -0400 |
| commit | 849256634ad1234f9957532e0131e0e2b491bdeb (patch) | |
| tree | 1feba99e261107f0e5c2ad8e724df57bbb3b9fa0 /Remote/Helper/P2P.hs | |
| parent | dce8e76ef443e33d88b8301c86ebf080fceff511 (diff) | |
improve p2p protocol implementation
Tested it in ghci a little now.
Diffstat (limited to 'Remote/Helper/P2P.hs')
| -rw-r--r-- | Remote/Helper/P2P.hs | 6 |
1 files changed, 3 insertions, 3 deletions
diff --git a/Remote/Helper/P2P.hs b/Remote/Helper/P2P.hs index fbd6c2463..1e1519560 100644 --- a/Remote/Helper/P2P.hs +++ b/Remote/Helper/P2P.hs @@ -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) |