add ALREADY-HAVE response to PUT
This commit is contained in:
parent
47b7028d7c
commit
2b33452bd8
1 changed files with 14 additions and 3 deletions
|
@ -47,6 +47,7 @@ data Message
|
||||||
| GET Offset Key
|
| GET Offset Key
|
||||||
| PUT Key
|
| PUT Key
|
||||||
| PUT_FROM Offset
|
| PUT_FROM Offset
|
||||||
|
| ALREADY_HAVE
|
||||||
| SUCCESS
|
| SUCCESS
|
||||||
| FAILURE
|
| FAILURE
|
||||||
| DATA Len -- followed by bytes
|
| DATA Len -- followed by bytes
|
||||||
|
@ -74,6 +75,8 @@ data ProtoF next
|
||||||
-- content been transferred.
|
-- content been transferred.
|
||||||
| CheckAuthToken UUID AuthToken (Bool -> next)
|
| CheckAuthToken UUID AuthToken (Bool -> next)
|
||||||
| SetPresent Key UUID next
|
| SetPresent Key UUID next
|
||||||
|
| CheckPresent Key (Bool -> next)
|
||||||
|
-- ^ Checks if the whole content of the key is locally present.
|
||||||
deriving (Functor)
|
deriving (Functor)
|
||||||
|
|
||||||
type Proto = Free ProtoF
|
type Proto = Free ProtoF
|
||||||
|
@ -93,6 +96,7 @@ runPure (Free (ReadKeyFile _ _ next)) ms = runPure (next L.empty) ms
|
||||||
runPure (Free (WriteKeyFile _ _ _ _ next)) ms = runPure (next True) ms
|
runPure (Free (WriteKeyFile _ _ _ _ next)) ms = runPure (next True) ms
|
||||||
runPure (Free (CheckAuthToken _ _ 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 (SetPresent _ _ next)) ms = runPure next ms
|
||||||
|
runPure (Free (CheckPresent _ next)) ms = runPure (next False) ms
|
||||||
|
|
||||||
protoDump :: [(String, Maybe Message)] -> String
|
protoDump :: [(String, Maybe Message)] -> String
|
||||||
protoDump = unlines . map protoDump'
|
protoDump = unlines . map protoDump'
|
||||||
|
@ -121,6 +125,7 @@ put key = do
|
||||||
r <- getMessage
|
r <- getMessage
|
||||||
case r of
|
case r of
|
||||||
PUT_FROM offset -> sendContent key offset
|
PUT_FROM offset -> sendContent key offset
|
||||||
|
ALREADY_HAVE -> return True
|
||||||
_ -> do
|
_ -> do
|
||||||
sendMessage (PROTO_ERROR "expected PUT_FROM")
|
sendMessage (PROTO_ERROR "expected PUT_FROM")
|
||||||
return False
|
return False
|
||||||
|
@ -161,9 +166,13 @@ serve myuuid = go Nothing
|
||||||
|
|
||||||
authed _theiruuid r = case r of
|
authed _theiruuid r = case r of
|
||||||
PUT key -> do
|
PUT key -> do
|
||||||
ok <- receiveContent key PUT_FROM
|
have <- checkPresent key
|
||||||
when ok $
|
if have
|
||||||
setPresent key myuuid
|
then sendMessage ALREADY_HAVE
|
||||||
|
else do
|
||||||
|
ok <- receiveContent key PUT_FROM
|
||||||
|
when ok $
|
||||||
|
setPresent key myuuid
|
||||||
-- setPresent not called because the peer may have
|
-- setPresent not called because the peer may have
|
||||||
-- requested the data but not permanatly stored it.
|
-- requested the data but not permanatly stored it.
|
||||||
GET offset key -> void $ sendContent key offset
|
GET offset key -> void $ sendContent key offset
|
||||||
|
@ -217,6 +226,7 @@ instance Proto.Sendable Message where
|
||||||
formatMessage (GET offset key) = ["GET", Proto.serialize offset, Proto.serialize key]
|
formatMessage (GET offset key) = ["GET", Proto.serialize offset, Proto.serialize key]
|
||||||
formatMessage (PUT key) = ["PUT", Proto.serialize key]
|
formatMessage (PUT key) = ["PUT", Proto.serialize key]
|
||||||
formatMessage (PUT_FROM offset) = ["PUT-FROM", Proto.serialize offset]
|
formatMessage (PUT_FROM offset) = ["PUT-FROM", Proto.serialize offset]
|
||||||
|
formatMessage ALREADY_HAVE = ["ALREADY-HAVE"]
|
||||||
formatMessage SUCCESS = ["SUCCESS"]
|
formatMessage SUCCESS = ["SUCCESS"]
|
||||||
formatMessage FAILURE = ["FAILURE"]
|
formatMessage FAILURE = ["FAILURE"]
|
||||||
formatMessage (DATA leng) = ["DATA", Proto.serialize leng]
|
formatMessage (DATA leng) = ["DATA", Proto.serialize leng]
|
||||||
|
@ -229,6 +239,7 @@ instance Proto.Receivable Message where
|
||||||
parseCommand "GET" = Proto.parse2 GET
|
parseCommand "GET" = Proto.parse2 GET
|
||||||
parseCommand "PUT" = Proto.parse1 PUT
|
parseCommand "PUT" = Proto.parse1 PUT
|
||||||
parseCommand "PUT-FROM" = Proto.parse1 PUT_FROM
|
parseCommand "PUT-FROM" = Proto.parse1 PUT_FROM
|
||||||
|
parseCommand "ALREADY-HAVE" = Proto.parse0 ALREADY_HAVE
|
||||||
parseCommand "SUCCESS" = Proto.parse0 SUCCESS
|
parseCommand "SUCCESS" = Proto.parse0 SUCCESS
|
||||||
parseCommand "FAILURE" = Proto.parse0 FAILURE
|
parseCommand "FAILURE" = Proto.parse0 FAILURE
|
||||||
parseCommand "DATA" = Proto.parse1 DATA
|
parseCommand "DATA" = Proto.parse1 DATA
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue