{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} module FediChordSpec where import Control.Concurrent.STM.TVar import Control.Exception 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 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 it "throws an exception when @toNodeID@ on out-of-bound values" pending it "can be generated" $ do 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 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 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 cacheLookup anotherID newCache `shouldBe` Just anotherID nid . cacheGetNodeStateUnvalidated <$> cacheLookup (anotherID+1) newCache `shouldBe` Nothing -- initially, the proxy elements store nothing cacheLookup minBound emptyCache `shouldBe` Nothing cacheLookup maxBound emptyCache `shouldBe` Nothing -- now store a node at that ID let cacheWithMaxNode = addCacheEntryPure 10 (RemoteCacheEntry maxNode 10) newCache 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 -- given situation: 0 < anotherNode < nid exampleLocalNode < maxBound -- 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 nid . cacheGetNodeStateUnvalidated <$> cacheLookupSucc (exampleID + 10) newCache `shouldBe` Just anotherID -- queries that require a (pseudo)modular structure nid . cacheGetNodeStateUnvalidated <$> cacheLookupPred (exampleID - 2) newCache `shouldBe` Just anotherID nid . cacheGetNodeStateUnvalidated <$> cacheLookupSucc (anotherID + 2) newCache `shouldBe` Just exampleID -- now store a node in one of the ProxyEntries 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 let nC = addCacheEntryPure 10 (RemoteCacheEntry maxNode 10) newCache nc' = deleteCacheEntry maxBound . deleteCacheEntry anotherID $ nC cacheLookup anotherID nc' `shouldBe` Nothing cacheLookup maxBound nc' `shouldBe` Nothing 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 "unjoined nodes should never return themselfs" $ do exampleLocalNodeAsRemote <- toRemoteNodeState <$> exampleLocalNode queryLocalCache <$> exampleLocalNode <*> pure emptyCache <*> pure 3 <*> pure (toNodeID 2^(9::Integer)+5) `shouldReturn` FORWARD Set.empty (FORWARD fwSet) <- queryLocalCache <$> exampleLocalNode <*> pure cacheWith4Entries <*> pure 1 <*> (getNid <$> exampleLocalNode) remoteNode (head $ Set.elems fwSet) `shouldBe` node4 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 describe "successors and predecessors do not disturb the ring characteristics of EpiChord operations (see #48)" $ do let emptyCache = initCache -- implicitly relies on kNeighbours 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 , leaveDoMigration = True } 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)} ] } qLoadReqPayload = LoadRequestPayload { loadLowerBound = fromInteger 12 , loadUpperBound = fromInteger 1025 } qLoadResPayload = LoadResponsePayload { loadSum = 3.141 , loadRemainingTarget = -1.337 } 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 encodeDecodeAndCheck $ requestWith QueryLoad qLoadReqPayload encodeDecodeAndCheck $ responseWith QueryLoad qLoadResPayload 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 describe "join cache lookup" $ it "A bootstrap cache initialised with just one node returns that one." $ do let bootstrapNid = toNodeID 34804191837661041451755206127000721433747285589603756490902196113256157045194 bootstrapNode = setNid bootstrapNid exampleNodeState bootstrapCache = addCacheEntryPure 10 (RemoteCacheEntry bootstrapNode 19) initCache ownId = toNodeID 34804191837661041451755206127000721433707928516052624394829818586723613390165 ownNode <- setNid ownId <$> exampleLocalNode let (FORWARD qResult) = queryLocalCache ownNode bootstrapCache 2 ownId remoteNode (head $ Set.elems qResult) `shouldBe` bootstrapNode -- some example data exampleNodeState :: RemoteNodeState exampleNodeState = RemoteNodeState { nid = toNodeID 12 , domain = exampleNodeDomain , ipAddr = exampleIp , dhtPort = 2342 , servicePort = 513 , vServerID = 0 } exampleLocalNode :: IO (LocalNodeState MockService) exampleLocalNode = do realNode <- newTVarIO $ RealNode { vservers = [] , nodeConfig = exampleFediConf , bootstrapNodes = confBootstrapNodes exampleFediConf , nodeService = MockService } nodeStateInit realNode exampleFediConf :: FediChordConf exampleFediConf = FediChordConf { confDomain = "example.social" , confIP = exampleIp , confDhtPort = 2342 } exampleNodeDomain :: String exampleNodeDomain = "example.social" exampleVs :: (Integral i) => i exampleVs = 4 exampleIp :: HostAddress6 exampleIp = tupleToHostAddress6 (0x2001, 0x16b8, 0x755a, 0xb110, 0x7d6a, 0x12ab, 0xf0c5, 0x386e) data MockService d = MockService instance DHT d => Service MockService d where runService _ _ = pure MockService getListeningPortFromService = const 1337