implement NodeID generation + tests

contributes to #1 #2

Hash2Pub/Hash2Pub.cabal

@@ -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
 

Hash2Pub/hashtest.hs

@@ -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

Hash2Pub/src/Hash2Pub/FediChord.hs

@@ -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
+toNodeID :: Integer -> NodeID
-mkNodeID i = assert (i >= getNodeID minBound && i <= getNodeID maxBound) $ NodeID i
+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

Hash2Pub/test/FediChordSpec.hs

@@ -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
+                a = toNodeID 3
-                b = mkNodeID 3 - mkNodeID 10
+                b = toNodeID 3 - toNodeID 10
             a > b `shouldBe` True
             b < a `shouldBe` True
             -- edge cases
-            (mkNodeID 5001 - mkNodeID 2^255) < 5001 `shouldBe` True
+            (toNodeID 5001 - toNodeID 2^255) < 5001 `shouldBe` True
-            (mkNodeID 5001 - mkNodeID 2^255 - 1) < 5001 `shouldBe` False
+            (toNodeID 5001 - toNodeID 2^255 - 1) < 5001 `shouldBe` False
-        it "throws an exception when @mkNodeID@ on out-of-bound values" $
+        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