Hécate
41e999ed99
This commit brings in an HLint configuration file and several recommended modifications such as: * End-of-line extra spaces removal; * Import lines ordering; * Redundant $ removal; * Generalisation of ++ and map to <> and fmap; * Preferring `pure` over `return`; * Removing extraenous extensions. And finally, a `stylish-haskell` helper script that detects if code files are dirty. Can be useful for CI, although manually calling it can be nice if you would rather first implement then beautify.
269 lines
15 KiB
Haskell
269 lines
15 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
||
module FediChordSpec where
|
||
|
||
import Control.Exception
|
||
import Data.ASN1.Parse (runParseASN1)
|
||
import qualified Data.ByteString as BS
|
||
import Data.IORef
|
||
import qualified Data.Map.Strict as Map
|
||
import Data.Maybe (fromJust)
|
||
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
|
||
|
||
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
|
||
pure $ 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 = fmap 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)
|