diff --git a/Hash2Pub/FediChord.asn1 b/Hash2Pub/FediChord.asn1 index bf9ebff..486089e 100644 --- a/Hash2Pub/FediChord.asn1 +++ b/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 diff --git a/Hash2Pub/Hash2Pub.cabal b/Hash2Pub/Hash2Pub.cabal index 53c99d2..f03627c 100644 --- a/Hash2Pub/Hash2Pub.cabal +++ b/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 diff --git a/Hash2Pub/src/Hash2Pub/ASN1Coding.hs b/Hash2Pub/src/Hash2Pub/ASN1Coding.hs new file mode 100644 index 0000000..ca6d8e4 --- /dev/null +++ b/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 diff --git a/Hash2Pub/src/Hash2Pub/DHTProtocol.hs b/Hash2Pub/src/Hash2Pub/DHTProtocol.hs index 3d226f1..90c9a33 100644 --- a/Hash2Pub/src/Hash2Pub/DHTProtocol.hs +++ b/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) + + diff --git a/Hash2Pub/src/Hash2Pub/FediChord.hs b/Hash2Pub/src/Hash2Pub/FediChord.hs index b04b5bb..5958847 100644 --- a/Hash2Pub/src/Hash2Pub/FediChord.hs +++ b/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 diff --git a/Hash2Pub/test/FediChordSpec.hs b/Hash2Pub/test/FediChordSpec.hs index 2907285..76b19d4 100644 --- a/Hash2Pub/test/FediChordSpec.hs +++ b/Hash2Pub/test/FediChordSpec.hs @@ -171,7 +171,7 @@ exampleInternals = InternalNodeState { , pNumParallelQueries = 2 , jEntriesPerSlice = 2 } - +exampleLocalNode :: NodeState exampleLocalNode = exampleNodeState {internals = Just exampleInternals} exampleNodeDomain :: String