diff --git a/FediChord.asn1 b/FediChord.asn1 index 41f9650..a907bb1 100644 --- a/FediChord.asn1 +++ b/FediChord.asn1 @@ -27,8 +27,7 @@ Request ::= SEQUENCE { -- request and response instead of explicit flag Response ::= SEQUENCE { - -- requestID of the request responding to - requestID INTEGER (0..4294967295), -- arbitrarily restricting to an unsigned 32bit integer + responseTo INTEGER (0..4294967295), -- arbitrarily restricting to an unsigned 32bit integer senderID NodeID, part Partnum, finalPart BOOLEAN, -- flag indicating this `part` to be the last of this response diff --git a/Hash2Pub.cabal b/Hash2Pub.cabal index d1ee4b1..2286385 100644 --- a/Hash2Pub.cabal +++ b/Hash2Pub.cabal @@ -86,7 +86,7 @@ executable Hash2Pub other-extensions: GeneralizedNewtypeDeriving -- Directories containing source files. - hs-source-dirs: app + hs-source-dirs: src/Hash2Pub -- Base language which the package is written in. default-language: Haskell2010 diff --git a/src/Hash2Pub/ASN1Coding.hs b/src/Hash2Pub/ASN1Coding.hs index d476809..25e435b 100644 --- a/src/Hash2Pub/ASN1Coding.hs +++ b/src/Hash2Pub/ASN1Coding.hs @@ -226,9 +226,9 @@ encodeMessage <> maybe [] encodePayload requestPayload <> [End Sequence] encodeMessage - (Response requestID senderID part isFinalPart action responsePayload) = [ + (Response responseTo senderID part isFinalPart action responsePayload) = [ Start Sequence - , IntVal requestID + , IntVal responseTo , IntVal . getNodeID $ senderID , IntVal part , Boolean isFinalPart @@ -277,7 +277,7 @@ parseRequest action = do pure $ Request requestID sender part isFinalPart action payload parseResponse :: Integer -> ParseASN1 FediChordMessage -parseResponse requestID = do +parseResponse responseTo = do senderID <- fromInteger <$> parseInteger :: ParseASN1 NodeID part <- parseInteger isFinalPart <- parseBool @@ -290,7 +290,7 @@ parseResponse requestID = do Stabilise -> parseStabiliseResponse Ping -> parsePingResponse - pure $ Response requestID senderID part isFinalPart action payload + pure $ Response responseTo senderID part isFinalPart action payload parseBool :: ParseASN1 Bool parseBool = do diff --git a/src/Hash2Pub/DHTProtocol.hs b/src/Hash2Pub/DHTProtocol.hs index 64e4602..89a429b 100644 --- a/src/Hash2Pub/DHTProtocol.hs +++ b/src/Hash2Pub/DHTProtocol.hs @@ -161,14 +161,13 @@ sendMessageSize = 1200 -- encode the response to a request that just signals successful receipt ackRequest :: NodeID -> FediChordMessage -> Map.Map Integer BS.ByteString ackRequest ownID req@Request{} = serialiseMessage sendMessageSize $ Response { - requestID = requestID req + responseTo = requestID req , senderID = ownID , part = part req , isFinalPart = False , action = action req , payload = Nothing } -ackRequest _ _ = Map.empty -- | Dispatch incoming requests to the dedicated handling and response function, and enqueue @@ -213,7 +212,6 @@ handleIncomingRequest nsSTM sendQ msgSet sourceAddr = do -- | execute a key ID lookup on local cache and respond with the result respondQueryID :: LocalNodeStateSTM -> Set.Set FediChordMessage -> IO (Map.Map Integer BS.ByteString) respondQueryID nsSTM msgSet = do - putStrLn "responding to a QueryID request" -- this message cannot be split reasonably, so just -- consider the first payload let @@ -234,7 +232,7 @@ respondQueryID nsSTM msgSet = do queryResult = queryLocalCache nsSnap cache (fromIntegral $ queryLBestNodes senderPayload') (queryTargetID senderPayload') } queryResponseMsg = Response { - requestID = requestID aRequestPart + responseTo = requestID aRequestPart , senderID = getNid nsSnap , part = if Set.size msgSet == 1 then 1 else fromIntegral $ Set.size msgSet + 1 , isFinalPart = False @@ -268,7 +266,7 @@ respondLeave nsSTM msgSet = do . setSuccessors (delete senderID $ requestSuccs <> successors nsSnap) $ nsSnap -- TODO: handle handover of key data let leaveResponse = Response { - requestID = requestID aRequestPart + responseTo = requestID aRequestPart , senderID = getNid nsSnap , part = if Set.size msgSet == 1 then 1 else fromIntegral $ Set.size msgSet + 1 , isFinalPart = False @@ -289,7 +287,7 @@ respondStabilise nsSTM msgSet = do , stabilisePredecessors = predecessors nsSnap } stabiliseResponse = Response { - requestID = requestID aRequestPart + responseTo = requestID aRequestPart , senderID = getNid nsSnap , part = if Set.size msgSet == 1 then 1 else fromIntegral $ Set.size msgSet + 1 , isFinalPart = False @@ -309,7 +307,7 @@ respondPing nsSTM msgSet = do aRequestPart = Set.elemAt 0 msgSet responsePayload = PingResponsePayload { pingNodeStates = [ toRemoteNodeState nsSnap ] } pingResponse = Response { - requestID = requestID aRequestPart + responseTo = requestID aRequestPart , senderID = getNid nsSnap , part = if Set.size msgSet == 1 then 1 else fromIntegral $ Set.size msgSet + 1 , isFinalPart = False @@ -345,7 +343,7 @@ respondJoin nsSTM msgSet = do , joinCache = toRemoteCache cache } joinResponse = Response { - requestID = requestID aRequestPart + responseTo = requestID aRequestPart , senderID = getNid joinedNS , part = if Set.size msgSet == 1 then 1 else fromIntegral $ Set.size msgSet + 1 , isFinalPart = False @@ -356,7 +354,7 @@ respondJoin nsSTM msgSet = do pure joinResponse -- otherwise respond with empty payload else pure Response { - requestID = requestID aRequestPart + responseTo = requestID aRequestPart , senderID = getNid nsSnap , part = if Set.size msgSet == 1 then 1 else fromIntegral $ Set.size msgSet + 1 , isFinalPart = False @@ -488,10 +486,7 @@ sendRequestTo :: Int -- ^ timeout in seconds sendRequestTo timeoutMillis numAttempts msgIncomplete sock = do -- give the message a random request ID randomID <- randomRIO (0, 2^32-1) - let - msgComplete = msgIncomplete randomID - requests = serialiseMessage sendMessageSize msgComplete - putStrLn $ "sending request message " <> show msgComplete + let requests = serialiseMessage sendMessageSize $ msgIncomplete randomID -- create a queue for passing received response messages back, even after a timeout responseQ <- newTBQueueIO $ 2*maximumParts -- keep room for duplicate packets -- start sendAndAck with timeout diff --git a/src/Hash2Pub/FediChord.hs b/src/Hash2Pub/FediChord.hs index f66cafc..795772b 100644 --- a/src/Hash2Pub/FediChord.hs +++ b/src/Hash2Pub/FediChord.hs @@ -128,7 +128,6 @@ fediChordBootstrapJoin :: LocalNodeStateSTM -- ^ the local 'NodeSta fediChordBootstrapJoin nsSTM (joinHost, joinPort) = -- can be invoked multiple times with all known bootstrapping nodes until successfully joined bracket (mkSendSocket joinHost joinPort) close (\sock -> do - putStrLn "BootstrapJoin" -- 1. get routed to placement of own ID until FOUND: -- Initialise an empty cache only with the responses from a bootstrapping node ns <- readTVarIO nsSTM @@ -146,7 +145,6 @@ fediChordBootstrapJoin nsSTM (joinHost, joinPort) = Just (FORWARD resultset) -> foldr' (addCacheEntryPure now) cacheAcc resultset ) initCache bootstrapResponse - putStrLn "initialised bootstrap cache" fediChordJoin bootstrapCache nsSTM ) `catch` (\e -> pure . Left $ "Error at bootstrap joining: " <> displayException (e :: IOException)) diff --git a/app/Main.hs b/src/Hash2Pub/Main.hs similarity index 100% rename from app/Main.hs rename to src/Hash2Pub/Main.hs diff --git a/src/Hash2Pub/ProtocolTypes.hs b/src/Hash2Pub/ProtocolTypes.hs index d56a257..c6348b3 100644 --- a/src/Hash2Pub/ProtocolTypes.hs +++ b/src/Hash2Pub/ProtocolTypes.hs @@ -30,7 +30,7 @@ data FediChordMessage = Request , payload :: Maybe ActionPayload } | Response - { requestID :: Integer + { responseTo :: Integer , senderID :: NodeID , part :: Integer , isFinalPart :: Bool @@ -40,12 +40,8 @@ data FediChordMessage = Request deriving (Show, Eq) instance Ord FediChordMessage where - compare a@Request{} b@Request{} | requestID a == requestID b = part a `compare` part b + compare a b | requestID a == requestID b = part a `compare` part 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 { queryTargetID :: NodeID diff --git a/test/FediChordSpec.hs b/test/FediChordSpec.hs index 146afcd..b6f08ad 100644 --- a/test/FediChordSpec.hs +++ b/test/FediChordSpec.hs @@ -201,7 +201,7 @@ spec = do , payload = undefined } responseTemplate = Response { - requestID = 2342 + responseTo = 2342 , senderID = nid exampleNodeState , part = 1 , isFinalPart = True