implement ASN.1 parsing with parser combinators

This commit is contained in:
Trolli Schmittlauch 2020-05-04 20:37:16 +02:00
parent 9f16964efc
commit 1d8d9a33fd
5 changed files with 218 additions and 85 deletions

View file

@ -9,15 +9,15 @@ Action ::= ENUMERATED {queryID, join, leave, stabilise, ping}
Request ::= SEQUENCE { Request ::= SEQUENCE {
action Action, action Action,
requestID INTEGER, requestID INTEGER,
senderID NodeID, sender NodeState,
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
actionPayload CHOICE { actionPayload CHOICE {
queryIDSendPayload QueryIDSendPayload, queryIDRequestPayload QueryIDRequestPayload,
joinSendPayload JoinSendPayload, joinRequestPayload JoinRequestPayload,
leaveSendPayload LeaveSendPayload, leaveRequestPayload LeaveRequestPayload,
stabiliseSendPayload StabiliseSendPayload, stabiliseRequestPayload StabiliseRequestPayload,
pingSendPayload PingSendPayload pingRequestPayload PingRequestPayload
} }
} }
@ -31,11 +31,11 @@ Response ::= SEQUENCE {
part INTEGER, part INTEGER,
action Action, action Action,
actionPayload CHOICE { actionPayload CHOICE {
queryIDReceivePayload QueryIDReceivePayload, queryIDResponsePayload QueryIDResponsePayload,
joinReceivePayload JoinReceivePayload, joinResponsePayload JoinResponsePayload,
leaveReceivePayload LeaveReceivePayload, leaveResponsePayload LeaveResponsePayload,
stabiliseReceivePayload StabiliseReceivePayload, stabiliseResponsePayload StabiliseResponsePayload,
pingReceivePayload PingReceivePayload pingResponsePayload PingResponsePayload
} }
} }
@ -45,7 +45,7 @@ NodeState ::= SEQUENCE {
ipAddr OCTET STRING (SIZE(16)), ipAddr OCTET STRING (SIZE(16)),
dhtPort INTEGER, dhtPort INTEGER,
apPort INTEGER, apPort INTEGER,
vServer INTEGER vServerID INTEGER
} }
CacheEntry ::= SEQUENCE { CacheEntry ::= SEQUENCE {
@ -56,47 +56,47 @@ CacheEntry ::= SEQUENCE {
NodeCache ::= SEQUENCE OF CacheEntry NodeCache ::= SEQUENCE OF CacheEntry
JoinSendPayload ::= NodeState JoinRequestPayload ::= NULL
JoinReceivePayload ::= SEQUENCE { JoinResponsePayload ::= SEQUENCE {
successors SEQUENCE OF NodeID, successors SEQUENCE OF NodeID,
predecessors SEQUENCE OF NodeID, predecessors SEQUENCE OF NodeID,
cache NodeCache cache NodeCache
} }
QueryIDSendPayload ::= SEQUENCE { QueryResult ::= ENUMERATED { found, forward }
QueryIDRequestPayload ::= SEQUENCE {
targetID NodeID, targetID NodeID,
lBestNodes INTEGER lBestNodes INTEGER
} }
QueryResult ::= ENUMERATED { found, forward } QueryIDResponsePayload ::= SEQUENCE {
QueryIDReceivePayload ::= SEQUENCE {
result QueryResult, result QueryResult,
nodeData NodeCache OPTIONAL -- empty if `found` nodeData CHOICE {NodeState, NodeCache}
} }
StabiliseSendPayload ::= NodeState StabiliseRequestPayload ::= NULL
StabiliseReceivePayload ::= SEQUENCE { StabiliseResponsePayload ::= SEQUENCE {
successors SEQUENCE OF NodeID, successors SEQUENCE OF NodeID,
predecessors SEQUENCE OF NodeID predecessors SEQUENCE OF NodeID
-- ToDo: transfer of handled key data, if newly responsible for it -- ToDo: transfer of handled key data, if newly responsible for it
} }
LeaveSendPayload ::= SEQUENCE { LeaveRequestPayload ::= SEQUENCE {
successors SEQUENCE OF NodeID, successors SEQUENCE OF NodeID,
predecessors SEQUENCE OF NodeID predecessors SEQUENCE OF NodeID
-- ToDo: transfer of own data to newly responsible node -- 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 -- the node has to respond with all active ones
-- learning all active vserver IDs handled by the server at once -- learning all active vserver IDs handled by the server at once
PingReceivePayload ::= SEQUENCE OF NodeState PingResponsePayload ::= SEQUENCE OF NodeState
END END

View file

@ -46,7 +46,7 @@ category: Network
extra-source-files: CHANGELOG.md extra-source-files: CHANGELOG.md
common deps 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 ghc-options: -Wall

View file

@ -26,33 +26,35 @@ data Action =
-- ToDo: probably move this to DHTProtocol as it is high-level -- ToDo: probably move this to DHTProtocol as it is high-level
data FediChordMessage = FediChordMessage { data FediChordMessage =
messageType :: MessageType Request {
, requestID :: Integer requestID :: Integer
, sender :: NodeState
, parts :: Integer
, part :: Integer
, action :: Action
, payload :: ActionPayload
}
| Response {
responseTo :: Integer
, senderID :: NodeID , senderID :: NodeID
, parts :: Integer , parts :: Integer
, part :: Integer , part :: Integer
, action :: Action , action :: Action
, payload :: ActionPayload , payload :: ActionPayload
} deriving (Show, Eq) } deriving (Show, Eq)
data MessageType = Request | Response deriving (Show, Eq, Enum)
data ActionPayload = data ActionPayload =
QueryIDRequestPayload { QueryIDRequestPayload {
queryTargetID :: NodeID queryTargetID :: NodeID
, queryLBestNodes :: Integer , queryLBestNodes :: Integer
} }
| JoinRequestPayload { | JoinRequestPayload
joinNodeState :: NodeState
}
| LeaveRequestPayload { | LeaveRequestPayload {
leaveSuccessors :: [NodeID] leaveSuccessors :: [NodeID]
, leavePredecessors :: [NodeID] , leavePredecessors :: [NodeID]
} }
| StabiliseRequestPayload { | StabiliseRequestPayload
stabiliseNodeState :: NodeState
}
| PingRequestPayload | PingRequestPayload
| QueryIDResponsePayload { | QueryIDResponsePayload {
queryResult :: QueryResponse queryResult :: QueryResponse
@ -82,6 +84,7 @@ encodeNodeState :: NodeState -> [ASN1]
encodeNodeState ns = [ encodeNodeState ns = [
Start Sequence Start Sequence
, IntVal (getNodeID . nid $ ns) , IntVal (getNodeID . nid $ ns)
, ASN1String . asn1CharacterString Visible $ domain ns
, OctetString (ipAddrAsBS $ ipAddr ns) , OctetString (ipAddrAsBS $ ipAddr ns)
, IntVal (toInteger . dhtPort $ ns) , IntVal (toInteger . dhtPort $ ns)
, IntVal (maybe 0 toInteger $ apPort ns) , IntVal (maybe 0 toInteger $ apPort ns)
@ -95,21 +98,21 @@ encodeCacheEntry (NodeEntry _ ns timestamp) =
: encodeNodeState ns : encodeNodeState ns
-- ToDo: possibly optimise this by using dlists -- ToDo: possibly optimise this by using dlists
++ [ ++ [
IntVal . fromIntegral . fromEnum . utcTimeToPOSIXSeconds $ timestamp IntVal . fromIntegral . fromEnum $ timestamp
, End Sequence] , End Sequence]
encodeCacheEntry _ = [] encodeCacheEntry _ = []
encodeLeaveResponsePayload :: [ASN1] encodeLeaveResponsePayload :: ActionPayload -> [ASN1]
encodeLeaveResponsePayload = [Null] encodeLeaveResponsePayload LeaveResponsePayload = [Null]
encodeLeaveRequestPayload :: ActionPayload -> [ASN1] encodeLeaveRequestPayload :: ActionPayload -> [ASN1]
encodeLeaveRequestPayload payload@LeaveRequestPayload{} = encodeLeaveRequestPayload payload@LeaveRequestPayload{} =
Start Sequence Start Sequence
: Start Sequence : Start Sequence
: map (IntVal . getNodeID) $ leaveSuccessors payload : (map (IntVal . getNodeID) $ leaveSuccessors payload)
++ [End Sequence ++ [End Sequence
, Start Sequence] , Start Sequence]
++ map (IntVal . getNodeID) $ leavePredecessors payload ++ (map (IntVal . getNodeID) $ leavePredecessors payload)
++ [End Sequence ++ [End Sequence
, End Sequence] , End Sequence]
@ -118,16 +121,15 @@ encodeStabiliseResponsePayload :: ActionPayload -> [ASN1]
encodeStabiliseResponsePayload payload@StabiliseResponsePayload{} = encodeStabiliseResponsePayload payload@StabiliseResponsePayload{} =
Start Sequence Start Sequence
: Start Sequence : Start Sequence
: map (IntVal . getNodeID) $ stabiliseSuccessors payload : (map (IntVal . getNodeID) $ stabiliseSuccessors payload)
++ [End Sequence ++ [End Sequence
, Start Sequence] , Start Sequence]
++ map (IntVal . getNodeID) $ stabilisePredecessors payload ++ (map (IntVal . getNodeID) $ stabilisePredecessors payload)
++ [End Sequence ++ [End Sequence
, End Sequence] , End Sequence]
encodeStabiliseRequestPayload :: ActionPayload -> [ASN1] encodeStabiliseRequestPayload :: ActionPayload -> [ASN1]
encodeStabiliseRequestPayload payload@StabiliseRequestPayload = encodeStabiliseRequestPayload payload@StabiliseRequestPayload = [Null]
encodeNodeState $ stabiliseNodeState payload
encodeQueryResult :: QueryResponse -> ASN1 encodeQueryResult :: QueryResponse -> ASN1
encodeQueryResult FOUND{} = Enumerated 0 encodeQueryResult FOUND{} = Enumerated 0
@ -144,12 +146,12 @@ encodeQueryIDResponsePayload payload@QueryIDResponsePayload{} =
FOUND _ -> [] FOUND _ -> []
FORWARD entrySet -> FORWARD entrySet ->
Start Sequence Start Sequence
: concatMap encodeCacheEntry . Set.elems $ entrySet : (concatMap encodeCacheEntry . Set.elems $ entrySet)
++ [End Sequence] ++ [End Sequence]
++ [End Sequence] ++ [End Sequence]
encodeQueryIDRequestPayload :: ActionPayload -> [ASN1] encodeQueryIDRequestPayload :: ActionPayload -> [ASN1]
encodeQueryIDRequestPayload payload@QueryIDResponsePayload = [ encodeQueryIDRequestPayload payload@QueryIDResponsePayload{} = [
Start Sequence Start Sequence
, IntVal . getNodeID $ queryTargetID payload , IntVal . getNodeID $ queryTargetID payload
, IntVal $ queryLBestNodes payload , IntVal $ queryLBestNodes payload
@ -158,30 +160,29 @@ encodeQueryIDRequestPayload payload@QueryIDResponsePayload = [
-- | encodes the @JoinResponsePayload@ ASN.1 type -- | encodes the @JoinResponsePayload@ ASN.1 type
encodeJoinResponsePayload :: ActionPayload -> [ASN1] encodeJoinResponsePayload :: ActionPayload -> [ASN1]
encodeJoinResponsePayload payload@JoinResponsePayload = encodeJoinResponsePayload payload@JoinResponsePayload{} =
Start Sequence Start Sequence
: Start Sequence : Start Sequence
: map (IntVal . getNodeID) $ joinSuccessors payload : (map (IntVal . getNodeID) $ joinSuccessors payload)
++ [End Sequence ++ [End Sequence
, Start Sequence] , Start Sequence]
++ map (IntVal . getNodeID) $ joinPredecessors payload ++ (map (IntVal . getNodeID) $ joinPredecessors payload)
++ [End Sequence ++ [End Sequence
, Start Sequence] , Start Sequence]
++ concatMap encodeCacheEntry $ joinCache payload ++ (concatMap encodeCacheEntry $ joinCache payload)
++ [End Sequence ++ [End Sequence
, End Sequence] , End Sequence]
encodeJoinRequestPayload :: ActionPayload -> [ASN1] encodeJoinRequestPayload :: ActionPayload -> [ASN1]
encodeJoinRequestPayload payload@JoinRequestPayload = encodeJoinRequestPayload payload@JoinRequestPayload{} = [Null]
encodeNodeState $ joinNodeState payload
encodePingRequestPayload :: [ASN1] encodePingRequestPayload :: ActionPayload -> [ASN1]
encodePingRequestPayload = Null encodePingRequestPayload PingRequestPayload{} = [Null]
encodePingResponsePayload :: ActionPayload -> [ASN1] encodePingResponsePayload :: ActionPayload -> [ASN1]
encodePingResponsePayload payload@PingResponsePayload = encodePingResponsePayload payload@PingResponsePayload{} =
Start Sequence Start Sequence
: concatMap encodeNodeState $ pingNodeStates payload : (concatMap encodeNodeState $ pingNodeStates payload)
++ [End Sequence] ++ [End Sequence]
-- | Encode a 'FediChordMessage' as ASN.1. -- | Encode a 'FediChordMessage' as ASN.1.
@ -193,17 +194,18 @@ encodeMessage :: FediChordMessage -- ^ the 'FediChordMessage to be encoded, th
-- the message's 'payload' -- the message's 'payload'
-> [ASN1] -> [ASN1]
encodeMessage encodeMessage
(FediChordMessage Request requestID senderID parts part action _) (Request requestID sender parts part action _)
payload = [ payload =
Start Sequence Start Sequence
, Enumerated . fromIntegral . fromEnum $ action : (Enumerated . fromIntegral . fromEnum $ action)
, IntVal requestID : IntVal requestID
, IntVal . getNodeID $ senderID : encodeNodeState sender
, IntVal parts ++ [
IntVal parts
, IntVal part ] , IntVal part ]
++ payload ++ payload
encodeMessage encodeMessage
(FediChordMessage Response responseTo senderID parts part action _) (Response responseTo senderID parts part action _)
payload = [ payload = [
Start Sequence Start Sequence
, IntVal responseTo , IntVal responseTo
@ -221,13 +223,13 @@ parseMessage = do
-- see ASN.1 schema -- see ASN.1 schema
first <- getNext first <- getNext
case first of case first of
Enumerated a -> parseRequest . toEnum $ a Enumerated a -> parseRequest . toEnum . fromIntegral $ a
IntVal i -> parseResponse i IntVal i -> parseResponse i
parseRequest :: Action -> ParseASN1 FediChordMessage parseRequest :: Action -> ParseASN1 FediChordMessage
parseRequest action = do parseRequest action = do
requestID <- parseInteger requestID <- parseInteger
senderID <- (fromInteger <$> parseInteger :: ParseASN1 NodeID) sender <- parseNodeState
parts <- parseInteger parts <- parseInteger
part <- parseInteger part <- parseInteger
payload <- onNextContainer Sequence $ payload <- onNextContainer Sequence $
@ -238,14 +240,14 @@ parseRequest action = do
Stabilise -> parseStabiliseRequest Stabilise -> parseStabiliseRequest
Ping -> parsePingRequest Ping -> parsePingRequest
return () return $ Request requestID sender parts part action payload
parseResponse :: Integer -> ParseASN1 FediChordMessage parseResponse :: Integer -> ParseASN1 FediChordMessage
parseResponse responseTo = do parseResponse responseTo = do
senderID <- (fromInteger <$> parseInteger :: ParseASN1 NodeID) senderID <- fromInteger <$> parseInteger :: ParseASN1 NodeID
parts <- parseInteger parts <- parseInteger
part <- parseInteger part <- parseInteger
action <- (parseEnum :: ParseASN1 Action) action <- parseEnum :: ParseASN1 Action
payload <- onNextContainer Sequence $ payload <- onNextContainer Sequence $
case action of case action of
QueryID -> parseQueryIDResponse QueryID -> parseQueryIDResponse
@ -254,7 +256,7 @@ parseResponse responseTo = do
Stabilise -> parseStabiliseResponse Stabilise -> parseStabiliseResponse
Ping -> parsePingResponse Ping -> parsePingResponse
return () return $ Response responseTo senderID parts part action payload
parseInteger :: ParseASN1 Integer parseInteger :: ParseASN1 Integer
parseInteger = do parseInteger = do
@ -265,3 +267,121 @@ parseEnum :: Enum a => ParseASN1 a
parseEnum = do parseEnum = do
Enumerated en <- getNext Enumerated en <- getNext
return $ toEnum . fromIntegral $ en 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
}

View file

@ -37,11 +37,12 @@ module Hash2Pub.FediChord (
, genKeyIDBS , genKeyIDBS
, byteStringToUInteger , byteStringToUInteger
, ipAddrAsBS , ipAddrAsBS
, bsAsIpAddr
) 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.POSIX
import Control.Exception import Control.Exception
import Data.Maybe (isJust, fromMaybe, mapMaybe) import Data.Maybe (isJust, fromMaybe, mapMaybe)
@ -49,10 +50,9 @@ import Data.Maybe (isJust, fromMaybe, mapMaybe)
import Crypto.Hash import Crypto.Hash
import Data.Word import Data.Word
import qualified Data.ByteString as BS 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.ByteString.UTF8 as BSU
import qualified Data.ByteArray as BA import qualified Data.ByteArray as BA
import qualified Network.ByteOrder as NetworkBytes
import Hash2Pub.Utils 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 -- |an entry of the 'nodeCache' can hold 2 different kinds of data
data CacheEntry = data CacheEntry =
-- | an entry representing its validation status, the node state and its timestamp -- | 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 -- | 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@ -- resumed at the given @NodeID@ unless the @ProxyEntry@ itself holds a @NodeEntry@
| ProxyEntry (NodeID, ProxyDirection) (Maybe CacheEntry) | ProxyEntry (NodeID, ProxyDirection) (Maybe CacheEntry)
@ -234,21 +234,21 @@ initCache = Map.fromList $ proxyEntry <$> [(maxBound, (minBound, Forwards)), (mi
where where
proxyEntry (from,to) = (from, ProxyEntry to Nothing) 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 addCacheEntry :: NodeState -- ^ the node to insert
-> Integer -- ^ initial age penalty in seconds -> Integer -- ^ initial age penalty in seconds
-> NodeCache -- ^ node cache to insert to -> NodeCache -- ^ node cache to insert to
-> IO NodeCache -- ^ new node cache with the element inserted -> IO NodeCache -- ^ new node cache with the element inserted
addCacheEntry node diffSeconds cache = do addCacheEntry node timestamp cache = do
now <- getCurrentTime now <- getPOSIXTime
let let
-- TODO: limit diffSeconds to some maximum value to prevent malicious nodes from inserting entries valid nearly until eternity -- TODO: limit diffSeconds to some maximum value to prevent malicious nodes from inserting entries valid nearly until eternity
timestamp = fromInteger (negate diffSeconds) `addUTCTime` now timestamp' = fromInteger timestamp
newCache = Map.insertWith insertCombineFunction (nid node) (NodeEntry False node timestamp) cache newCache = Map.insertWith insertCombineFunction (nid node) (NodeEntry False node timestamp') cache
insertCombineFunction newVal oldVal = insertCombineFunction newVal@(NodeEntry newValidationState newNode newTimestamp) oldVal =
case oldVal of case oldVal of
ProxyEntry n _ -> ProxyEntry n (Just newVal) ProxyEntry n _ -> ProxyEntry n (Just newVal)
_ -> newVal NodeEntry oldValidationState _ oldTimestamp -> NodeEntry oldValidationState newNode (max oldTimestamp newTimestamp)
return newCache return newCache
-- | delete the node with given ID from cache -- | 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 -- | converts a 'HostAddress6' IP address to a big-endian strict ByteString
ipAddrAsBS :: HostAddress6 -> BS.ByteString ipAddrAsBS :: HostAddress6 -> BS.ByteString
-- TODO: this is inefficient and possibly better done with binary-strict ipAddrAsBS (a, b, c, d) = mconcat $ map NetworkBytes.bytestring32 [a, b, c, d]
ipAddrAsBS (a, b, c, d) = BL.toStrict . BB.toLazyByteString . mconcat $ map BB.word32BE [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 -- | 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

View file

@ -65,6 +65,9 @@ spec = do
, vServerID = 1 , vServerID = 1
} }
print nsReady 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 describe "NodeCache" $ do
let let
emptyCache = fromJust $ getNodeCache exampleLocalNode emptyCache = fromJust $ getNodeCache exampleLocalNode