remove unnecessary directory level
This commit is contained in:
parent
fdd4efe269
commit
60c164dbb0
20 changed files with 0 additions and 0 deletions
268
test/FediChordSpec.hs
Normal file
268
test/FediChordSpec.hs
Normal file
|
|
@ -0,0 +1,268 @@
|
|||
{-# 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 Data.IORef
|
||||
|
||||
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 = initCache
|
||||
anotherID = toNodeID 2^(230::Integer)+1
|
||||
anotherNode = exampleNodeState { nid = anotherID}
|
||||
maxNode = exampleNodeState { nid = maxBound}
|
||||
newCache = addCacheEntryPure 10 (RemoteCacheEntry exampleNodeState 10) (addCacheEntryPure 10 (RemoteCacheEntry anotherNode 10) emptyCache)
|
||||
exampleID = nid exampleNodeState
|
||||
it "entries can be added to a node cache and looked up again" $ do
|
||||
-- the cache includes 2 additional proxy elements right from the start
|
||||
Map.size newCache - Map.size emptyCache `shouldBe` 2
|
||||
-- normal entry lookup
|
||||
nid . cacheGetNodeStateUnvalidated <$> 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 = do
|
||||
eln <- exampleLocalNode -- is at 2^23.00000017198264 = 8388609
|
||||
return $ putPredecessors [nid4] $ eln {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 :: IO NodeCache
|
||||
cacheWith2Entries = addCacheEntryPure 10 <$> (RemoteCacheEntry <$> node1 <*> pure 10) <*> pure (addCacheEntryPure 10 (RemoteCacheEntry node2 10) emptyCache)
|
||||
cacheWith4Entries = addCacheEntryPure 10 (RemoteCacheEntry node3 10) <$> (addCacheEntryPure 10 (RemoteCacheEntry node4 10) <$> cacheWith2Entries)
|
||||
it "works on an empty cache" $ do
|
||||
queryLocalCache <$> exampleLocalNode <*> pure emptyCache <*> pure 3 <*> pure (toNodeID 2^(9::Integer)+5) `shouldReturn` FORWARD Set.empty
|
||||
queryLocalCache <$> exampleLocalNode <*> pure emptyCache <*> pure 1 <*> pure (toNodeID 2342) `shouldReturn` FORWARD Set.empty
|
||||
it "works on a cache with less entries than needed" $ do
|
||||
(FORWARD nodeset) <- queryLocalCache <$> exampleLocalNode <*> cacheWith2Entries <*> pure 4 <*> pure (toNodeID 2^(9::Integer)+5)
|
||||
Set.map (nid . remoteNode_) nodeset `shouldBe` Set.fromList [ nid1, nid2 ]
|
||||
it "works on a cache with sufficient entries" $ do
|
||||
(FORWARD nodeset1) <- queryLocalCache <$> exampleLocalNode <*> cacheWith4Entries <*> pure 3 <*> pure (toNodeID 2^(9::Integer)+5)
|
||||
(FORWARD nodeset2) <- queryLocalCache <$> exampleLocalNode <*> cacheWith4Entries <*> pure 1 <*> pure (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
|
||||
FOUND selfQueryRes <- queryLocalCache <$> node1 <*> cacheWith4Entries <*> pure 3 <*> pure nid1
|
||||
nid <$> node1 `shouldReturn` nid selfQueryRes
|
||||
FOUND responsibilityResult <- queryLocalCache <$> node1 <*> cacheWith4Entries <*> pure 3 <*> pure (toNodeID 2^(22::Integer))
|
||||
nid <$> node1 `shouldReturn` nid responsibilityResult
|
||||
it "does not fail on nodes without neighbours (initial state)" $ do
|
||||
(FORWARD nodeset) <- queryLocalCache <$> exampleLocalNode <*> cacheWith4Entries <*> pure 3 <*> pure (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 = Just pa}
|
||||
responseWith a pa = responseTemplate {action = a, payload = Just 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 (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
|
||||
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
|
||||
}
|
||||
|
||||
exampleLocalNode :: IO NodeState
|
||||
exampleLocalNode = nodeStateInit $ 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)
|
||||
8
test/Specs.hs
Normal file
8
test/Specs.hs
Normal file
|
|
@ -0,0 +1,8 @@
|
|||
module Main (main) where
|
||||
|
||||
import Test.Hspec
|
||||
import qualified FediChordSpec
|
||||
|
||||
main :: IO ()
|
||||
main = hspec $ do
|
||||
describe "FediChord tests" FediChordSpec.spec
|
||||
Loading…
Add table
Add a link
Reference in a new issue