add CHECKPRESENT
Using SUCCESS to mean the content is present and FAILURE to mean it's not.
This commit is contained in:
parent
cbffb61083
commit
27c8a4a229
1 changed files with 16 additions and 4 deletions
|
@ -13,6 +13,7 @@ module Remote.Helper.P2P (
|
|||
runPure,
|
||||
protoDump,
|
||||
auth,
|
||||
checkPresent,
|
||||
remove,
|
||||
get,
|
||||
put,
|
||||
|
@ -45,6 +46,7 @@ data Message
|
|||
= AUTH UUID AuthToken -- uuid of the peer that is authenticating
|
||||
| AUTH_SUCCESS UUID -- uuid of the remote peer
|
||||
| AUTH_FAILURE
|
||||
| CHECKPRESENT Key
|
||||
| REMOVE Key
|
||||
| GET Offset Key
|
||||
| PUT Key
|
||||
|
@ -77,7 +79,7 @@ data ProtoF next
|
|||
-- content been transferred.
|
||||
| CheckAuthToken UUID AuthToken (Bool -> next)
|
||||
| SetPresent Key UUID next
|
||||
| CheckPresent Key (Bool -> next)
|
||||
| CheckContentPresent Key (Bool -> next)
|
||||
-- ^ Checks if the whole content of the key is locally present.
|
||||
| RemoveKeyFile Key (Bool -> next)
|
||||
-- ^ If the key file is not present, still succeeds.
|
||||
|
@ -101,8 +103,8 @@ runPure (Free (ReadKeyFile _ _ next)) ms = runPure (next L.empty) ms
|
|||
runPure (Free (WriteKeyFile _ _ _ _ next)) ms = runPure (next True) ms
|
||||
runPure (Free (CheckAuthToken _ _ next)) ms = runPure (next True) ms
|
||||
runPure (Free (SetPresent _ _ next)) ms = runPure next ms
|
||||
runPure (Free (CheckPresent _ next)) ms = runPure (next False) ms
|
||||
runPure (Free (RemoveKeyFile _ next)) ms = runPure (next False) ms
|
||||
runPure (Free (CheckContentPresent _ next)) ms = runPure (next False) ms
|
||||
runPure (Free (RemoveKeyFile _ next)) ms = runPure (next True) ms
|
||||
|
||||
protoDump :: [(String, Maybe Message)] -> String
|
||||
protoDump = unlines . map protoDump'
|
||||
|
@ -122,6 +124,11 @@ auth myuuid t = do
|
|||
sendMessage (PROTO_ERROR "auth failed")
|
||||
return Nothing
|
||||
|
||||
checkPresent :: Key -> Proto Bool
|
||||
checkPresent key = do
|
||||
sendMessage (CHECKPRESENT key)
|
||||
checkSuccess
|
||||
|
||||
remove :: Key -> Proto Bool
|
||||
remove key = do
|
||||
sendMessage (REMOVE key)
|
||||
|
@ -176,11 +183,14 @@ serve myuuid = go Nothing
|
|||
go autheduuid
|
||||
|
||||
authed _theiruuid r = case r of
|
||||
CHECKPRESENT key -> do
|
||||
ok <- checkContentPresent key
|
||||
sendMessage $ if ok then SUCCESS else FAILURE
|
||||
REMOVE key -> do
|
||||
ok <- removeKeyFile key
|
||||
sendMessage $ if ok then SUCCESS else FAILURE
|
||||
PUT key -> do
|
||||
have <- checkPresent key
|
||||
have <- checkContentPresent key
|
||||
if have
|
||||
then sendMessage ALREADY_HAVE
|
||||
else do
|
||||
|
@ -241,6 +251,7 @@ instance Proto.Sendable Message where
|
|||
formatMessage (AUTH uuid authtoken) = ["AUTH", Proto.serialize uuid, Proto.serialize authtoken]
|
||||
formatMessage (AUTH_SUCCESS uuid) = ["AUTH-SUCCESS", Proto.serialize uuid]
|
||||
formatMessage AUTH_FAILURE = ["AUTH-FAILURE"]
|
||||
formatMessage (CHECKPRESENT key) = ["CHECKPRESENT", Proto.serialize key]
|
||||
formatMessage (REMOVE key) = ["REMOVE", Proto.serialize key]
|
||||
formatMessage (GET offset key) = ["GET", Proto.serialize offset, Proto.serialize key]
|
||||
formatMessage (PUT key) = ["PUT", Proto.serialize key]
|
||||
|
@ -255,6 +266,7 @@ instance Proto.Receivable Message where
|
|||
parseCommand "AUTH" = Proto.parse2 AUTH
|
||||
parseCommand "AUTH-SUCCESS" = Proto.parse1 AUTH_SUCCESS
|
||||
parseCommand "AUTH-FAILURE" = Proto.parse0 AUTH_FAILURE
|
||||
parseCommand "CHECKPRESENT" = Proto.parse1 CHECKPRESENT
|
||||
parseCommand "REMOVE" = Proto.parse1 REMOVE
|
||||
parseCommand "GET" = Proto.parse2 GET
|
||||
parseCommand "PUT" = Proto.parse1 PUT
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue