Hash2Pub/test/FediChordSpec.hs

294 lines
17 KiB
Haskell
Raw Normal View History

{-# LANGUAGE OverloadedStrings #-}
module FediChordSpec where
import Control.Exception
2020-06-15 16:41:03 +02:00
import Data.ASN1.Parse (runParseASN1)
import qualified Data.ByteString as BS
import qualified Data.Map.Strict as Map
import Data.Maybe (fromJust, isJust)
import qualified Data.Set as Set
import Data.Time.Clock.POSIX
import Network.Socket
import Test.Hspec
import Hash2Pub.ASN1Coding
import Hash2Pub.DHTProtocol
import Hash2Pub.FediChord
2020-06-15 16:41:03 +02:00
import Hash2Pub.FediChordTypes
spec :: Spec
spec = do
describe "NodeID" $ do
it "can store a numeral ID" $
getNodeID (toNodeID 2342) `shouldBe` 2342
it "computes ID values within the modular bounds" $ do
getNodeID ((maxBound :: NodeID) + toNodeID 2) < getNodeID (maxBound :: NodeID) `shouldBe` True
3 * (maxBound :: NodeID) `shouldBe` fromInteger (-3)
it "local comparison works in the context of preceding/ succeding nodes on a ring" $ do
toNodeID 12 `localCompare` toNodeID 12 `shouldBe` EQ
let
a = toNodeID 3
b = toNodeID 3 - toNodeID 10
a `localCompare` b `shouldBe` GT
b `localCompare` a `shouldBe` LT
-- edge cases
((toNodeID 5001 - toNodeID 2^(255::Integer)) `localCompare` 5001) `shouldBe` LT
(toNodeID 5001 - toNodeID 2^(255::Integer) - 1) `localCompare` 5001 `shouldBe` GT
2020-04-01 13:26:42 +02:00
it "throws an exception when @toNodeID@ on out-of-bound values"
pending
it "can be generated" $ do
2020-04-12 00:17:38 +02:00
genNodeIDBS exampleIp exampleNodeDomain exampleVs `shouldBe` "\ACK\211\183&S\GS\214\247Xn8\216\232\195\247\162\182\253\210\SOHG7I\194\251\196\130\142RSx\219"
genNodeID exampleIp exampleNodeDomain exampleVs `shouldBe` toNodeID 3087945874980469002564169693112490135217795916629034079089428181202645514459
describe "ByteString to Integer conversion" $
it "correctly interprets ByteStrings as unsigned big-endian integers" $ do
2020-03-20 20:25:52 +01:00
byteStringToUInteger (BS.pack $ replicate 32 0xff) `shouldBe` 2^(256::Integer)-1
byteStringToUInteger (BS.pack $ replicate 32 0x00) `shouldBe` 0
byteStringToUInteger (BS.pack [0x00, 0x03, 0xf6, 0x78, 0x10, 0x00]) `shouldBe` 17019965440
2020-03-21 01:13:21 +01:00
describe "key ID" $
it "can be generated" $ do
genKeyIDBS "#sometag" `shouldBe` "\178\239\146\131\166\SYN\ESC\209\205\&3\143\212\145@#\205T\219\152\191\229\ACK|\153<b\199p\147\182&l"
genKeyIDBS "#ÄปӥicоdeTag" `shouldBe` "\f\159\165|D*\SUB\180\SO\202\&0\158\148\238\STX FZ/\184\SOH\188\169\153\154\164\229\&2Ix\SUB\169"
genKeyID "#sometag" `shouldBe` 80934974700514031200587628522801847528706765451025022694022301350330549806700
genKeyID "#ÄปӥicоdeTag" `shouldBe` 5709825004658123480531764908635278432808461265905814952223156184506818894505
describe "NodeState" $ do
2020-04-12 00:17:38 +02:00
it "can be initialised" $
print exampleNodeState
2020-03-20 20:17:27 +01:00
it "can be initialised partly and then modified later" $ do
let ns = RemoteNodeState {
2020-03-20 20:17:27 +01:00
nid = undefined
2020-04-12 00:17:38 +02:00
, domain = exampleNodeDomain
, ipAddr = exampleIp
2020-03-20 20:17:27 +01:00
, dhtPort = 2342
, servicePort = 513
, vServerID = undefined
2020-03-20 20:17:27 +01:00
}
nsReady = ns {
nid = genNodeID (ipAddr ns) (domain ns) 3
, vServerID = 1
2020-03-20 20:17:27 +01:00
}
print nsReady
describe "IP address to ByteString conversion" $
it "correctly converts HostAddress6 values back and forth" $
(bsAsIpAddr . ipAddrAsBS $ ipAddr exampleNodeState) `shouldBe` ipAddr exampleNodeState
2020-04-12 00:17:38 +02:00
describe "NodeCache" $ do
2020-04-16 01:08:41 +02:00
let
emptyCache = initCache
2020-04-16 01:08:41 +02:00
anotherID = toNodeID 2^(230::Integer)+1
anotherNode = exampleNodeState { nid = anotherID}
maxNode = exampleNodeState { nid = maxBound}
2020-05-17 01:06:50 +02:00
newCache = addCacheEntryPure 10 (RemoteCacheEntry exampleNodeState 10) (addCacheEntryPure 10 (RemoteCacheEntry anotherNode 10) emptyCache)
exampleID = nid exampleNodeState
2020-04-16 01:08:41 +02:00
it "entries can be added to a node cache and looked up again" $ do
2020-06-15 16:41:03 +02:00
rMapSize emptyCache `shouldBe` 0
rMapSize newCache `shouldBe` 2
2020-04-16 01:08:41 +02:00
-- normal entry lookup
2020-05-17 01:06:50 +02:00
nid . cacheGetNodeStateUnvalidated <$> cacheLookup anotherID newCache `shouldBe` Just anotherID
nid . cacheGetNodeStateUnvalidated <$> cacheLookup (anotherID+1) newCache `shouldBe` Nothing
2020-04-16 01:08:41 +02:00
-- initially, the proxy elements store nothing
cacheLookup minBound emptyCache `shouldBe` Nothing
cacheLookup maxBound emptyCache `shouldBe` Nothing
-- now store a node at that ID
2020-05-17 01:06:50 +02:00
let cacheWithMaxNode = addCacheEntryPure 10 (RemoteCacheEntry maxNode 10) newCache
2020-04-16 01:08:41 +02:00
nid . cacheGetNodeStateUnvalidated <$> cacheLookup maxBound cacheWithMaxNode `shouldBe` Just maxBound
it "looking up predecessor and successor works like on a modular ring" $ do
-- ignore empty proxy elements in initial cache
nid . cacheGetNodeStateUnvalidated <$> cacheLookupPred (exampleID + 10) emptyCache `shouldBe` Nothing
nid . cacheGetNodeStateUnvalidated <$> cacheLookupSucc exampleID emptyCache `shouldBe` Nothing
2020-05-17 01:06:50 +02:00
-- given situation: 0 < anotherNode < nid exampleLocalNode < maxBound
2020-04-16 01:08:41 +02:00
-- first try non-modular queries between the 2 stored nodes
nid . cacheGetNodeStateUnvalidated <$> cacheLookupPred (exampleID + 10) newCache `shouldBe` Just exampleID
nid . cacheGetNodeStateUnvalidated <$> cacheLookupSucc exampleID newCache `shouldBe` Just exampleID
2020-05-17 01:06:50 +02:00
nid . cacheGetNodeStateUnvalidated <$> cacheLookupSucc (exampleID + 10) newCache `shouldBe` Just anotherID
2020-04-16 01:08:41 +02:00
-- queries that require a (pseudo)modular structure
2020-05-17 01:06:50 +02:00
nid . cacheGetNodeStateUnvalidated <$> cacheLookupPred (exampleID - 2) newCache `shouldBe` Just anotherID
nid . cacheGetNodeStateUnvalidated <$> cacheLookupSucc (anotherID + 2) newCache `shouldBe` Just exampleID
2020-04-16 01:08:41 +02:00
-- now store a node in one of the ProxyEntries
2020-05-17 01:06:50 +02:00
let cacheWithProxyNodeEntry = addCacheEntryPure 10 (RemoteCacheEntry maxNode 10) newCache
nid . cacheGetNodeStateUnvalidated <$> cacheLookupPred (exampleID - 2) cacheWithProxyNodeEntry `shouldBe` Just maxBound
nid . cacheGetNodeStateUnvalidated <$> cacheLookupSucc (anotherID + 2) cacheWithProxyNodeEntry `shouldBe` Just maxBound
it "entries can be deleted" $ do
2020-05-17 01:06:50 +02:00
let
nC = addCacheEntryPure 10 (RemoteCacheEntry maxNode 10) newCache
nc' = deleteCacheEntry maxBound . deleteCacheEntry anotherID $ nC
cacheLookup anotherID nc' `shouldBe` Nothing
cacheLookup maxBound nc' `shouldBe` Nothing
2020-04-16 01:08:41 +02:00
describe "NodeCache query lookup" $ do
let
emptyCache = initCache
nid1 = toNodeID 2^(23::Integer)+1
node1 = setPredecessors [node4] . setNid nid1 <$> exampleLocalNode
nid2 = toNodeID 2^(230::Integer)+12
node2 = exampleNodeState { nid = nid2}
nid3 = toNodeID 2^(25::Integer)+10
node3 = exampleNodeState { nid = nid3}
nid4 = toNodeID 2^(9::Integer)+100
node4 = exampleNodeState { nid = nid4}
nid5 = toNodeID 2^(25::Integer)+100
node5 = exampleNodeState { nid = nid5}
cacheWith2Entries :: NodeCache
cacheWith2Entries = addCacheEntryPure 10 (RemoteCacheEntry node5 10) (addCacheEntryPure 10 (RemoteCacheEntry node2 10) emptyCache)
cacheWith4Entries = addCacheEntryPure 10 (RemoteCacheEntry node3 10) (addCacheEntryPure 10 (RemoteCacheEntry node4 10) cacheWith2Entries)
it "nodes not joined provide the default answer FOUND" $ do
exampleLocalNodeAsRemote <- toRemoteNodeState <$> exampleLocalNode
queryLocalCache <$> exampleLocalNode <*> pure emptyCache <*> pure 3 <*> pure (toNodeID 2^(9::Integer)+5) `shouldReturn` FOUND exampleLocalNodeAsRemote
queryLocalCache <$> exampleLocalNode <*> pure cacheWith4Entries <*> pure 1 <*> pure (toNodeID 2342) `shouldReturn` FOUND exampleLocalNodeAsRemote
it "joined nodes do not fall back to the default" $
queryLocalCache <$> node1 <*> pure emptyCache <*> pure 1 <*> pure (toNodeID 3) `shouldReturn` FORWARD Set.empty
it "works on a cache with less entries than needed" $ do
(FORWARD nodeset) <- queryLocalCache <$> node1 <*> pure cacheWith2Entries <*> pure 4 <*> pure (toNodeID 2^(9::Integer)+5)
Set.map (nid . remoteNode) nodeset `shouldBe` Set.fromList [ nid5, nid2 ]
it "works on a cache with sufficient entries" $ do
(FORWARD nodeset1) <- queryLocalCache <$> node1 <*> pure cacheWith4Entries <*> pure 3 <*> pure (toNodeID 2^(9::Integer)+5)
(FORWARD nodeset2) <- queryLocalCache <$> node1 <*> pure cacheWith4Entries <*> pure 1 <*> pure (toNodeID 2^(9::Integer)+5)
Set.map (nid . remoteNode) nodeset1 `shouldBe` Set.fromList [nid4, nid2, nid5]
Set.map (nid . remoteNode) nodeset2 `shouldBe` Set.fromList [nid4]
it "recognises the node's own responsibility" $ do
FOUND selfQueryRes <- queryLocalCache <$> node1 <*> pure cacheWith4Entries <*> pure 3 <*> pure nid1
getNid <$> node1 `shouldReturn` getNid selfQueryRes
FOUND responsibilityResult <- queryLocalCache <$> node1 <*> pure cacheWith4Entries <*> pure 3 <*> pure (toNodeID 2^(22::Integer))
getNid <$> node1 `shouldReturn` getNid responsibilityResult
2020-06-13 14:47:40 +02:00
describe "successors and predecessors do not disturb the ring characteristics of EpiChord operations (see #48)" $ do
let
emptyCache = initCache
-- implicitly relies on kNieghbours to be <= 3
thisNid = toNodeID 1000
thisNode = setNid thisNid <$> exampleLocalNode
nid2 = toNodeID 1003
node2 = exampleNodeState { nid = nid2}
nid3 = toNodeID 1010
node3 = exampleNodeState { nid = nid3}
nid4 = toNodeID 1020
node4 = exampleNodeState { nid = nid4}
nid5 = toNodeID 1025
node5 = exampleNodeState { nid = nid5}
allRemoteNodes = [node2, node3, node4, node5]
it "lookups also work for slices larger than 1/2 key space" $ do
node <- setSuccessors allRemoteNodes . setPredecessors allRemoteNodes <$> thisNode
-- do lookup on empty cache but with successors for a key > 1/2 key space
-- succeeding the node
queryLocalCache node emptyCache 1 (nid5 + 10) `shouldBe` FOUND (toRemoteNodeState node)
describe "Messages can be encoded to and decoded from ASN.1" $ do
-- define test messages
let
someNodes = fmap (flip setNid exampleNodeState . fromInteger) [3..12]
qidReqPayload = QueryIDRequestPayload {
queryTargetID = nid exampleNodeState
, queryLBestNodes = 3
}
jReqPayload = JoinRequestPayload
lReqPayload = LeaveRequestPayload {
leaveSuccessors = someNodes
, leavePredecessors = someNodes
}
stabReqPayload = StabiliseRequestPayload
pingReqPayload = PingRequestPayload
qidResPayload1 = QueryIDResponsePayload {
queryResult = FOUND exampleNodeState
}
qidResPayload2 = QueryIDResponsePayload {
queryResult = FORWARD $ Set.fromList [
RemoteCacheEntry exampleNodeState (toEnum 23420001)
, RemoteCacheEntry (exampleNodeState {nid = fromInteger (-5)}) (toEnum 0)
]
}
jResPayload = JoinResponsePayload {
joinSuccessors = someNodes
, joinPredecessors = someNodes
, joinCache = [
RemoteCacheEntry exampleNodeState (toEnum 23420001)
, RemoteCacheEntry (exampleNodeState {nid = fromInteger (-5)}) (toEnum 0)
]
}
lResPayload = LeaveResponsePayload
stabResPayload = StabiliseResponsePayload {
stabiliseSuccessors = someNodes
, stabilisePredecessors = []
}
pingResPayload = PingResponsePayload {
pingNodeStates = [
exampleNodeState
, exampleNodeState {nid = fromInteger (-5)}
]
}
requestTemplate = Request {
requestID = 2342
, sender = exampleNodeState
, part = 1
, isFinalPart = True
, action = undefined
, payload = undefined
}
responseTemplate = Response {
requestID = 2342
, senderID = nid exampleNodeState
, part = 1
, isFinalPart = True
, action = undefined
, payload = undefined
}
requestWith a pa = requestTemplate {action = a, payload = Just pa}
responseWith a pa = responseTemplate {action = a, payload = Just pa}
encodeDecodeAndCheck msg = runParseASN1 parseMessage (encodeMessage msg) `shouldBe` pure msg
largeMessage = responseWith Join $ JoinResponsePayload {
joinSuccessors = flip setNid exampleNodeState . fromInteger <$> [-20..150]
, joinPredecessors = flip setNid exampleNodeState . fromInteger <$> [5..11]
, joinCache = [ RemoteCacheEntry (exampleNodeState {nid = node}) 290001 | node <- [50602,506011..60000]]
}
it "messages are encoded and decoded correctly from and to ASN1" $ do
encodeDecodeAndCheck $ requestWith QueryID qidReqPayload
encodeDecodeAndCheck $ requestWith Join jReqPayload
encodeDecodeAndCheck $ requestWith Leave lReqPayload
encodeDecodeAndCheck $ requestWith Stabilise stabReqPayload
encodeDecodeAndCheck $ requestWith Ping pingReqPayload
encodeDecodeAndCheck $ responseWith QueryID qidResPayload1
encodeDecodeAndCheck $ responseWith QueryID qidResPayload2
encodeDecodeAndCheck $ responseWith Join jResPayload
encodeDecodeAndCheck $ responseWith Leave lResPayload
encodeDecodeAndCheck $ responseWith Stabilise stabResPayload
encodeDecodeAndCheck $ responseWith Ping pingResPayload
it "messages are encoded and decoded to ASN.1 DER properly" $
deserialiseMessage (fromJust $ Map.lookup 1 (serialiseMessage 652 $ responseWith Ping pingResPayload)) `shouldBe` Right (responseWith Ping pingResPayload)
it "messages too large for a single packet can (often) be split into multiple parts" $ do
-- TODO: once splitting works more efficient, test for exact number or payload, see #18
length (serialiseMessage 600 largeMessage) > 1 `shouldBe` True
length (serialiseMessage 60000 largeMessage) `shouldBe` 1
it "message part numbering starts at the submitted part number" $ do
isJust (Map.lookup 1 (serialiseMessage 600 largeMessage)) `shouldBe` True
let startAt5 = serialiseMessage 600 (largeMessage {part = 5})
Map.lookup 1 startAt5 `shouldBe` Nothing
part <$> (deserialiseMessage . fromJust) (Map.lookup 5 startAt5) `shouldBe` Right 5
2020-04-12 00:17:38 +02:00
-- some example data
exampleNodeState :: RemoteNodeState
exampleNodeState = RemoteNodeState {
2020-04-12 00:17:38 +02:00
nid = toNodeID 12
, domain = exampleNodeDomain
, ipAddr = exampleIp
, dhtPort = 2342
, servicePort = 513
, vServerID = 0
}
exampleLocalNode :: IO LocalNodeState
exampleLocalNode = nodeStateInit $ FediChordConf {
confDomain = "example.social"
, confIP = exampleIp
, confDhtPort = 2342
}
2020-04-12 00:17:38 +02:00
exampleNodeDomain :: String
exampleNodeDomain = "example.social"
exampleVs :: (Integral i) => i
exampleVs = 4
exampleIp :: HostAddress6
exampleIp = tupleToHostAddress6 (0x2001, 0x16b8, 0x755a, 0xb110, 0x7d6a, 0x12ab, 0xf0c5, 0x386e)