Hash2Pub/Hash2Pub/test/FediChordSpec.hs

{-# LANGUAGE OverloadedStrings #-}
module FediChordSpec where

import Test.Hspec
import Control.Exception
import Network.Socket
import Data.Maybe (fromJust)
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.Set as Set
import Data.ASN1.Parse (runParseASN1)
import Data.Time.Clock.POSIX

import Hash2Pub.FediChord
import Hash2Pub.DHTProtocol
import Hash2Pub.ASN1Coding

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<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
        it "can be initialised" $
            print exampleNodeState
        it "can be initialised partly and then modified later" $ do
            let ns = NodeState {
                nid = undefined
              , domain = exampleNodeDomain
              , ipAddr = exampleIp
              , dhtPort = 2342
              , apPort = Nothing
              , vServerID = undefined
              , internals = Nothing
                               }
                nsReady = ns {
                  nid = genNodeID (ipAddr ns) (domain ns) 3
                , 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
            exampleID = nid exampleLocalNode
            anotherID = toNodeID 2^(230::Integer)+1
            anotherNode = exampleNodeState { nid = anotherID}
            maxNode = exampleNodeState { nid = maxBound}
            newCache = addCacheWrapper (remoteEntryFromNow exampleLocalNode) =<< addCacheWrapper (remoteEntryFromNow anotherNode) emptyCache
        it "entries can be added to a node cache and looked up again" $ do
            nC <- newCache
            -- the cache includes 2 additional proxy elements right from the start
            Map.size nC - Map.size emptyCache `shouldBe` 2
            -- normal entry lookup
            nid . cacheGetNodeStateUnvalidated <$> 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 <- addCacheWrapper (remoteEntryFromNow maxNode) =<< 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 exampleLocalNode < 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 <- addCacheWrapper (remoteEntryFromNow maxNode) =<< 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 <- addCacheWrapper (remoteEntryFromNow maxNode) =<< 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 = fromJust $ getNodeCache exampleLocalNode
            nid1 = toNodeID 2^(23::Integer)+1
            node1 = putPredecessors [nid4] $ exampleLocalNode { 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 = addCacheWrapper (remoteEntryFromNow node1) =<< addCacheWrapper (remoteEntryFromNow node2) emptyCache
            cacheWith4Entries = addCacheWrapper (remoteEntryFromNow node3) =<< addCacheWrapper (remoteEntryFromNow node4) =<< cacheWith2Entries
        it "works on an empty cache" $ do
            incomingQuery exampleLocalNode emptyCache 3 (toNodeID 2^(9::Integer)+5) `shouldBe` FORWARD Set.empty
            incomingQuery exampleLocalNode 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 exampleLocalNode c2 4 (toNodeID 2^(9::Integer)+5)
            Set.map (nid . remoteNode_) nodeset `shouldBe` Set.fromList [ nid1, nid2 ]
        it "works on a cache with sufficient entries" $ do
            c4 <- cacheWith4Entries
            let
                (FORWARD nodeset1) = incomingQuery exampleLocalNode c4 3 (toNodeID 2^(9::Integer)+5)
                (FORWARD nodeset2) = incomingQuery exampleLocalNode c4 1 (toNodeID 2^(9::Integer)+5)
            Set.map (nid . remoteNode_) nodeset1 `shouldBe` Set.fromList [nid4, nid2, nid3]
            Set.map (nid . remoteNode_) nodeset2 `shouldBe` Set.fromList [nid4]
        it "recognises the node's own responsibility" $ do
            nC <- cacheWith4Entries
            incomingQuery node1 nC 3 (toNodeID 2^(22::Integer)) `shouldBe` FOUND node1
            incomingQuery node1 nC 3 nid1 `shouldBe` FOUND node1
        it "does not fail on nodes without neighbours (initial state)" $ do
            nC <- cacheWith4Entries
            let (FORWARD nodeset) = incomingQuery exampleLocalNode nC 3 (toNodeID 11)
            Set.map (nid . remoteNode_ ) nodeset `shouldBe` Set.fromList [nid4, nid2, nid3]

    describe "Messages can be encoded to and decoded from ASN.1" $ do
        -- define test messages
        let
            someNodeIDs = map fromInteger [3..12]
            qidReqPayload = QueryIDRequestPayload {
                queryTargetID = nid exampleNodeState
              , queryLBestNodes = 3
                                               }
            jReqPayload = JoinRequestPayload
            lReqPayload = LeaveRequestPayload {
                leaveSuccessors = someNodeIDs
              , leavePredecessors = someNodeIDs
                                              }
            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 = someNodeIDs
              , joinPredecessors = someNodeIDs
              , joinCache = [
                  RemoteCacheEntry exampleNodeState (toEnum 23420001)
                , RemoteCacheEntry (exampleNodeState {nid = fromInteger (-5)}) (toEnum 0)
                            ]
                                              }
            lResPayload = LeaveResponsePayload
            stabResPayload = StabiliseResponsePayload {
                stabiliseSuccessors = someNodeIDs
              , stabilisePredecessors = []
                                                      }
            pingResPayload = PingResponsePayload {
                pingNodeStates = [
                    exampleNodeState
                  , exampleNodeState {nid = fromInteger (-5)}
                                 ]
                                              }
            requestTemplate = Request {
                requestID = 2342
              , sender = exampleNodeState
              , parts = 1
              , part = 1
              , action = undefined
              , payload = undefined
                                      }
            responseTemplate = Response {
                responseTo = 2342
              , senderID = nid exampleNodeState
              , parts = 1
              , part = 1
              , action = undefined
              , payload = undefined
                                      }
            requestWith a pa = requestTemplate {action = a, payload = pa}
            responseWith a pa = responseTemplate {action = a, payload = pa}

            encodeDecodeAndCheck msg = runParseASN1 parseMessage (encodeMessage msg) `shouldBe` pure msg
        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 (head $ 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
            let largeMessage = responseWith Join $ JoinResponsePayload {
                joinSuccessors = fromInteger <$> [-20..150]
              , joinPredecessors = fromInteger <$> [5..11]
              , joinCache = [ RemoteCacheEntry (exampleNodeState {nid = node}) 290001 | node <- [50602,506011..60000]]
                                                                       }
            -- TODO: once splitting works more efficient, test for exact number or payload, see #18
            length (serialiseMessage 600 largeMessage) > 1 `shouldBe` True
            length (serialiseMessage 6000 largeMessage) `shouldBe` 1


-- some example data

exampleNodeState :: NodeState
exampleNodeState = NodeState {
    nid = toNodeID 12
  , domain = exampleNodeDomain
  , ipAddr = exampleIp
  , dhtPort = 2342
  , apPort = Nothing
  , vServerID = 0
  , internals = Nothing
                   }

exampleInternals :: InternalNodeState
exampleInternals = InternalNodeState {
    nodeCache = initCache
  , successors = []
  , predecessors = []
  , kNeighbours = 3
  , lNumBestNodes = 3
  , pNumParallelQueries = 2
  , jEntriesPerSlice = 2
                                     }
exampleLocalNode :: NodeState
exampleLocalNode = exampleNodeState {internals = Just exampleInternals}

exampleNodeDomain :: String
exampleNodeDomain = "example.social"
exampleVs :: (Integral i) => i
exampleVs = 4
exampleIp :: HostAddress6
exampleIp = tupleToHostAddress6 (0x2001, 0x16b8, 0x755a, 0xb110, 0x7d6a, 0x12ab, 0xf0c5, 0x386e)

-- | helper function to create a 'RemoteCacheEntry' with the current time stamp
remoteEntryFromNow :: NodeState -> IO RemoteCacheEntry
remoteEntryFromNow ns = RemoteCacheEntry ns <$> getPOSIXTime

-- | helper function for chaining the IO actions of RemoteCacheEntry creation
-- and adding to cache
addCacheWrapper :: IO RemoteCacheEntry -> NodeCache -> IO NodeCache
addCacheWrapper entryIO nc = do
    entry <- entryIO
    addCacheEntry entry nc