diff options
author | Joey Hess <joeyh@joeyh.name> | 2016-11-17 21:04:35 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2016-11-17 21:04:35 -0400 |
commit | a5e818dd54e8413fdb1da0d92343a9718b8754a7 (patch) | |
tree | 13b2d8bdaaac50fb8ea94228719282c7ef019ee2 | |
parent | d11aad0d99b1e24cf5ba08800c8333f8a379db8b (diff) |
refactor
-rw-r--r-- | Remote/Helper/P2P.hs | 50 |
1 files changed, 22 insertions, 28 deletions
diff --git a/Remote/Helper/P2P.hs b/Remote/Helper/P2P.hs index 0b4d05847..bf25a4ed9 100644 --- a/Remote/Helper/P2P.hs +++ b/Remote/Helper/P2P.hs @@ -104,16 +104,7 @@ auth myuuid t = do return Nothing get :: Key -> Proto Bool -get key = do - Len n <- keyFileSize key - let offset = Offset n - sendMessage (GET offset key) - r <- getMessage - case r of - DATA len -> receiveContent key offset len - _ -> do - sendMessage (PROTO_ERROR "expected DATA") - return False +get key = receiveContent key (`GET` key) put :: Key -> Proto Bool put key = do @@ -156,23 +147,17 @@ serve myuuid = go Nothing _ -> do case autheduuid of Just theiruuid -> authed theiruuid r - Nothing -> sendMessage (PROTO_ERROR "must AUTH first") + Nothing -> sendMessage (PROTO_ERROR "must AUTH first") go autheduuid - authed theiruuid r = case r of + authed _theiruuid r = case r of PUT key -> do - (Len n) <- keyFileSize key - let offset = Offset n - sendMessage (PUT_FROM offset) - r' <- getMessage - case r' of - DATA len -> do - void $ receiveContent key offset len - setPresent key myuuid - _ -> sendMessage (PROTO_ERROR "expected DATA") + ok <- receiveContent key PUT_FROM + when ok $ + setPresent key myuuid -- setPresent not called because the peer may have -- requested the data but not permanatly stored it. - GET offset key -> sendContent key offset + GET offset key -> void $ sendContent key offset _ -> sendMessage (PROTO_ERROR "unexpected command") sendContent :: Key -> Offset -> Proto Bool @@ -188,12 +173,21 @@ sendContent key offset = do sendMessage (PROTO_ERROR "expected SUCCESS or FAILURE") return False -receiveContent :: Key -> Offset -> Len -> Proto Bool -receiveContent key offset len = do - content <- receiveBytes len - ok <- writeKeyFile key offset content - sendMessage $ if ok then SUCCESS else FAILURE - return ok +receiveContent :: Key -> (Offset -> Message) -> Proto Bool +receiveContent key mkmsg = do + Len n <- keyFileSize key + let offset = Offset n + sendMessage (mkmsg offset) + r <- getMessage + case r of + DATA len -> do + content <- receiveBytes len + ok <- writeKeyFile key offset content + sendMessage $ if ok then SUCCESS else FAILURE + return ok + _ -> do + sendMessage (PROTO_ERROR "expected DATA") + return False -- Reads key file from an offset. The Len should correspond to -- the length of the ByteString, but to avoid buffering the content |