schmittlauch/Hash2Pub
1
0
Fork 1
Code Issues 47 Pull requests Releases Wiki Activity

rename responseTo -> requestID to avoid partial record accessors

Browse source
This commit is contained in:
Trolli Schmittlauch 2020-06-08 20:31:18 +02:00
parent 3892dc91aa
commit 2c827ea326
5 changed files with 21 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
FediChord.asn1
View file

@ -27,7 +27,8 @@ Request ::= SEQUENCE {
-- request and response instead of explicit flag -- request and response instead of explicit flag
Response ::= SEQUENCE { Response ::= SEQUENCE {
responseTo INTEGER (0..4294967295), -- arbitrarily restricting to an unsigned 32bit integer -- requestID of the request responding to
requestID INTEGER (0..4294967295), -- arbitrarily restricting to an unsigned 32bit integer
senderID NodeID, senderID NodeID,
part Partnum, part Partnum,
finalPart BOOLEAN, -- flag indicating this `part` to be the last of this response finalPart BOOLEAN, -- flag indicating this `part` to be the last of this response

8
src/Hash2Pub/ASN1Coding.hs
View file

@ -226,9 +226,9 @@ encodeMessage
<> maybe [] encodePayload requestPayload <> maybe [] encodePayload requestPayload
<> [End Sequence] <> [End Sequence]
encodeMessage encodeMessage
(Response responseTo senderID part isFinalPart action responsePayload) = [ (Response requestID senderID part isFinalPart action responsePayload) = [
Start Sequence Start Sequence
, IntVal responseTo , IntVal requestID
, IntVal . getNodeID $ senderID , IntVal . getNodeID $ senderID
, IntVal part , IntVal part
, Boolean isFinalPart , Boolean isFinalPart
@ -277,7 +277,7 @@ parseRequest action = do
pure $ Request requestID sender part isFinalPart action payload pure $ Request requestID sender part isFinalPart action payload
parseResponse :: Integer -> ParseASN1 FediChordMessage parseResponse :: Integer -> ParseASN1 FediChordMessage
parseResponse responseTo = do parseResponse requestID = do
senderID <- fromInteger <$> parseInteger :: ParseASN1 NodeID senderID <- fromInteger <$> parseInteger :: ParseASN1 NodeID
part <- parseInteger part <- parseInteger
isFinalPart <- parseBool isFinalPart <- parseBool
@ -290,7 +290,7 @@ parseResponse responseTo = do
Stabilise -> parseStabiliseResponse Stabilise -> parseStabiliseResponse
Ping -> parsePingResponse Ping -> parsePingResponse
pure $ Response responseTo senderID part isFinalPart action payload pure $ Response requestID senderID part isFinalPart action payload
parseBool :: ParseASN1 Bool parseBool :: ParseASN1 Bool
parseBool = do parseBool = do

15
src/Hash2Pub/DHTProtocol.hs
View file

@ -161,13 +161,14 @@ sendMessageSize = 1200
-- encode the response to a request that just signals successful receipt -- encode the response to a request that just signals successful receipt
ackRequest :: NodeID -> FediChordMessage -> Map.Map Integer BS.ByteString ackRequest :: NodeID -> FediChordMessage -> Map.Map Integer BS.ByteString
ackRequest ownID req@Request{} = serialiseMessage sendMessageSize $ Response { ackRequest ownID req@Request{} = serialiseMessage sendMessageSize $ Response {
responseTo = requestID req requestID = requestID req
, senderID = ownID , senderID = ownID
, part = part req , part = part req
, isFinalPart = False , isFinalPart = False
, action = action req , action = action req
, payload = Nothing , payload = Nothing
} }
ackRequest _ _ = Map.empty
-- | Dispatch incoming requests to the dedicated handling and response function, and enqueue -- | Dispatch incoming requests to the dedicated handling and response function, and enqueue
@ -232,7 +233,7 @@ respondQueryID nsSTM msgSet = do
queryResult = queryLocalCache nsSnap cache (fromIntegral $ queryLBestNodes senderPayload') (queryTargetID senderPayload') queryResult = queryLocalCache nsSnap cache (fromIntegral $ queryLBestNodes senderPayload') (queryTargetID senderPayload')
} }
queryResponseMsg = Response { queryResponseMsg = Response {
responseTo = requestID aRequestPart requestID = requestID aRequestPart
, senderID = getNid nsSnap , senderID = getNid nsSnap
, part = if Set.size msgSet == 1 then 1 else fromIntegral $ Set.size msgSet + 1 , part = if Set.size msgSet == 1 then 1 else fromIntegral $ Set.size msgSet + 1
, isFinalPart = False , isFinalPart = False
@ -266,7 +267,7 @@ respondLeave nsSTM msgSet = do
. setSuccessors (delete senderID $ requestSuccs <> successors nsSnap) $ nsSnap . setSuccessors (delete senderID $ requestSuccs <> successors nsSnap) $ nsSnap
-- TODO: handle handover of key data -- TODO: handle handover of key data
let leaveResponse = Response { let leaveResponse = Response {
responseTo = requestID aRequestPart requestID = requestID aRequestPart
, senderID = getNid nsSnap , senderID = getNid nsSnap
, part = if Set.size msgSet == 1 then 1 else fromIntegral $ Set.size msgSet + 1 , part = if Set.size msgSet == 1 then 1 else fromIntegral $ Set.size msgSet + 1
, isFinalPart = False , isFinalPart = False
@ -287,7 +288,7 @@ respondStabilise nsSTM msgSet = do
, stabilisePredecessors = predecessors nsSnap , stabilisePredecessors = predecessors nsSnap
} }
stabiliseResponse = Response { stabiliseResponse = Response {
responseTo = requestID aRequestPart requestID = requestID aRequestPart
, senderID = getNid nsSnap , senderID = getNid nsSnap
, part = if Set.size msgSet == 1 then 1 else fromIntegral $ Set.size msgSet + 1 , part = if Set.size msgSet == 1 then 1 else fromIntegral $ Set.size msgSet + 1
, isFinalPart = False , isFinalPart = False
@ -307,7 +308,7 @@ respondPing nsSTM msgSet = do
aRequestPart = Set.elemAt 0 msgSet aRequestPart = Set.elemAt 0 msgSet
responsePayload = PingResponsePayload { pingNodeStates = [ toRemoteNodeState nsSnap ] } responsePayload = PingResponsePayload { pingNodeStates = [ toRemoteNodeState nsSnap ] }
pingResponse = Response { pingResponse = Response {
responseTo = requestID aRequestPart requestID = requestID aRequestPart
, senderID = getNid nsSnap , senderID = getNid nsSnap
, part = if Set.size msgSet == 1 then 1 else fromIntegral $ Set.size msgSet + 1 , part = if Set.size msgSet == 1 then 1 else fromIntegral $ Set.size msgSet + 1
, isFinalPart = False , isFinalPart = False
@ -343,7 +344,7 @@ respondJoin nsSTM msgSet = do
, joinCache = toRemoteCache cache , joinCache = toRemoteCache cache
} }
joinResponse = Response { joinResponse = Response {
responseTo = requestID aRequestPart requestID = requestID aRequestPart
, senderID = getNid joinedNS , senderID = getNid joinedNS
, part = if Set.size msgSet == 1 then 1 else fromIntegral $ Set.size msgSet + 1 , part = if Set.size msgSet == 1 then 1 else fromIntegral $ Set.size msgSet + 1
, isFinalPart = False , isFinalPart = False
@ -354,7 +355,7 @@ respondJoin nsSTM msgSet = do
pure joinResponse pure joinResponse
-- otherwise respond with empty payload -- otherwise respond with empty payload
else pure Response { else pure Response {
responseTo = requestID aRequestPart requestID = requestID aRequestPart
, senderID = getNid nsSnap , senderID = getNid nsSnap
, part = if Set.size msgSet == 1 then 1 else fromIntegral $ Set.size msgSet + 1 , part = if Set.size msgSet == 1 then 1 else fromIntegral $ Set.size msgSet + 1
, isFinalPart = False , isFinalPart = False

8
src/Hash2Pub/ProtocolTypes.hs
View file

@ -30,7 +30,7 @@ data FediChordMessage = Request
, payload :: Maybe ActionPayload , payload :: Maybe ActionPayload
} }
| Response | Response
{ responseTo :: Integer { requestID :: Integer
, senderID :: NodeID , senderID :: NodeID
, part :: Integer , part :: Integer
, isFinalPart :: Bool , isFinalPart :: Bool
@ -40,8 +40,12 @@ data FediChordMessage = Request
deriving (Show, Eq) deriving (Show, Eq)
instance Ord FediChordMessage where instance Ord FediChordMessage where
compare a b | requestID a == requestID b = part a `compare` part b compare a@Request{} b@Request{} | requestID a == requestID b = part a `compare` part b
| otherwise = requestID a `compare` requestID b | otherwise = requestID a `compare` requestID b
compare a@Response{} b@Response{} | requestID a == requestID b = part a `compare` part b
| otherwise = requestID a `compare` requestID b
-- comparing different constructor types always yields "not equal"
compare _ _ = LT
data ActionPayload = QueryIDRequestPayload data ActionPayload = QueryIDRequestPayload
{ queryTargetID :: NodeID { queryTargetID :: NodeID

2
test/FediChordSpec.hs
View file

@ -201,7 +201,7 @@ spec = do
, payload = undefined , payload = undefined
} }
responseTemplate = Response { responseTemplate = Response {
responseTo = 2342 requestID = 2342
, senderID = nid exampleNodeState , senderID = nid exampleNodeState
, part = 1 , part = 1
, isFinalPart = True , isFinalPart = True