forked from schmittlauch/Hash2Pub
parent
b41acaf52a
commit
3c981fbf86
|
|
@ -46,7 +46,7 @@ category: Network
|
|||
extra-source-files: CHANGELOG.md
|
||||
|
||||
common deps
|
||||
build-depends: base ^>=4.12.0.0, containers ^>=0.6.0.1, utf8-string ^>=1.0.1.1, network ^>=2.8.0.1, time ^>=1.8.0.2, cmdargs ^>= 0.10, cryptonite ^>= 0.25, memory, binary-strict
|
||||
build-depends: base ^>=4.12.0.0, containers ^>=0.6.0.1, bytestring, utf8-string ^>=1.0.1.1, network ^>=2.8.0.1, time ^>=1.8.0.2, cmdargs ^>= 0.10, cryptonite ^>= 0.25, memory, binary-strict
|
||||
ghc-options: -Wall
|
||||
|
||||
|
||||
|
|
@ -61,7 +61,7 @@ library
|
|||
-- other-modules:
|
||||
|
||||
-- LANGUAGE extensions used by modules in this package.
|
||||
other-extensions: GeneralizedNewtypeDeriving
|
||||
other-extensions: GeneralizedNewtypeDeriving, DataKinds, OverloadedStrings
|
||||
|
||||
-- Directories containing source files.
|
||||
hs-source-dirs: src
|
||||
|
|
@ -108,5 +108,6 @@ test-suite Hash2Pub-test
|
|||
-- The entrypoint to the test suite.
|
||||
main-is: Specs.hs
|
||||
other-modules: FediChordSpec
|
||||
other-extensions: OverloadedStrings
|
||||
build-depends: hspec, Hash2Pub
|
||||
|
||||
|
|
|
|||
|
|
@ -30,7 +30,8 @@ hashNodeIDBS ipaddr@(a, b, _, _) domain vserver =
|
|||
(hashIpaddrUpper, hashIpaddLower) = BS.splitAt 64 $ hashID ipaddrNet
|
||||
|
||||
|
||||
--hashNodeID = byteStringToUInteger hashNodeIDBS
|
||||
hashNodeID :: HostAddress6 -> String -> Word8 -> Integer
|
||||
hashNodeID ip domain vs = byteStringToUInteger $ hashNodeIDBS ip domain vs
|
||||
|
||||
|
||||
-- | parses the bit pattern of a ByteString as an unsigned Integer in Big Endian order
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving, DataKinds #-}
|
||||
{- |
|
||||
Module : FediChord
|
||||
Description : An opinionated implementation of the EpiChord DHT by Leong et al.
|
||||
|
|
@ -12,9 +12,12 @@ Modernised EpiChord + k-choices load balancing
|
|||
module Hash2Pub.FediChord (
|
||||
NodeID -- abstract, but newtype constructors cannot be hidden
|
||||
, getNodeID
|
||||
, mkNodeID
|
||||
, toNodeID
|
||||
, NodeState (..)
|
||||
, CacheEntry
|
||||
, genNodeID
|
||||
, genNodeIDBS
|
||||
, byteStringToUInteger
|
||||
) where
|
||||
|
||||
import qualified Data.Map.Strict as Map
|
||||
|
|
@ -23,6 +26,15 @@ import Network.Socket
|
|||
import Data.Time.Clock.System
|
||||
import Control.Exception
|
||||
|
||||
-- for hashing and ID conversion
|
||||
import Crypto.Hash
|
||||
import Data.Word
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Builder as BB
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import qualified Data.ByteString.UTF8 as BSU
|
||||
import qualified Data.ByteArray as BA
|
||||
|
||||
-- define protocol constants
|
||||
-- | static definition of ID length in bits
|
||||
idBits :: Integer
|
||||
|
|
@ -32,13 +44,13 @@ idBits = 256
|
|||
-- their instance behaviour
|
||||
--
|
||||
-- for being able to check value bounds, the constructor should not be used directly
|
||||
-- and new values are created via @mkNodeID@ (newtype constructors cannot be hidden)
|
||||
-- and new values are created via @toNodeID@ (newtype constructors cannot be hidden)
|
||||
newtype NodeID = NodeID { getNodeID :: Integer } deriving (Eq, Show, Enum)
|
||||
|
||||
-- |smart data constructor for NodeID that throws a runtime exception for out-of-bounds values.
|
||||
-- When needing a runtime-safe constructor with drawbacks, try @fromInteger@
|
||||
mkNodeID :: Integer -> NodeID
|
||||
mkNodeID i = assert (i >= getNodeID minBound && i <= getNodeID maxBound) $ NodeID i
|
||||
toNodeID :: Integer -> NodeID
|
||||
toNodeID i = assert (i >= getNodeID minBound && i <= getNodeID maxBound) $ NodeID i
|
||||
|
||||
-- |NodeIDs are bounded by the value range of an unsigned Integer of length 'idBits'
|
||||
instance Bounded NodeID where
|
||||
|
|
@ -51,7 +63,7 @@ instance Num NodeID where
|
|||
a * b = NodeID $ (getNodeID a * getNodeID b) `mod` (getNodeID maxBound + 1)
|
||||
a - b = NodeID $ (getNodeID a - getNodeID b) `mod` (getNodeID maxBound + 1)
|
||||
-- |safe constructor for NodeID values with the drawback, that out-of-bound values are wrapped around
|
||||
-- with modulo to fit in the allowed value space. For runtime checking, look at @mkNodeID@.
|
||||
-- with modulo to fit in the allowed value space. For runtime checking, look at @toNodeID@.
|
||||
fromInteger i = NodeID $ i `mod` (getNodeID maxBound + 1)
|
||||
signum = NodeID . signum . getNodeID
|
||||
abs = NodeID . abs . getNodeID -- ToDo: make sure that at creation time only IDs within the range are used
|
||||
|
|
@ -105,6 +117,45 @@ type CacheEntry = (
|
|||
, SystemTime
|
||||
) -- ^ ( a node's data, timestamp for cache entry expiration )
|
||||
|
||||
-- | generates a 256 bit long NodeID using SHAKE128, represented as ByteString
|
||||
genNodeIDBS :: HostAddress6 -- ^a node's IPv6 address
|
||||
-> String -- ^a node's 1st and 2nd level domain name
|
||||
-> Word8 -- ^the used vserver ID
|
||||
-> BS.ByteString -- ^the NodeID as a 256bit ByteString big-endian unsigned integer
|
||||
genNodeIDBS ipaddr@(a, b, _, _) domain vserver =
|
||||
hashIpaddrUpper `BS.append` hashID domain' `BS.append` hashIpaddLower
|
||||
where
|
||||
vsBS = BS.pack [vserver] -- attention: only works for vserver IDs up to 255
|
||||
-- TODO: this is inefficient and possibly better done with binary-strict
|
||||
ipaddrNet = (BL.toStrict . BB.toLazyByteString . mconcat $ map BB.word32BE [a, b]) `BS.append` vsBS
|
||||
domain' = BSU.fromString domain `BS.append` vsBS
|
||||
hashID bstr = BS.pack . BA.unpack $ (hash bstr :: Digest (SHAKE128 128))
|
||||
(hashIpaddrUpper, hashIpaddLower) = BS.splitAt 64 $ hashID ipaddrNet
|
||||
|
||||
|
||||
genNodeID :: HostAddress6 -- ^a node's IPv6 address
|
||||
-> String -- ^a node's 1st and 2nd level domain name
|
||||
-> Word8 -- ^the used vserver ID
|
||||
-> NodeID -- ^the generated @NodeID@
|
||||
genNodeID ip domain vs = NodeID . byteStringToUInteger $ genNodeIDBS ip domain vs
|
||||
|
||||
|
||||
-- | parses the bit pattern of a ByteString as an unsigned Integer in Big Endian order
|
||||
-- by iterating it byte-wise from the back and shifting the byte values according to their offset
|
||||
byteStringToUInteger :: BS.ByteString -> Integer
|
||||
byteStringToUInteger bs = sum $ parsedBytes 0 bs
|
||||
where
|
||||
parsedBytes :: Integer -> BS.ByteString -> [ Integer ]
|
||||
parsedBytes offset bs = case BS.unsnoc bs of
|
||||
Nothing -> []
|
||||
Just (bs, w) -> parseWithOffset offset w : parsedBytes (offset+1) bs
|
||||
|
||||
parseWithOffset :: Integer -> Word8 -> Integer
|
||||
parseWithOffset 0 word = toInteger word -- a shift of 0 is always 0
|
||||
parseWithOffset offset word = toInteger word * 2^(8 * offset)
|
||||
|
||||
|
||||
|
||||
-- Todo: DHT backend can learn potential initial bootstrapping points through the instances mentioned in the received AP-relay messages
|
||||
-- needs to know its own domain anyways for ID generation
|
||||
-- persist them on disk so they can be used for all following bootstraps
|
||||
|
|
|
|||
|
|
@ -1,8 +1,11 @@
|
|||
{-# 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 Hash2Pub.FediChord
|
||||
|
||||
|
|
@ -10,26 +13,39 @@ spec :: Spec
|
|||
spec = do
|
||||
describe "NodeID" $ do
|
||||
it "can store a numeral ID" $
|
||||
getNodeID (mkNodeID 2342) `shouldBe` 2342
|
||||
getNodeID (toNodeID 2342) `shouldBe` 2342
|
||||
it "computes ID values within the modular bounds" $ do
|
||||
getNodeID ((maxBound :: NodeID) + mkNodeID 2) < getNodeID (maxBound :: NodeID) `shouldBe` True
|
||||
getNodeID ((maxBound :: NodeID) + toNodeID 2) < getNodeID (maxBound :: NodeID) `shouldBe` True
|
||||
3 * (maxBound :: NodeID) `shouldBe` fromInteger (-3)
|
||||
it "uses comparison in the context of preceding/ succeding nodes on a ring" $ do
|
||||
mkNodeID 12 `compare` mkNodeID 12 `shouldBe` EQ
|
||||
toNodeID 12 `compare` toNodeID 12 `shouldBe` EQ
|
||||
let
|
||||
a = mkNodeID 3
|
||||
b = mkNodeID 3 - mkNodeID 10
|
||||
a = toNodeID 3
|
||||
b = toNodeID 3 - toNodeID 10
|
||||
a > b `shouldBe` True
|
||||
b < a `shouldBe` True
|
||||
-- edge cases
|
||||
(mkNodeID 5001 - mkNodeID 2^255) < 5001 `shouldBe` True
|
||||
(mkNodeID 5001 - mkNodeID 2^255 - 1) < 5001 `shouldBe` False
|
||||
it "throws an exception when @mkNodeID@ on out-of-bound values" $
|
||||
(toNodeID 5001 - toNodeID 2^255) < 5001 `shouldBe` True
|
||||
(toNodeID 5001 - toNodeID 2^255 - 1) < 5001 `shouldBe` False
|
||||
it "throws an exception when @toNodeID@ on out-of-bound values" $
|
||||
pending
|
||||
it "can be generated" $ do
|
||||
let
|
||||
domain = "example.social"
|
||||
vs = 4
|
||||
ip = tupleToHostAddress6 (0x2001, 0x16b8, 0x755a, 0xb110, 0x7d6a, 0x12aab, 0xf0c5, 0x386e)
|
||||
genNodeIDBS ip domain vs `shouldBe` "\ACK\211\183&S\GS\214\247Xn8\216\232\195\247\162\182\253\210\SOHG7I\194\251\196\130\142RSx\219"
|
||||
genNodeID ip domain vs `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-1
|
||||
byteStringToUInteger (BS.pack $ replicate 32 0x00) `shouldBe` 0
|
||||
byteStringToUInteger (BS.pack [0x00, 0x03, 0xf6, 0x78, 0x10, 0x00]) `shouldBe` 17019965440
|
||||
describe "NodeState" $ do
|
||||
it "can be initialised" $ do
|
||||
let ns = NodeState {
|
||||
nid = mkNodeID 12
|
||||
nid = toNodeID 12
|
||||
, domain = "herebedragons.social"
|
||||
, ipAddr = (0x200116b8, 0x755ab1100, 0x7d6a12ab, 0xf0c5386e)
|
||||
, dhtPort = 2342
|
||||
|
|
|
|||
Loading…
Reference in a new issue