forked from schmittlauch/Hash2Pub
implement ASN.1 parsing with parser combinators
This commit is contained in:
parent
9f16964efc
commit
1d8d9a33fd
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue