{-# LANGUAGE OverloadedStrings #-} module FediChordSpec where import Test.Hspec import Control.Exception import Network.Socket import qualified Data.Map.Strict as Map import qualified Data.ByteString as BS import qualified Data.Set as Set import Hash2Pub.FediChord import Hash2Pub.DHTProtocol 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 nC `shouldBe` Just anotherID nid . cacheGetNodeStateUnvalidated <$> cacheLookup (anotherID+1) nC `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 cacheWithMaxNode <- addCacheEntry maxNode 0 =<< 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 nC <- newCache -- given situation: 0 < nid exampleNodeState < anotherNode < maxBound -- first try non-modular queries between the 2 stored nodes nid. cacheGetNodeStateUnvalidated <$> cacheLookupPred (exampleID + 10) nC `shouldBe` Just exampleID nid. cacheGetNodeStateUnvalidated <$> cacheLookupSucc exampleID nC `shouldBe` Just exampleID nid. cacheGetNodeStateUnvalidated <$> cacheLookupSucc (exampleID + 10) nC `shouldBe` Just anotherID -- queries that require a (pseudo)modular structure nid. cacheGetNodeStateUnvalidated <$> cacheLookupPred (exampleID - 2) nC `shouldBe` Just anotherID nid. cacheGetNodeStateUnvalidated <$> cacheLookupSucc (anotherID + 2) nC `shouldBe` Just exampleID -- now store a node in one of the ProxyEntries cacheWithProxyNodeEntry <- addCacheEntry maxNode 0 =<< 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 nC <- addCacheEntry maxNode 0 =<< newCache let nc' = deleteCacheEntry maxBound . deleteCacheEntry anotherID $ nC cacheLookup anotherID nc' `shouldBe` Nothing cacheLookup maxBound nc' `shouldBe` Nothing describe "NodeCache query lookup" $ do let emptyCache = nodeCache exampleNodeState nid1 = toNodeID 2^(23::Integer)+1 node1 = exampleNodeState { nid = nid1} 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} cacheWith2Entries = addCacheEntry node1 120 =<< addCacheEntry node2 0 emptyCache cacheWith4Entries = addCacheEntry node3 110 =<< addCacheEntry node4 0 =<< cacheWith2Entries it "works on an empty cache" $ do incomingQuery exampleNodeState emptyCache 3 (toNodeID 2^(9::Integer)+5) `shouldBe` FORWARD Set.empty incomingQuery exampleNodeState emptyCache 1 (toNodeID 2342) `shouldBe` FORWARD Set.empty it "works on a cache with less entries than needed" $ do c2 <- cacheWith2Entries let (FORWARD nodeset) = incomingQuery exampleNodeState c2 4 (toNodeID 2^(9::Integer)+5) Set.map (nid . cacheGetNodeStateUnvalidated) nodeset `shouldBe` Set.fromList [ nid1, nid2 ] it "works on a cache with sufficient entries" $ do c4 <- cacheWith4Entries let (FORWARD nodeset1) = incomingQuery exampleNodeState c4 3 (toNodeID 2^(9::Integer)+5) (FORWARD nodeset2) = incomingQuery exampleNodeState c4 1 (toNodeID 2^(9::Integer)+5) Set.map (nid . cacheGetNodeStateUnvalidated) nodeset1 `shouldBe` Set.fromList [nid4, nid2, nid3] Set.map (nid . cacheGetNodeStateUnvalidated) nodeset2 `shouldBe` Set.fromList [nid4] -- some example data exampleNodeState :: NodeState exampleNodeState = NodeState { nid = toNodeID 12 , domain = exampleNodeDomain , ipAddr = exampleIp , dhtPort = 2342 , apPort = Nothing , nodeCache = initCache , successors = [] , predecessors = [] , kNeighbours = 3 , lNumBestNodes = 3 , pNumParallelQueries = 2 , jEntriesPerSlice = 2 } exampleNodeDomain :: String exampleNodeDomain = "example.social" exampleVs :: (Integral i) => i exampleVs = 4 exampleIp :: HostAddress6 exampleIp = tupleToHostAddress6 (0x2001, 0x16b8, 0x755a, 0xb110, 0x7d6a, 0x12ab, 0xf0c5, 0x386e)