forked from schmittlauch/Hash2Pub
functions for encoding protocol messages as ASN.1
This commit is contained in:
parent
947771ba18
commit
1968b5f883
|
@ -4,12 +4,14 @@ NodeID ::= INTEGER (0..115792089237316195423570985008687907853269984665640564039
|
||||||
|
|
||||||
Domain ::= VisibleString
|
Domain ::= VisibleString
|
||||||
|
|
||||||
|
Action ::= ENUMERATED {queryID, join, leave, stabilise, ping}
|
||||||
|
|
||||||
Request ::= SEQUENCE {
|
Request ::= SEQUENCE {
|
||||||
requestID INTEGER,
|
requestID INTEGER,
|
||||||
senderID NodeID,
|
senderID NodeID,
|
||||||
parts INTEGER, -- number of message parts
|
parts INTEGER, -- number of message parts
|
||||||
part INTEGER, -- part number of this message
|
part INTEGER, -- part number of this message
|
||||||
action ENUMERATED {queryID, join, leave, stabilise, ping},
|
action Action,
|
||||||
actionPayload CHOICE {
|
actionPayload CHOICE {
|
||||||
queryIDSendPayload QueryIDSendPayload,
|
queryIDSendPayload QueryIDSendPayload,
|
||||||
joinSendPayload JoinSendPayload,
|
joinSendPayload JoinSendPayload,
|
||||||
|
@ -23,7 +25,7 @@ Response ::= SEQUENCE {
|
||||||
senderID NodeID,
|
senderID NodeID,
|
||||||
parts INTEGER,
|
parts INTEGER,
|
||||||
part INTEGER,
|
part INTEGER,
|
||||||
action ENUMERATED {queryID, join, leave, stabilise, ping},
|
action Action,
|
||||||
actionPayload CHOICE {
|
actionPayload CHOICE {
|
||||||
queryIDReceivePayload QueryIDReceivePayload,
|
queryIDReceivePayload QueryIDReceivePayload,
|
||||||
joinReceivePayload JoinReceivePayload,
|
joinReceivePayload JoinReceivePayload,
|
||||||
|
@ -43,7 +45,7 @@ NodeState ::= SEQUENCE {
|
||||||
|
|
||||||
CacheEntry ::= SEQUENCE {
|
CacheEntry ::= SEQUENCE {
|
||||||
node NodeState,
|
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
|
timestamp INTEGER
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -66,7 +68,7 @@ QueryResult ::= ENUMERATED { found, forward }
|
||||||
|
|
||||||
QueryIDReceivePayload ::= SEQUENCE {
|
QueryIDReceivePayload ::= SEQUENCE {
|
||||||
result QueryResult,
|
result QueryResult,
|
||||||
nodeData NodeCache
|
nodeData NodeCache OPTIONAL -- empty if `found`
|
||||||
}
|
}
|
||||||
|
|
||||||
StabiliseSendPayload ::= NodeState
|
StabiliseSendPayload ::= NodeState
|
||||||
|
|
|
@ -55,8 +55,7 @@ library
|
||||||
import: deps
|
import: deps
|
||||||
|
|
||||||
-- Modules exported by the library.
|
-- Modules exported by the library.
|
||||||
exposed-modules: Hash2Pub.FediChord, Hash2Pub.DHTProtocol
|
exposed-modules: Hash2Pub.FediChord, Hash2Pub.DHTProtocol, Hash2Pub.ASN1Coding
|
||||||
--, Hash2Pub.ASN1Coding
|
|
||||||
|
|
||||||
-- Modules included in this library but not exported.
|
-- Modules included in this library but not exported.
|
||||||
other-modules: Hash2Pub.Utils
|
other-modules: Hash2Pub.Utils
|
||||||
|
|
133
Hash2Pub/src/Hash2Pub/ASN1Coding.hs
Normal file
133
Hash2Pub/src/Hash2Pub/ASN1Coding.hs
Normal 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
|
|
@ -66,3 +66,5 @@ incomingQuery ownState nCache lBestNodes targetID
|
||||||
case result of
|
case result of
|
||||||
Nothing -> Set.empty
|
Nothing -> Set.empty
|
||||||
Just nPred -> Set.insert nPred $ closestPredecessor (remainingLookups-1) (nid . cacheGetNodeStateUnvalidated $ nPred)
|
Just nPred -> Set.insert nPred $ closestPredecessor (remainingLookups-1) (nid . cacheGetNodeStateUnvalidated $ nPred)
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -36,13 +36,14 @@ module Hash2Pub.FediChord (
|
||||||
, genKeyID
|
, genKeyID
|
||||||
, genKeyIDBS
|
, genKeyIDBS
|
||||||
, byteStringToUInteger
|
, byteStringToUInteger
|
||||||
|
, ipAddrAsBS
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.Map.Strict as Map
|
import qualified Data.Map.Strict as Map
|
||||||
import Network.Socket
|
import Network.Socket
|
||||||
import Data.Time.Clock
|
import Data.Time.Clock
|
||||||
import Control.Exception
|
import Control.Exception
|
||||||
import Data.Maybe (isJust, fromMaybe)
|
import Data.Maybe (isJust, fromMaybe, mapMaybe)
|
||||||
|
|
||||||
-- for hashing and ID conversion
|
-- for hashing and ID conversion
|
||||||
import Crypto.Hash
|
import Crypto.Hash
|
||||||
|
@ -181,7 +182,7 @@ getSuccessors = getInternals_ successors
|
||||||
|
|
||||||
-- | convenience function that updates the successors of a NodeState
|
-- | convenience function that updates the successors of a NodeState
|
||||||
putSuccessors :: [NodeID] -> NodeState -> 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'
|
-- | convenience function for extracting the @predecessors@ from a 'NodeState'
|
||||||
getPredecessors :: NodeState -> Maybe [NodeID]
|
getPredecessors :: NodeState -> Maybe [NodeID]
|
||||||
|
@ -189,7 +190,7 @@ getPredecessors = getInternals_ predecessors
|
||||||
|
|
||||||
-- | convenience function that updates the predecessors of a NodeState
|
-- | convenience function that updates the predecessors of a NodeState
|
||||||
putPredecessors :: [NodeID] -> NodeState -> 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
|
type NodeCache = Map.Map NodeID CacheEntry
|
||||||
|
|
||||||
|
@ -220,6 +221,12 @@ instance Enum ProxyDirection where
|
||||||
fromEnum Backwards = - 1
|
fromEnum Backwards = - 1
|
||||||
fromEnum Forwards = 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,
|
-- | An empty @NodeCache@ needs to be initialised with 2 proxy entries,
|
||||||
-- linking the modular name space together by connecting @minBound@ and @maxBound@
|
-- linking the modular name space together by connecting @minBound@ and @maxBound@
|
||||||
initCache :: NodeCache
|
initCache :: NodeCache
|
||||||
|
@ -311,17 +318,21 @@ cacheGetNodeStateUnvalidated (NodeEntry _ nState _) = nState
|
||||||
cacheGetNodeStateUnvalidated (ProxyEntry _ (Just entry)) = cacheGetNodeStateUnvalidated entry
|
cacheGetNodeStateUnvalidated (ProxyEntry _ (Just entry)) = cacheGetNodeStateUnvalidated entry
|
||||||
cacheGetNodeStateUnvalidated _ = error "trying to return empty node state, please report a bug"
|
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
|
-- | generates a 256 bit long NodeID using SHAKE128, represented as ByteString
|
||||||
genNodeIDBS :: HostAddress6 -- ^a node's IPv6 address
|
genNodeIDBS :: HostAddress6 -- ^a node's IPv6 address
|
||||||
-> String -- ^a node's 1st and 2nd level domain name
|
-> String -- ^a node's 1st and 2nd level domain name
|
||||||
-> Word8 -- ^the used vserver ID
|
-> Word8 -- ^the used vserver ID
|
||||||
-> BS.ByteString -- ^the NodeID as a 256bit ByteString big-endian unsigned integer
|
-> 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
|
hashIpaddrUpper `BS.append` hashID nodeDomain' `BS.append` hashIpaddLower
|
||||||
where
|
where
|
||||||
vsBS = BS.pack [vserver] -- attention: only works for vserver IDs up to 255
|
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 = (BS.take 8 $ ipAddrAsBS ip) `BS.append` vsBS
|
||||||
ipaddrNet = (BL.toStrict . BB.toLazyByteString . mconcat $ map BB.word32BE [a, b]) `BS.append` vsBS
|
|
||||||
nodeDomain' = BSU.fromString nodeDomain `BS.append` vsBS
|
nodeDomain' = BSU.fromString nodeDomain `BS.append` vsBS
|
||||||
hashID bstr = BS.pack . BA.unpack $ (hash bstr :: Digest (SHAKE128 128))
|
hashID bstr = BS.pack . BA.unpack $ (hash bstr :: Digest (SHAKE128 128))
|
||||||
(hashIpaddrUpper, hashIpaddLower) = BS.splitAt 64 $ hashID ipaddrNet
|
(hashIpaddrUpper, hashIpaddLower) = BS.splitAt 64 $ hashID ipaddrNet
|
||||||
|
|
|
@ -171,7 +171,7 @@ exampleInternals = InternalNodeState {
|
||||||
, pNumParallelQueries = 2
|
, pNumParallelQueries = 2
|
||||||
, jEntriesPerSlice = 2
|
, jEntriesPerSlice = 2
|
||||||
}
|
}
|
||||||
|
exampleLocalNode :: NodeState
|
||||||
exampleLocalNode = exampleNodeState {internals = Just exampleInternals}
|
exampleLocalNode = exampleNodeState {internals = Just exampleInternals}
|
||||||
|
|
||||||
exampleNodeDomain :: String
|
exampleNodeDomain :: String
|
||||||
|
|
Loading…
Reference in a new issue