From 41aaa8ff7018b30062425ce7cb4e24e0715c872b Mon Sep 17 00:00:00 2001
From: Trolli Schmittlauch <t.schmittlauch@orlives.de>
Date: Fri, 18 Sep 2020 01:33:31 +0200
Subject: [PATCH] parse ASN.1 representation of load querying

includes tests
contributes to #71
---
 src/Hash2Pub/ASN1Coding.hs    | 40 +++++++++++++++++++++++++++++++++++
 src/Hash2Pub/ProtocolTypes.hs |  9 ++++++++
 test/FediChordSpec.hs         | 10 +++++++++
 3 files changed, 59 insertions(+)

diff --git a/src/Hash2Pub/ASN1Coding.hs b/src/Hash2Pub/ASN1Coding.hs
index 10177ab..6080ff3 100644
--- a/src/Hash2Pub/ASN1Coding.hs
+++ b/src/Hash2Pub/ASN1Coding.hs
@@ -184,6 +184,18 @@ encodePayload payload'@PingResponsePayload{} =
     Start Sequence
   : concatMap encodeNodeState (pingNodeStates payload')
   <> [End Sequence]
+encodePayload payload'@LoadRequestPayload{} =
+  [ Start Sequence
+  , IntVal . getNodeID $ loadLowerBound payload'
+  , IntVal . getNodeID $ loadUpperBound payload'
+  , End Sequence
+  ]
+encodePayload payload'@LoadResponsePayload{} =
+  [ Start Sequence
+  , Real $ loadSum payload'
+  , Real $ loadRemainingTarget payload'
+  , End Sequence
+  ]
 
 encodeNodeState :: NodeState a => a -> [ASN1]
 encodeNodeState ns = [
@@ -272,6 +284,7 @@ parseRequest action = do
                  Leave     -> parseLeaveRequest
                  Stabilise -> parseStabiliseRequest
                  Ping      -> parsePingRequest
+                 QueryLoad -> parseLoadRequestPayload
 
     pure $ Request requestID sender part isFinalPart action payload
 
@@ -288,6 +301,7 @@ parseResponse requestID = do
                  Leave     -> parseLeaveResponse
                  Stabilise -> parseStabiliseResponse
                  Ping      -> parsePingResponse
+                 QueryLoad -> parseLoadResponsePayload
 
     pure $ Response requestID senderID part isFinalPart action payload
 
@@ -305,6 +319,13 @@ parseInteger = do
         IntVal parsed -> pure parsed
         x -> throwParseError $ "Expected IntVal but got " <> show x
 
+parseReal :: ParseASN1 Double
+parseReal = do
+    i <- getNext
+    case i of
+      Real parsed -> pure parsed
+      x           -> throwParseError $ "Expected Real but got " <> show x
+
 parseEnum :: Enum a => ParseASN1 a
 parseEnum = do
     e <- getNext
@@ -437,3 +458,22 @@ parsePingResponse = onNextContainer Sequence $ do
     pure $ PingResponsePayload {
         pingNodeStates = handledNodes
                                  }
+
+parseLoadRequestPayload :: ParseASN1 ActionPayload
+parseLoadRequestPayload = onNextContainer Sequence $ do
+    loadLowerBound' <- fromInteger <$> parseInteger
+    loadUpperBound' <- fromInteger <$> parseInteger
+    pure LoadRequestPayload
+        { loadLowerBound = loadLowerBound'
+        , loadUpperBound = loadUpperBound'
+        }
+
+parseLoadResponsePayload :: ParseASN1 ActionPayload
+parseLoadResponsePayload = onNextContainer Sequence $ do
+    loadSum' <- parseReal
+    loadRemainingTarget' <- parseReal
+    pure LoadResponsePayload
+        { loadSum = loadSum'
+        , loadRemainingTarget = loadRemainingTarget'
+        }
+
diff --git a/src/Hash2Pub/ProtocolTypes.hs b/src/Hash2Pub/ProtocolTypes.hs
index a5af10c..e7f1e3c 100644
--- a/src/Hash2Pub/ProtocolTypes.hs
+++ b/src/Hash2Pub/ProtocolTypes.hs
@@ -16,6 +16,7 @@ data Action = QueryID
     | Leave
     | Stabilise
     | Ping
+    | QueryLoad
     deriving (Show, Eq, Enum)
 
 data FediChordMessage = Request
@@ -73,6 +74,14 @@ data ActionPayload = QueryIDRequestPayload
     | PingResponsePayload
     { pingNodeStates :: [RemoteNodeState]
     }
+    | LoadRequestPayload
+    { loadLowerBound :: NodeID
+    , loadUpperBound :: NodeID
+    }
+    | LoadResponsePayload
+    { loadSum             :: Double
+    , loadRemainingTarget :: Double
+    }
     deriving (Show, Eq)
 
 -- | global limit of parts per message used when (de)serialising messages.
diff --git a/test/FediChordSpec.hs b/test/FediChordSpec.hs
index 6a3ca5d..8756b69 100644
--- a/test/FediChordSpec.hs
+++ b/test/FediChordSpec.hs
@@ -221,6 +221,14 @@ spec = do
                   , exampleNodeState {nid = fromInteger (-5)}
                                  ]
                                               }
+            qLoadReqPayload = LoadRequestPayload
+                { loadLowerBound = fromInteger 12
+                , loadUpperBound = fromInteger 1025
+                }
+            qLoadResPayload = LoadResponsePayload
+                { loadSum = 3.141
+                , loadRemainingTarget = -1.337
+                }
             requestTemplate = Request {
                 requestID = 2342
               , sender = exampleNodeState
@@ -259,6 +267,8 @@ spec = do
             encodeDecodeAndCheck $ responseWith Leave lResPayload
             encodeDecodeAndCheck $ responseWith Stabilise stabResPayload
             encodeDecodeAndCheck $ responseWith Ping pingResPayload
+            encodeDecodeAndCheck $ requestWith QueryLoad qLoadReqPayload
+            encodeDecodeAndCheck $ responseWith QueryLoad qLoadResPayload
         it "messages are encoded and decoded to ASN.1 DER properly" $
             deserialiseMessage (fromJust $ Map.lookup 1 (serialiseMessage 652  $ responseWith Ping pingResPayload)) `shouldBe` Right (responseWith Ping pingResPayload)
         it "messages too large for a single packet can (often) be split into multiple parts" $ do