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 {
|
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
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
}
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue