functions for encoding protocol messages as ASN.1

This commit is contained in:
Trolli Schmittlauch 2020-04-29 22:55:43 +02:00
parent 947771ba18
commit 1968b5f883
6 changed files with 160 additions and 13 deletions

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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