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

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

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

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

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))

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

test/FediChordSpec.hs

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