diff --git a/Hash2Pub/FediChord.asn1 b/Hash2Pub/FediChord.asn1 index 3d23fc6..6b52ad4 100644 --- a/Hash2Pub/FediChord.asn1 +++ b/Hash2Pub/FediChord.asn1 @@ -9,15 +9,15 @@ Action ::= ENUMERATED {queryID, join, leave, stabilise, ping} Request ::= SEQUENCE { action Action, requestID INTEGER, - senderID NodeID, + sender NodeState, parts INTEGER, -- number of message parts part INTEGER, -- part number of this message actionPayload CHOICE { - queryIDSendPayload QueryIDSendPayload, - joinSendPayload JoinSendPayload, - leaveSendPayload LeaveSendPayload, - stabiliseSendPayload StabiliseSendPayload, - pingSendPayload PingSendPayload + queryIDRequestPayload QueryIDRequestPayload, + joinRequestPayload JoinRequestPayload, + leaveRequestPayload LeaveRequestPayload, + stabiliseRequestPayload StabiliseRequestPayload, + pingRequestPayload PingRequestPayload } } @@ -31,11 +31,11 @@ Response ::= SEQUENCE { part INTEGER, action Action, actionPayload CHOICE { - queryIDReceivePayload QueryIDReceivePayload, - joinReceivePayload JoinReceivePayload, - leaveReceivePayload LeaveReceivePayload, - stabiliseReceivePayload StabiliseReceivePayload, - pingReceivePayload PingReceivePayload + queryIDResponsePayload QueryIDResponsePayload, + joinResponsePayload JoinResponsePayload, + leaveResponsePayload LeaveResponsePayload, + stabiliseResponsePayload StabiliseResponsePayload, + pingResponsePayload PingResponsePayload } } @@ -45,7 +45,7 @@ NodeState ::= SEQUENCE { ipAddr OCTET STRING (SIZE(16)), dhtPort INTEGER, apPort INTEGER, - vServer INTEGER + vServerID INTEGER } CacheEntry ::= SEQUENCE { @@ -56,47 +56,47 @@ CacheEntry ::= SEQUENCE { NodeCache ::= SEQUENCE OF CacheEntry -JoinSendPayload ::= NodeState +JoinRequestPayload ::= NULL -JoinReceivePayload ::= SEQUENCE { +JoinResponsePayload ::= SEQUENCE { successors SEQUENCE OF NodeID, predecessors SEQUENCE OF NodeID, cache NodeCache } -QueryIDSendPayload ::= SEQUENCE { +QueryResult ::= ENUMERATED { found, forward } + +QueryIDRequestPayload ::= SEQUENCE { targetID NodeID, lBestNodes INTEGER } -QueryResult ::= ENUMERATED { found, forward } - -QueryIDReceivePayload ::= SEQUENCE { +QueryIDResponsePayload ::= SEQUENCE { result QueryResult, - nodeData NodeCache OPTIONAL -- empty if `found` + nodeData CHOICE {NodeState, NodeCache} } -StabiliseSendPayload ::= NodeState +StabiliseRequestPayload ::= NULL -StabiliseReceivePayload ::= SEQUENCE { +StabiliseResponsePayload ::= SEQUENCE { successors SEQUENCE OF NodeID, predecessors SEQUENCE OF NodeID -- ToDo: transfer of handled key data, if newly responsible for it } -LeaveSendPayload ::= SEQUENCE { +LeaveRequestPayload ::= SEQUENCE { successors SEQUENCE OF NodeID, predecessors SEQUENCE OF NodeID -- ToDo: transfer of own data to newly responsible node } -LeaveReceivePayload ::= NULL -- just a confirmation +LeaveResponsePayload ::= NULL -- just a confirmation -PingSendPayload ::= NULL -- do not include a node/ vserver ID, so that +PingRequestPayload ::= NULL -- do not include a node/ vserver ID, so that -- the node has to respond with all active ones -- learning all active vserver IDs handled by the server at once -PingReceivePayload ::= SEQUENCE OF NodeState +PingResponsePayload ::= SEQUENCE OF NodeState END diff --git a/Hash2Pub/Hash2Pub.cabal b/Hash2Pub/Hash2Pub.cabal index f03627c..471a475 100644 --- a/Hash2Pub/Hash2Pub.cabal +++ b/Hash2Pub/Hash2Pub.cabal @@ -46,7 +46,7 @@ category: Network extra-source-files: CHANGELOG.md common deps - build-depends: base ^>=4.12.0.0, containers ^>=0.6.0.1, bytestring, utf8-string ^>=1.0.1.1, network ^>=2.8.0.1, time ^>=1.8.0.2, cmdargs ^>= 0.10, cryptonite ^>= 0.25, memory, async, asn1-encoding, asn1-types, asn1-parse, publicsuffix + build-depends: base ^>=4.12.0.0, containers ^>=0.6.0.1, bytestring, utf8-string ^>=1.0.1.1, network ^>=2.8.0.1, time ^>=1.8.0.2, cmdargs ^>= 0.10, cryptonite ^>= 0.25, memory, async, asn1-encoding, asn1-types, asn1-parse, publicsuffix, network-byte-order ghc-options: -Wall diff --git a/Hash2Pub/src/Hash2Pub/ASN1Coding.hs b/Hash2Pub/src/Hash2Pub/ASN1Coding.hs index 69972d3..8a2e76c 100644 --- a/Hash2Pub/src/Hash2Pub/ASN1Coding.hs +++ b/Hash2Pub/src/Hash2Pub/ASN1Coding.hs @@ -26,33 +26,35 @@ data Action = -- ToDo: probably move this to DHTProtocol as it is high-level -data FediChordMessage = FediChordMessage { - messageType :: MessageType - , requestID :: Integer +data FediChordMessage = + Request { + requestID :: Integer + , sender :: NodeState + , parts :: Integer + , part :: Integer + , action :: Action + , payload :: ActionPayload + } + | Response { + responseTo :: Integer , senderID :: NodeID , parts :: Integer , part :: Integer , action :: Action , payload :: ActionPayload - } deriving (Show, Eq) - -data MessageType = Request | Response deriving (Show, Eq, Enum) + } deriving (Show, Eq) data ActionPayload = QueryIDRequestPayload { queryTargetID :: NodeID , queryLBestNodes :: Integer } - | JoinRequestPayload { - joinNodeState :: NodeState - } + | JoinRequestPayload | LeaveRequestPayload { leaveSuccessors :: [NodeID] , leavePredecessors :: [NodeID] } - | StabiliseRequestPayload { - stabiliseNodeState :: NodeState - } + | StabiliseRequestPayload | PingRequestPayload | QueryIDResponsePayload { queryResult :: QueryResponse @@ -82,6 +84,7 @@ encodeNodeState :: NodeState -> [ASN1] encodeNodeState ns = [ Start Sequence , IntVal (getNodeID . nid $ ns) + , ASN1String . asn1CharacterString Visible $ domain ns , OctetString (ipAddrAsBS $ ipAddr ns) , IntVal (toInteger . dhtPort $ ns) , IntVal (maybe 0 toInteger $ apPort ns) @@ -95,21 +98,21 @@ encodeCacheEntry (NodeEntry _ ns timestamp) = : encodeNodeState ns -- ToDo: possibly optimise this by using dlists ++ [ - IntVal . fromIntegral . fromEnum . utcTimeToPOSIXSeconds $ timestamp + IntVal . fromIntegral . fromEnum $ timestamp , End Sequence] encodeCacheEntry _ = [] -encodeLeaveResponsePayload :: [ASN1] -encodeLeaveResponsePayload = [Null] +encodeLeaveResponsePayload :: ActionPayload -> [ASN1] +encodeLeaveResponsePayload LeaveResponsePayload = [Null] encodeLeaveRequestPayload :: ActionPayload -> [ASN1] encodeLeaveRequestPayload payload@LeaveRequestPayload{} = Start Sequence : Start Sequence - : map (IntVal . getNodeID) $ leaveSuccessors payload + : (map (IntVal . getNodeID) $ leaveSuccessors payload) ++ [End Sequence , Start Sequence] - ++ map (IntVal . getNodeID) $ leavePredecessors payload + ++ (map (IntVal . getNodeID) $ leavePredecessors payload) ++ [End Sequence , End Sequence] @@ -118,16 +121,15 @@ encodeStabiliseResponsePayload :: ActionPayload -> [ASN1] encodeStabiliseResponsePayload payload@StabiliseResponsePayload{} = Start Sequence : Start Sequence - : map (IntVal . getNodeID) $ stabiliseSuccessors payload + : (map (IntVal . getNodeID) $ stabiliseSuccessors payload) ++ [End Sequence , Start Sequence] - ++ map (IntVal . getNodeID) $ stabilisePredecessors payload + ++ (map (IntVal . getNodeID) $ stabilisePredecessors payload) ++ [End Sequence , End Sequence] encodeStabiliseRequestPayload :: ActionPayload -> [ASN1] -encodeStabiliseRequestPayload payload@StabiliseRequestPayload = - encodeNodeState $ stabiliseNodeState payload +encodeStabiliseRequestPayload payload@StabiliseRequestPayload = [Null] encodeQueryResult :: QueryResponse -> ASN1 encodeQueryResult FOUND{} = Enumerated 0 @@ -144,12 +146,12 @@ encodeQueryIDResponsePayload payload@QueryIDResponsePayload{} = FOUND _ -> [] FORWARD entrySet -> Start Sequence - : concatMap encodeCacheEntry . Set.elems $ entrySet + : (concatMap encodeCacheEntry . Set.elems $ entrySet) ++ [End Sequence] ++ [End Sequence] encodeQueryIDRequestPayload :: ActionPayload -> [ASN1] -encodeQueryIDRequestPayload payload@QueryIDResponsePayload = [ +encodeQueryIDRequestPayload payload@QueryIDResponsePayload{} = [ Start Sequence , IntVal . getNodeID $ queryTargetID payload , IntVal $ queryLBestNodes payload @@ -158,30 +160,29 @@ encodeQueryIDRequestPayload payload@QueryIDResponsePayload = [ -- | encodes the @JoinResponsePayload@ ASN.1 type encodeJoinResponsePayload :: ActionPayload -> [ASN1] -encodeJoinResponsePayload payload@JoinResponsePayload = +encodeJoinResponsePayload payload@JoinResponsePayload{} = Start Sequence : Start Sequence - : map (IntVal . getNodeID) $ joinSuccessors payload + : (map (IntVal . getNodeID) $ joinSuccessors payload) ++ [End Sequence , Start Sequence] - ++ map (IntVal . getNodeID) $ joinPredecessors payload + ++ (map (IntVal . getNodeID) $ joinPredecessors payload) ++ [End Sequence , Start Sequence] - ++ concatMap encodeCacheEntry $ joinCache payload + ++ (concatMap encodeCacheEntry $ joinCache payload) ++ [End Sequence , End Sequence] encodeJoinRequestPayload :: ActionPayload -> [ASN1] -encodeJoinRequestPayload payload@JoinRequestPayload = - encodeNodeState $ joinNodeState payload +encodeJoinRequestPayload payload@JoinRequestPayload{} = [Null] -encodePingRequestPayload :: [ASN1] -encodePingRequestPayload = Null +encodePingRequestPayload :: ActionPayload -> [ASN1] +encodePingRequestPayload PingRequestPayload{} = [Null] encodePingResponsePayload :: ActionPayload -> [ASN1] -encodePingResponsePayload payload@PingResponsePayload = +encodePingResponsePayload payload@PingResponsePayload{} = Start Sequence - : concatMap encodeNodeState $ pingNodeStates payload + : (concatMap encodeNodeState $ pingNodeStates payload) ++ [End Sequence] -- | Encode a 'FediChordMessage' as ASN.1. @@ -193,17 +194,18 @@ encodeMessage :: FediChordMessage -- ^ the 'FediChordMessage to be encoded, th -- the message's 'payload' -> [ASN1] encodeMessage - (FediChordMessage Request requestID senderID parts part action _) - payload = [ + (Request requestID sender parts part action _) + payload = Start Sequence - , Enumerated . fromIntegral . fromEnum $ action - , IntVal requestID - , IntVal . getNodeID $ senderID - , IntVal parts + : (Enumerated . fromIntegral . fromEnum $ action) + : IntVal requestID + : encodeNodeState sender + ++ [ + IntVal parts , IntVal part ] ++ payload encodeMessage - (FediChordMessage Response responseTo senderID parts part action _) + (Response responseTo senderID parts part action _) payload = [ Start Sequence , IntVal responseTo @@ -221,13 +223,13 @@ parseMessage = do -- see ASN.1 schema first <- getNext case first of - Enumerated a -> parseRequest . toEnum $ a + Enumerated a -> parseRequest . toEnum . fromIntegral $ a IntVal i -> parseResponse i parseRequest :: Action -> ParseASN1 FediChordMessage parseRequest action = do requestID <- parseInteger - senderID <- (fromInteger <$> parseInteger :: ParseASN1 NodeID) + sender <- parseNodeState parts <- parseInteger part <- parseInteger payload <- onNextContainer Sequence $ @@ -238,14 +240,14 @@ parseRequest action = do Stabilise -> parseStabiliseRequest Ping -> parsePingRequest - return () + return $ Request requestID sender parts part action payload parseResponse :: Integer -> ParseASN1 FediChordMessage parseResponse responseTo = do - senderID <- (fromInteger <$> parseInteger :: ParseASN1 NodeID) + senderID <- fromInteger <$> parseInteger :: ParseASN1 NodeID parts <- parseInteger part <- parseInteger - action <- (parseEnum :: ParseASN1 Action) + action <- parseEnum :: ParseASN1 Action payload <- onNextContainer Sequence $ case action of QueryID -> parseQueryIDResponse @@ -254,7 +256,7 @@ parseResponse responseTo = do Stabilise -> parseStabiliseResponse Ping -> parsePingResponse - return () + return $ Response responseTo senderID parts part action payload parseInteger :: ParseASN1 Integer parseInteger = do @@ -265,3 +267,121 @@ parseEnum :: Enum a => ParseASN1 a parseEnum = do Enumerated en <- getNext return $ toEnum . fromIntegral $ en + +parseString :: ParseASN1 String +parseString = do + ASN1String toBeParsed <- getNext + maybe (throwParseError "string parsing failed") return $ asn1CharacterToString toBeParsed + +parseOctets :: ParseASN1 BS.ByteString +parseOctets = do + OctetString bs <- getNext + return bs + +parseNull :: ParseASN1 () +parseNull = do + -- ToDo: figure out how this fails on wrong inputs, + -- maybe a case distinction + throwParseError is better? + Null <- getNext + return () + +parseNodeState :: ParseASN1 NodeState +parseNodeState = do + nid' <- fromInteger <$> parseInteger + domain' <- parseString + ip' <- bsAsIpAddr <$> parseOctets + dhtPort' <- fromInteger <$> parseInteger + apPort' <- fromInteger <$> parseInteger + vServer' <- parseInteger + return NodeState { + nid = nid' + , domain = domain' + , dhtPort = dhtPort' + , apPort = if apPort' == 0 then Nothing else Just apPort' + , vServerID = vServer' + } + + +parseCacheEntry :: ParseASN1 CacheEntry +parseCacheEntry = do + node <- parseNodeState + timestamp <- toEnum . fromIntegral <$> parseInteger + return $ NodeEntry False node timestamp + +parseNodeCache :: ParseASN1 [CacheEntry] +parseNodeCache = getMany parseCacheEntry + +parseJoinRequest :: ParseASN1 ActionPayload +parseJoinRequest = do + parseNull + return JoinRequestPayload + +parseJoinResponse :: ParseASN1 ActionPayload +parseJoinResponse = do + succ' <- map fromInteger <$> onNextContainer Sequence (getMany parseInteger) + pred' <- map fromInteger <$> onNextContainer Sequence (getMany parseInteger) + cache <- parseNodeCache + return $ JoinResponsePayload { + joinSuccessors = succ' + , joinPredecessors = pred' + , joinCache = cache + } + +parseQueryIDRequest :: ParseASN1 ActionPayload +parseQueryIDRequest = do + targetID <- fromInteger <$> parseInteger + lBestNodes <- parseInteger + return $ QueryIDRequestPayload { + queryTargetID = targetID + , queryLBestNodes = lBestNodes + } + +parseQueryIDResponse :: ParseASN1 ActionPayload +parseQueryIDResponse = do + Enumerated resultType <- getNext + result <- case resultType of + 0 -> FOUND <$> parseNodeState + 1 -> FORWARD . Set.fromList <$> parseNodeCache + return $ QueryIDResponsePayload { + queryResult = result + } + +parseStabiliseRequest :: ParseASN1 ActionPayload +parseStabiliseRequest = do + parseNull + return StabiliseRequestPayload + +parseStabiliseResponse :: ParseASN1 ActionPayload +parseStabiliseResponse = do + succ' <- map fromInteger <$> onNextContainer Sequence (getMany parseInteger) + pred' <- map fromInteger <$> onNextContainer Sequence (getMany parseInteger) + return $ StabiliseResponsePayload { + stabiliseSuccessors = succ' + , stabilisePredecessors = pred' + } + +parseLeaveRequest :: ParseASN1 ActionPayload +parseLeaveRequest = do + succ' <- map fromInteger <$> onNextContainer Sequence (getMany parseInteger) + pred' <- map fromInteger <$> onNextContainer Sequence (getMany parseInteger) + return $ LeaveRequestPayload { + leaveSuccessors = succ' + , leavePredecessors = pred' + } + +parseLeaveResponse :: ParseASN1 ActionPayload +parseLeaveResponse = do + parseNull + return LeaveResponsePayload + +parsePingRequest :: ParseASN1 ActionPayload +parsePingRequest = do + parseNull + return PingRequestPayload + +parsePingResponse :: ParseASN1 ActionPayload +parsePingResponse = do + handledNodes <- getMany parseNodeState + return $ PingResponsePayload { + pingNodeStates = handledNodes + } diff --git a/Hash2Pub/src/Hash2Pub/FediChord.hs b/Hash2Pub/src/Hash2Pub/FediChord.hs index 5958847..4a59689 100644 --- a/Hash2Pub/src/Hash2Pub/FediChord.hs +++ b/Hash2Pub/src/Hash2Pub/FediChord.hs @@ -37,11 +37,12 @@ module Hash2Pub.FediChord ( , genKeyIDBS , byteStringToUInteger , ipAddrAsBS + , bsAsIpAddr ) where import qualified Data.Map.Strict as Map import Network.Socket -import Data.Time.Clock +import Data.Time.Clock.POSIX import Control.Exception import Data.Maybe (isJust, fromMaybe, mapMaybe) @@ -49,10 +50,9 @@ import Data.Maybe (isJust, fromMaybe, mapMaybe) import Crypto.Hash import Data.Word import qualified Data.ByteString as BS -import qualified Data.ByteString.Builder as BB -import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.UTF8 as BSU import qualified Data.ByteArray as BA +import qualified Network.ByteOrder as NetworkBytes import Hash2Pub.Utils @@ -197,7 +197,7 @@ type NodeCache = Map.Map NodeID CacheEntry -- |an entry of the 'nodeCache' can hold 2 different kinds of data data CacheEntry = -- | an entry representing its validation status, the node state and its timestamp - NodeEntry Bool NodeState UTCTime + NodeEntry Bool NodeState POSIXTime -- | a proxy field for closing the ring structure, indicating the lookup shall be -- resumed at the given @NodeID@ unless the @ProxyEntry@ itself holds a @NodeEntry@ | ProxyEntry (NodeID, ProxyDirection) (Maybe CacheEntry) @@ -234,21 +234,21 @@ initCache = Map.fromList $ proxyEntry <$> [(maxBound, (minBound, Forwards)), (mi where proxyEntry (from,to) = (from, ProxyEntry to Nothing) --- | insert a new @NodeState@ node into the cache +-- | insert or update a new @NodeState@ node into the cache addCacheEntry :: NodeState -- ^ the node to insert -> Integer -- ^ initial age penalty in seconds -> NodeCache -- ^ node cache to insert to -> IO NodeCache -- ^ new node cache with the element inserted -addCacheEntry node diffSeconds cache = do - now <- getCurrentTime +addCacheEntry node timestamp cache = do + now <- getPOSIXTime let -- TODO: limit diffSeconds to some maximum value to prevent malicious nodes from inserting entries valid nearly until eternity - timestamp = fromInteger (negate diffSeconds) `addUTCTime` now - newCache = Map.insertWith insertCombineFunction (nid node) (NodeEntry False node timestamp) cache - insertCombineFunction newVal oldVal = + timestamp' = fromInteger timestamp + newCache = Map.insertWith insertCombineFunction (nid node) (NodeEntry False node timestamp') cache + insertCombineFunction newVal@(NodeEntry newValidationState newNode newTimestamp) oldVal = case oldVal of ProxyEntry n _ -> ProxyEntry n (Just newVal) - _ -> newVal + NodeEntry oldValidationState _ oldTimestamp -> NodeEntry oldValidationState newNode (max oldTimestamp newTimestamp) return newCache -- | delete the node with given ID from cache @@ -320,8 +320,18 @@ cacheGetNodeStateUnvalidated _ = error "trying to return empty node state, pleas -- | 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] +ipAddrAsBS (a, b, c, d) = mconcat $ map NetworkBytes.bytestring32 [a, b, c, d] + +-- | converts a ByteString in big endian order to an IPv6 address 'HostAddress6' +bsAsIpAddr :: BS.ByteString -> HostAddress6 +bsAsIpAddr bytes = (a,b,c,d) + where + a:b:c:d:_ = map NetworkBytes.word32 . fourBytes $ bytes + fourBytes bs = + case BS.splitAt 4 bs of + (a, "") -> [a] + (a, b) -> a: fourBytes b + -- | generates a 256 bit long NodeID using SHAKE128, represented as ByteString genNodeIDBS :: HostAddress6 -- ^a node's IPv6 address diff --git a/Hash2Pub/test/FediChordSpec.hs b/Hash2Pub/test/FediChordSpec.hs index 76b19d4..dbe699c 100644 --- a/Hash2Pub/test/FediChordSpec.hs +++ b/Hash2Pub/test/FediChordSpec.hs @@ -65,6 +65,9 @@ spec = do , vServerID = 1 } print nsReady + describe "IP address to ByteString conversion" $ + it "correctly converts HostAddress6 values back and forth" $ + (bsAsIpAddr . ipAddrAsBS $ ipAddr exampleNodeState) `shouldBe` ipAddr exampleNodeState describe "NodeCache" $ do let emptyCache = fromJust $ getNodeCache exampleLocalNode