functions for encoding protocol messages as ASN.1

Hash2Pub/FediChord.asn1

@@ -4,12 +4,14 @@ NodeID ::= INTEGER (0..115792089237316195423570985008687907853269984665640564039
 
 Domain ::= VisibleString
 
+Action ::= ENUMERATED {queryID, join, leave, stabilise, ping}
+
 Request ::= SEQUENCE {
 	requestID		INTEGER,
 	senderID		NodeID,
 	parts			INTEGER,	-- number of message parts
 	part			INTEGER,	-- part number of this message
-	action			ENUMERATED {queryID, join, leave, stabilise, ping},
+	action			Action,
 	actionPayload	CHOICE {
 		queryIDSendPayload		QueryIDSendPayload,
 		joinSendPayload			JoinSendPayload,
@@ -23,7 +25,7 @@ Response ::= SEQUENCE {
 	senderID		NodeID,
 	parts			INTEGER,
 	part			INTEGER,
-	action			ENUMERATED {queryID, join, leave, stabilise, ping},
+	action			Action,
 	actionPayload	CHOICE {
 		queryIDReceivePayload	QueryIDReceivePayload,
 		joinReceivePayload		JoinReceivePayload,
@@ -43,7 +45,7 @@ NodeState ::= SEQUENCE {
 
 CacheEntry ::= SEQUENCE {
 	node			NodeState,
-	-- use unix time stamp, as DATE-TIME isn't supported by the Haskell lib
+	-- use POSIX time stamp, as DATE-TIME isn't supported by the Haskell lib
 	timestamp		INTEGER
 	}
 
@@ -66,7 +68,7 @@ QueryResult ::= ENUMERATED { found, forward }
 
 QueryIDReceivePayload ::= SEQUENCE {
 	result			QueryResult,
-	nodeData		NodeCache
+	nodeData		NodeCache OPTIONAL -- empty if `found`
 	}
 
 StabiliseSendPayload ::= NodeState

Hash2Pub/Hash2Pub.cabal

@@ -55,8 +55,7 @@ library
   import: deps
 
   -- Modules exported by the library.
-  exposed-modules:     Hash2Pub.FediChord, Hash2Pub.DHTProtocol
-  --, Hash2Pub.ASN1Coding
+  exposed-modules:     Hash2Pub.FediChord, Hash2Pub.DHTProtocol, Hash2Pub.ASN1Coding
 
   -- Modules included in this library but not exported.
   other-modules: Hash2Pub.Utils

Hash2Pub/src/Hash2Pub/ASN1Coding.hs

@@ -0,0 +1,133 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Hash2Pub.ASN1Coding where
+
+import Data.ASN1.Encoding -- asn1-encoding package
+import Data.ASN1.BinaryEncoding
+import Data.ASN1.Error
+import Data.ASN1.Types -- asn1-types package
+import Data.ASN1.Parse
+import Data.Maybe (fromMaybe, mapMaybe)
+import Data.Time.Clock.POSIX
+import qualified Data.ByteString as BS
+import qualified Data.Set as Set
+import qualified Data.Map.Strict as Map
+
+import Hash2Pub.FediChord
+import Hash2Pub.DHTProtocol (QueryResponse (..))
+
+data Action =
+    QueryID 
+  | Join
+  | Leave
+  | Stabilise
+  | Ping
+  deriving (Show, Eq, Enum)
+
+-- ToDo: pagination so packets do not exceed maximum size
+-- probably should be taken care of by the callers of this, as the ASN.1
+-- encoding functions are layer-4 agnostic
+
+encodeNodeState :: NodeState -> [ASN1]
+encodeNodeState ns = [
+    Start Sequence
+  , IntVal (getNodeID . nid $ ns)
+  , OctetString (ipAddrAsBS $ ipAddr ns)
+  , IntVal (toInteger . dhtPort $ ns)
+  , IntVal (maybe 0 toInteger $ apPort ns)
+  , IntVal (vServerID ns)
+  , End Sequence
+                     ]
+
+encodeCacheEntry :: CacheEntry -> [ASN1]
+encodeCacheEntry (NodeEntry _ ns timestamp) =
+    Start Sequence
+  : encodeNodeState ns
+  -- ToDo: possibly optimise this by using dlists
+  ++ [
+    IntVal . fromIntegral . fromEnum . utcTimeToPOSIXSeconds $ timestamp
+  , End Sequence]
+encodeCacheEntry _ = []
+    
+encodeLeaveReceivePayload :: [ASN1]
+encodeLeaveReceivePayload = [Null]
+
+encodeLeaveSendPayload :: [NodeID] -> [NodeID] -> [ASN1]
+encodeLeaveSendPayload succ' pred' = 
+    Start Sequence
+  : Start Sequence
+  : map (IntVal . getNodeID) succ'
+  ++ [End Sequence
+  , Start Sequence]
+  ++ map (IntVal . getNodeID) pred'
+  ++ [End Sequence
+    , End Sequence]
+
+-- currently StabiliseReceivePayload and LeaveSendPayload are equal
+encodeStabiliseReceivePayload :: [NodeID] -> [NodeID] -> [ASN1]
+encodeStabiliseReceivePayload = encodeLeaveSendPayload
+
+encodeStabiliseSendPayload :: NodeState -> [ASN1]
+encodeStabiliseSendPayload = encodeNodeState
+
+encodeQueryResult :: QueryResponse -> ASN1
+encodeQueryResult FOUND{} = Enumerated 0
+encodeQueryResult FORWARD{} = Enumerated 1
+
+encodeQueryIDReceivePayload :: QueryResponse -> [ASN1]
+encodeQueryIDReceivePayload resp = 
+    Start Sequence
+  : encodeQueryResult resp
+  : case resp of
+      FOUND _ -> []
+      FORWARD entrySet ->
+            Start Sequence
+          : mconcat (map encodeCacheEntry . Set.elems $ entrySet)
+          ++ [End Sequence]
+  ++ [End Sequence]
+
+encodeQueryIDSendPayload :: NodeID -> Integer -> [ASN1]
+encodeQueryIDSendPayload targetID lNodes = [
+    Start Sequence
+  , IntVal . getNodeID $ targetID
+  , IntVal lNodes
+  , End Sequence
+                                           ]
+
+-- | encodes the @JoinReceivePayload@ ASN.1 type
+encodeJoinReceivePayload :: [NodeID] -> [NodeID] -> [CacheEntry] -> [ASN1]
+encodeJoinReceivePayload succ' pred' ncache =
+    Start Sequence
+  : Start Sequence
+  : map (IntVal . getNodeID) succ'
+  ++ [End Sequence
+  , Start Sequence]
+  ++ map (IntVal . getNodeID) pred'
+  ++ [End Sequence
+    , Start Sequence]
+  ++ mconcat (map encodeCacheEntry ncache)
+  ++ [End Sequence
+    , End Sequence]
+
+encodeJoinSendPayload :: NodeState -> [ASN1]
+encodeJoinSendPayload = encodeNodeState
+
+encodeRequest :: Integer -> NodeID -> Integer -> Integer -> Action -> [ASN1] -> [ASN1]
+encodeRequest requestID senderID parts part action payload = [
+    Start Sequence
+  , IntVal requestID
+  , IntVal . getNodeID $ senderID
+  , IntVal parts
+  , IntVal part
+  , Enumerated . fromIntegral . fromEnum $ action]
+  ++ payload
+
+encodeResponse :: Integer -> NodeID -> Integer -> Integer -> Action -> [ASN1] -> [ASN1]
+encodeResponse responseTo senderID parts part action payload = [
+    Start Sequence
+  , IntVal responseTo
+  , IntVal . getNodeID $ senderID
+  , IntVal parts
+  , IntVal part
+  , Enumerated . fromIntegral . fromEnum $ action]
+  ++ payload

Hash2Pub/src/Hash2Pub/DHTProtocol.hs

@@ -66,3 +66,5 @@ incomingQuery ownState nCache lBestNodes targetID
         case result of
           Nothing -> Set.empty
           Just nPred -> Set.insert nPred $ closestPredecessor (remainingLookups-1) (nid . cacheGetNodeStateUnvalidated $ nPred)
+
+

Hash2Pub/src/Hash2Pub/FediChord.hs

@@ -36,13 +36,14 @@ module Hash2Pub.FediChord (
   , genKeyID
   , genKeyIDBS
   , byteStringToUInteger
+  , ipAddrAsBS
                            ) where
 
 import qualified Data.Map.Strict as Map
 import Network.Socket
 import Data.Time.Clock
 import Control.Exception
-import Data.Maybe (isJust, fromMaybe)
+import Data.Maybe (isJust, fromMaybe, mapMaybe)
 
 -- for hashing and ID conversion
 import Crypto.Hash
@@ -181,7 +182,7 @@ getSuccessors = getInternals_ successors
 
 -- | convenience function that updates the successors of a NodeState
 putSuccessors :: [NodeID] -> NodeState -> NodeState
-putSuccessors succ = putInternals_ (\i -> i {successors = succ})
+putSuccessors succ' = putInternals_ (\i -> i {successors = succ'})
 
 -- | convenience function for extracting the @predecessors@ from a 'NodeState'
 getPredecessors :: NodeState -> Maybe [NodeID]
@@ -189,7 +190,7 @@ getPredecessors = getInternals_ predecessors
 
 -- | convenience function that updates the predecessors of a NodeState
 putPredecessors :: [NodeID] -> NodeState -> NodeState
-putPredecessors pred = putInternals_ (\i -> i {predecessors = pred})
+putPredecessors pred' = putInternals_ (\i -> i {predecessors = pred'})
 
 type NodeCache = Map.Map NodeID CacheEntry
 
@@ -220,6 +221,12 @@ instance Enum ProxyDirection where
     fromEnum Backwards = - 1
     fromEnum Forwards = 1
 
+--- useful function for getting entries for a full cache transfer
+cacheEntries :: NodeCache -> [CacheEntry]
+cacheEntries ncache = mapMaybe extractNodeEntries $ Map.elems ncache
+    where
+  extractNodeEntries (ProxyEntry _ possibleEntry) = possibleEntry
+
 -- | An empty @NodeCache@ needs to be initialised with 2 proxy entries,
 -- linking the modular name space together by connecting @minBound@ and @maxBound@
 initCache :: NodeCache
@@ -311,17 +318,21 @@ cacheGetNodeStateUnvalidated (NodeEntry _ nState _) = nState
 cacheGetNodeStateUnvalidated (ProxyEntry _ (Just entry)) = cacheGetNodeStateUnvalidated entry
 cacheGetNodeStateUnvalidated _ = error "trying to return empty node state, please report a bug"
 
+-- | converts a 'HostAddress6' IP address to a big-endian strict ByteString
+ipAddrAsBS :: HostAddress6 -> BS.ByteString
+-- TODO: this is inefficient and possibly better done with binary-strict
+ipAddrAsBS (a, b, c, d) = BL.toStrict . BB.toLazyByteString . mconcat $ map BB.word32BE [a, b, c, d]
+
 -- | generates a 256 bit long NodeID using SHAKE128, represented as ByteString
 genNodeIDBS :: HostAddress6     -- ^a node's IPv6 address
             -> String           -- ^a node's 1st and 2nd level domain name
             -> Word8            -- ^the used vserver ID
             -> BS.ByteString    -- ^the NodeID as a 256bit ByteString big-endian unsigned integer
-genNodeIDBS (a, b, _, _) nodeDomain vserver =
+genNodeIDBS ip nodeDomain vserver =
     hashIpaddrUpper `BS.append` hashID nodeDomain' `BS.append` hashIpaddLower
         where
             vsBS = BS.pack [vserver] -- attention: only works for vserver IDs up to 255
-            -- TODO: this is inefficient and possibly better done with binary-strict
-            ipaddrNet = (BL.toStrict . BB.toLazyByteString . mconcat $ map BB.word32BE [a, b]) `BS.append` vsBS
+            ipaddrNet = (BS.take 8 $ ipAddrAsBS ip) `BS.append` vsBS
             nodeDomain' = BSU.fromString nodeDomain `BS.append` vsBS
             hashID bstr = BS.pack . BA.unpack $ (hash bstr :: Digest (SHAKE128 128))
             (hashIpaddrUpper, hashIpaddLower) = BS.splitAt 64 $ hashID ipaddrNet

Hash2Pub/test/FediChordSpec.hs

@@ -171,7 +171,7 @@ exampleInternals = InternalNodeState {
   , pNumParallelQueries = 2
   , jEntriesPerSlice = 2
                                      }
-
+exampleLocalNode :: NodeState
 exampleLocalNode = exampleNodeState {internals = Just exampleInternals}
 
 exampleNodeDomain :: String