join request + large FediChord refactoring

- implement sending of initial join request sending, response parsing
  and cache population (untested but compiles)
- refactor basic types and their functions into Hash2Pub.FediChordTypes
  to prevent import loops, leaving Hash2Pub.FediChord to contain the
  high level actions called from Main

Hash2Pub.cabal

@@ -55,7 +55,7 @@ library
   import: deps
 
   -- Modules exported by the library.
-  exposed-modules:     Hash2Pub.FediChord, Hash2Pub.DHTProtocol, Hash2Pub.ASN1Coding, Hash2Pub.ProtocolTypes
+  exposed-modules:     Hash2Pub.FediChord, Hash2Pub.FediChordTypes, Hash2Pub.DHTProtocol, Hash2Pub.ASN1Coding, Hash2Pub.ProtocolTypes
 
   -- Modules included in this library but not exported.
   other-modules: Hash2Pub.Utils

src/Hash2Pub/ASN1Coding.hs

@@ -16,7 +16,7 @@ import qualified Data.Set                 as Set
 import           Data.Time.Clock.POSIX    ()
 import           Safe
 
-import           Hash2Pub.FediChord
+import           Hash2Pub.FediChordTypes
 import           Hash2Pub.ProtocolTypes
 import           Hash2Pub.Utils
 

src/Hash2Pub/DHTProtocol.hs

@@ -14,6 +14,11 @@ module Hash2Pub.DHTProtocol
     , maximumParts
     , sendQueryIdMessage
     , requestQueryID
+    , requestJoin
+    , queryIdLookupLoop
+    , resolve
+    , mkSendSocket
+    , mkServerSocket
     )
         where
 
@@ -24,8 +29,11 @@ import           Control.Concurrent.STM.TQueue
 import           Control.Monad                  (foldM, forM, forM_)
 import qualified Data.ByteString                as BS
 import           Data.Either                    (rights)
-import           Data.Foldable                  (foldl')
+import           Data.Foldable                  (foldl', foldr')
 import           Data.IORef
+import           Data.IP                        (IPv6, fromHostAddress6,
+                                                 toHostAddress6)
+import           Data.List                      (sortBy)
 import qualified Data.Map                       as Map
 import           Data.Maybe                     (fromJust, fromMaybe, mapMaybe,
                                                  maybe)
@@ -39,15 +47,15 @@ import           System.Random
 import           System.Timeout
 
 import           Hash2Pub.ASN1Coding
-import           Hash2Pub.FediChord             (CacheEntry (..),
+import           Hash2Pub.FediChordTypes        (CacheEntry (..),
                                                  LocalNodeState (..), NodeCache,
                                                  NodeID, NodeState (..),
                                                  RemoteNodeState (..),
                                                  cacheGetNodeStateUnvalidated,
                                                  cacheLookup, cacheLookupPred,
                                                  cacheLookupSucc, localCompare,
-                                                 mkSendSocket, mkServerSocket,
+                                                 localCompare, setPredecessors,
-                                                 setPredecessors, setSuccessors)
+                                                 setSuccessors)
 import           Hash2Pub.ProtocolTypes
 
 import           Debug.Trace                    (trace)
@@ -134,25 +142,58 @@ markCacheEntryAsVerified timestamp = Map.adjust adjustFunc
 
 -- ====== message send and receive operations ======
 
-requestQueryID :: LocalNodeState -> NodeID -> IO RemoteNodeState
+-- | send a join request and return the joined 'LocalNodeState' including neighbours
+requestJoin :: NodeState a => a             -- ^ currently responsible node to be contacted
+            -> LocalNodeState               -- ^ joining NodeState
+            -> IO (Maybe LocalNodeState)    -- ^ node after join with all its new information
+requestJoin toJoinOn ownState = do
+    sock <- mkSendSocket (getDomain toJoinOn) (getDhtPort toJoinOn)
+    responses <- sendRequestTo 5000 3 (\rid -> Request rid (toRemoteNodeState ownState) 1 1 Join (Just JoinRequestPayload)) sock
+    joinedStateUnsorted <- foldM
+        (\nsAcc msg -> case payload msg of
+          Nothing -> pure nsAcc
+          Just msgPl -> do
+            -- add transfered cache entries to global NodeCache
+            queueAddEntries (joinCache msgPl) nsAcc
+            -- add received predecessors and successors
+            let
+                addPreds ns' = setPredecessors (foldr' (:) (predecessors ns') (joinPredecessors msgPl)) ns'
+                addSuccs ns' = setSuccessors (foldr' (:) (successors ns') (joinSuccessors msgPl)) ns'
+            pure $ addSuccs . addPreds $ nsAcc
+            )
+        -- reset predecessors and successors
+        (setPredecessors [] . setSuccessors [] $ ownState)
+        responses
+    if responses == Set.empty
+       then pure Nothing
+        -- sort successors and predecessors
+       else pure . Just . setSuccessors (sortBy localCompare $ successors joinedStateUnsorted) . setPredecessors (sortBy localCompare $ predecessors joinedStateUnsorted) $ joinedStateUnsorted
+
+
+-- | Send a 'QueryID' 'Request' for getting the node that handles a certain key ID.
+requestQueryID :: LocalNodeState        -- ^ NodeState of the querying node
+               -> NodeID                -- ^ target key ID to look up
+               -> IO RemoteNodeState    -- ^ the node responsible for handling that key
 -- 1. do a local lookup for the l closest nodes
 -- 2. create l sockets
 -- 3. send a message async concurrently to all l nodes
 -- 4. collect the results, insert them into cache
 -- 5. repeat until FOUND (problem: new entries not necessarily already in cache, explicitly compare with closer results)
+-- TODO: deal with lookup failures
 requestQueryID ns targetID = do
     firstCacheSnapshot <- readIORef . nodeCacheRef $ ns
-    lookupLoop firstCacheSnapshot
+    queryIdLookupLoop firstCacheSnapshot ns targetID
-  where
+
-    lookupLoop :: NodeCache -> IO RemoteNodeState
+-- | like 'requestQueryID, but allows passing of a custom cache, e.g. for joining
-    lookupLoop cacheSnapshot = do
+queryIdLookupLoop :: NodeCache -> LocalNodeState -> NodeID -> IO RemoteNodeState
+queryIdLookupLoop cacheSnapshot ns targetID = do
     let localResult = queryLocalCache ns cacheSnapshot (lNumBestNodes ns) targetID
     -- FOUND can only be returned if targetID is owned by local node
     case localResult of
       FOUND thisNode -> pure thisNode
       FORWARD nodeSet -> do
           -- create connected sockets to all query targets
-              sockets <- mapM (\resultNode -> mkSendSocket (domain resultNode) (dhtPort resultNode)) $ remoteNode <$> Set.toList nodeSet
+          sockets <- mapM (\resultNode -> mkSendSocket (getDomain resultNode) (getDhtPort resultNode)) $ remoteNode <$> Set.toList nodeSet
           -- ToDo: make attempts and timeout configurable
           queryThreads <- mapM (async . sendQueryIdMessage targetID ns) sockets
           -- ToDo: process results immediately instead of waiting for the last one to finish, see https://stackoverflow.com/a/38815224/9198613
@@ -179,7 +220,7 @@ requestQueryID ns targetID = do
                     _                -> Nothing
                                            ) $ responses
           -- if no FOUND, recursively call lookup again
-              maybe (lookupLoop newLCache) pure foundResp
+          maybe (queryIdLookupLoop newLCache ns targetID) pure foundResp
 
 
 sendQueryIdMessage :: NodeID                        -- ^ target key ID to look up
@@ -208,8 +249,7 @@ sendRequestTo timeoutMillis numAttempts msgIncomplete sock = do
     attempts numAttempts . timeout timeoutMillis $ sendAndAck responseQ sock requests
     -- after timeout, check received responses, delete them from unacked message set/ map and rerun senAndAck with that if necessary.
     recvdParts <- atomically $ flushTBQueue responseQ
-    -- PLACEHOLDER
+    pure $ Set.fromList recvdParts
-    pure Set.empty
   where
     -- state reingeben: state = noch nicht geackte messages, result = responses
     sendAndAck :: TBQueue FediChordMessage          -- ^ the queue for putting in the received responses
@@ -242,6 +282,14 @@ sendRequestTo timeoutMillis numAttempts msgIncomplete sock = do
                  else recvLoop responseQueue newRemaining receivedPartNums
 
 
+-- | enqueue a list of RemoteCacheEntries to be added to the global NodeCache
+queueAddEntries :: [RemoteCacheEntry]
+                -> LocalNodeState
+                -> IO ()
+queueAddEntries entries ns = do
+    now <- getPOSIXTime
+    forM_ entries $ \entry -> atomically $ writeTQueue (cacheWriteQueue ns)  $ addCacheEntryPure now entry
+
 -- | retry an IO action at most *i* times until it delivers a result
 attempts :: Int             -- ^ number of retries *i*
          -> IO (Maybe a)    -- ^ action to retry
@@ -252,3 +300,38 @@ attempts i action = do
     case actionResult of
       Nothing  -> attempts (i-1) action
       Just res -> pure $ Just res
+
+-- ====== network socket operations ======
+
+-- | resolve a specified host and return the 'AddrInfo' for it.
+-- If no hostname or IP is specified, the 'AddrInfo' can be used to bind to all
+-- addresses;
+-- if no port is specified an arbitrary free port is selected.
+resolve :: Maybe String         -- ^ hostname or IP address to be resolved
+        -> Maybe PortNumber     -- ^ port number of either local bind or remote
+        -> IO AddrInfo
+resolve host port = let
+    hints = defaultHints { addrFamily = AF_INET6, addrSocketType = Datagram
+                         , addrFlags = [AI_PASSIVE] }
+    in
+    head <$> getAddrInfo (Just hints) host (show <$> port)
+
+-- | create an unconnected UDP Datagram 'Socket' bound to the specified address
+mkServerSocket :: HostAddress6 -> PortNumber -> IO Socket
+mkServerSocket ip port = do
+    sockAddr <- addrAddress <$> resolve (Just $ show . fromHostAddress6 $ ip) (Just port)
+    sock <- socket AF_INET6 Datagram defaultProtocol
+    setSocketOption sock IPv6Only 1
+    bind sock sockAddr
+    pure sock
+
+-- | create a UDP datagram socket, connected to a destination.
+-- The socket gets an arbitrary free local port assigned.
+mkSendSocket :: String  -- ^ destination hostname or IP
+             -> PortNumber  -- ^ destination port
+             -> IO Socket   -- ^ a socket with an arbitrary source port
+mkSendSocket dest destPort = do
+    destAddr <- addrAddress <$> resolve (Just dest) (Just destPort)
+    sendSock <- socket AF_INET6 Datagram defaultProtocol
+    setSocketOption sendSock IPv6Only 1
+    pure sendSock

src/Hash2Pub/FediChord.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE DataKinds          #-}
 {-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE OverloadedStrings  #-}
 {- |
 Module      : FediChord
@@ -46,8 +45,10 @@ module Hash2Pub.FediChord (
                            ) where
 
 import           Control.Exception
+import           Data.Foldable                 (foldr')
 import qualified Data.Map.Strict               as Map
 import           Data.Maybe                    (fromMaybe, isJust, mapMaybe)
+import qualified Data.Set                      as Set
 import           Data.Time.Clock.POSIX
 import           Network.Socket
 
@@ -66,379 +67,12 @@ import           Data.Typeable                 (Typeable (..), typeOf)
 import           Data.Word
 import qualified Network.ByteOrder             as NetworkBytes
 
+import           Hash2Pub.DHTProtocol
+import           Hash2Pub.FediChordTypes
 import           Hash2Pub.Utils
 
 import           Debug.Trace                   (trace)
 
--- define protocol constants
--- | static definition of ID length in bits
-idBits :: Integer
-idBits = 256
-
--- |NodeIDs are Integers wrapped in a newtype, to be able to redefine
--- their instance behaviour
---
--- for being able to check value bounds, the constructor should not be used directly
--- and new values are created via @toNodeID@ (newtype constructors cannot be hidden)
-newtype NodeID = NodeID { getNodeID :: Integer } deriving stock (Show, Eq) deriving newtype 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@
-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
-    minBound = NodeID 0
-    maxBound = NodeID (2^idBits - 1)
-
--- |calculations with NodeIDs are modular arithmetic operations
-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)
-    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 @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
-
--- | use normal strict monotonic ordering of integers, realising the ring structure
--- is done in the @NodeCache@ implementation
-instance Ord NodeID where
-    a `compare` b = getNodeID a `compare` getNodeID b
-
--- | local comparison of 2 node IDs, only relevant for determining a successor or predecessor on caches with just 2 nodes
-localCompare :: NodeID -> NodeID -> Ordering
-a `localCompare` b
-  | getNodeID a == getNodeID b = EQ
-  | wayForwards > wayBackwards = GT
-  | otherwise = LT
-  where
-    wayForwards = getNodeID (b - a)
-    wayBackwards = getNodeID (a - b)
-
-
--- | represents a node and all its important state
-data RemoteNodeState = RemoteNodeState
-    { nid         :: NodeID
-    , domain      :: String
-    -- ^ full public domain name the node is reachable under
-    , ipAddr      :: HostAddress6
-    -- the node's public IPv6 address
-    , dhtPort     :: PortNumber
-    -- ^ port of the DHT itself
-    , servicePort :: PortNumber
-    -- ^ port of the service provided on top of the DHT
-    , vServerID   :: Integer
-    -- ^ ID of this vserver
-    }
-    deriving (Show, Eq)
-
--- | represents a node and encapsulates all data and parameters that are not present for remote nodes
-data LocalNodeState = LocalNodeState
-    { nodeState           :: RemoteNodeState
-    -- ^ represents common data present both in remote and local node representations
-    , nodeCacheRef        :: IORef NodeCache
-    -- ^ EpiChord node cache with expiry times for nodes
-    , cacheWriteQueue     :: TQueue (NodeCache -> NodeCache)
-    -- ^ cache updates are not written directly to the  'nodeCache' but queued and
-    , successors          :: [NodeID] -- could be a set instead as these are ordered as well
-    -- ^ successor nodes in ascending order by distance
-    , predecessors        :: [NodeID]
-    -- ^ predecessor nodes in ascending order by distance
-    , kNeighbours         :: Int
-    -- ^ desired length of predecessor and successor list
-    , lNumBestNodes       :: Int
-    -- ^ number of best next hops to provide
-    , pNumParallelQueries :: Int
-    -- ^ number of parallel sent queries
-    , jEntriesPerSlice    :: Int
-    -- ^ number of desired entries per cache slice
-    }
-    deriving (Show, Eq)
-
--- | class for various NodeState representations, providing
--- getters and setters for common values
-class NodeState a where
-    -- getters for common properties
-    getNid :: a -> NodeID
-    getDomain :: a -> String
-    getIpAddr :: a -> HostAddress6
-    getDhtPort :: a -> PortNumber
-    getServicePort :: a -> PortNumber
-    getVServerID :: a -> Integer
-    -- setters for common properties
-    setNid :: NodeID -> a -> a
-    setDomain :: String -> a -> a
-    setIpAddr :: HostAddress6 -> a -> a
-    setDhtPort :: PortNumber -> a -> a
-    setServicePort :: PortNumber -> a -> a
-    setVServerID :: Integer -> a -> a
-    toRemoteNodeState :: a -> RemoteNodeState
-
-instance NodeState RemoteNodeState where
-    getNid = nid
-    getDomain = domain
-    getIpAddr = ipAddr
-    getDhtPort = dhtPort
-    getServicePort = servicePort
-    getVServerID = vServerID
-    setNid nid' ns = ns {nid = nid'}
-    setDomain domain' ns = ns {domain = domain'}
-    setIpAddr ipAddr' ns = ns {ipAddr = ipAddr'}
-    setDhtPort dhtPort' ns = ns {dhtPort = dhtPort'}
-    setServicePort servicePort' ns = ns {servicePort = servicePort'}
-    setVServerID vServerID' ns = ns {vServerID = vServerID'}
-    toRemoteNodeState = id
-
--- | helper function for setting values on the 'RemoteNodeState' contained in the 'LocalNodeState'
-propagateNodeStateSet_ :: (RemoteNodeState -> RemoteNodeState) -> LocalNodeState -> LocalNodeState
-propagateNodeStateSet_ func ns = let
-        newNs = func $ nodeState ns
-    in
-        ns {nodeState = newNs}
-
-
-instance NodeState LocalNodeState where
-    getNid = getNid . nodeState
-    getDomain = getDomain . nodeState
-    getIpAddr = getIpAddr . nodeState
-    getDhtPort = getDhtPort . nodeState
-    getServicePort = getServicePort . nodeState
-    getVServerID = getVServerID . nodeState
-    setNid nid' = propagateNodeStateSet_ $ setNid nid'
-    setDomain domain' = propagateNodeStateSet_ $ setDomain domain'
-    setIpAddr ipAddr' = propagateNodeStateSet_ $ setIpAddr ipAddr'
-    setDhtPort dhtPort' = propagateNodeStateSet_ $ setDhtPort dhtPort'
-    setServicePort servicePort' = propagateNodeStateSet_ $ setServicePort servicePort'
-    setVServerID vServerID' = propagateNodeStateSet_ $ setVServerID vServerID'
-    toRemoteNodeState = nodeState
-
--- | defining Show instances to be able to print NodeState for debug purposes
-instance Typeable a => Show (IORef a) where
-    show x = show (typeOf x)
-
-instance Typeable a => Show (TQueue a) where
-    show x = show (typeOf x)
-
--- | convenience function that updates the successors of a 'LocalNodeState'
-setSuccessors :: [NodeID] -> LocalNodeState -> LocalNodeState
-setSuccessors succ' ns = ns {successors = succ'}
-
--- | convenience function that updates the predecessors of a 'LocalNodeState'
-setPredecessors :: [NodeID] -> LocalNodeState -> LocalNodeState
-setPredecessors pred' ns = ns {predecessors = pred'}
-
-type NodeCache = Map.Map NodeID CacheEntry
-
--- | An entry of the 'nodeCache' can hold 2 different kinds of data.
--- Type variable @a@ should be of type class 'NodeState', but I do not want to use GADTs here.
-data CacheEntry = NodeEntry Bool RemoteNodeState POSIXTime
-    | ProxyEntry (NodeID, ProxyDirection) (Maybe CacheEntry)
-    deriving (Show, Eq)
-
--- | as a compromise, only NodeEntry components are ordered by their NodeID
--- while ProxyEntry components should never be tried to be ordered.
-instance Ord CacheEntry where
-
-    a `compare` b = compare (extractID a) (extractID b)
-        where
-            extractID (NodeEntry _ eState _) = getNid eState
-            extractID (ProxyEntry _ _) = error "proxy entries should never appear outside of the NodeCache"
-
-data ProxyDirection = Backwards
-    | Forwards
-    deriving (Show, Eq)
-
-instance Enum ProxyDirection where
-    toEnum (-1) = Backwards
-    toEnum 1    = Forwards
-    toEnum _    = error "no such ProxyDirection"
-    fromEnum Backwards = - 1
-    fromEnum Forwards  = 1
-
---- useful function for getting entries for a full cache transfer
-cacheEntries :: NodeCache -> [CacheEntry]
-cacheEntries ncache = mapMaybe extractNodeEntries $ Map.elems ncache
-    where
-  extractNodeEntries (ProxyEntry _ possibleEntry) = possibleEntry
-
--- | An empty @NodeCache@ needs to be initialised with 2 proxy entries,
--- linking the modular name space together by connecting @minBound@ and @maxBound@
-initCache :: NodeCache
-initCache = Map.fromList $ proxyEntry <$> [(maxBound, (minBound, Forwards)), (minBound, (maxBound, Backwards))]
-  where
-    proxyEntry (from,to) = (from, ProxyEntry to Nothing)
-
--- | Maybe returns the cache entry stored at given key
-cacheLookup :: NodeID       -- ^lookup key
-            -> NodeCache    -- ^lookup cache
-            -> Maybe CacheEntry
-cacheLookup key cache = case Map.lookup key cache of
-                          Just (ProxyEntry _ result) -> result
-                          res                        -> res
-
--- | a wrapper around lookup functions, making the lookup redirectable by a @ProxyEntry@
--- to simulate a modular ring
-lookupWrapper :: (NodeID -> NodeCache -> Maybe (NodeID, CacheEntry)) -> (NodeID -> NodeCache -> Maybe (NodeID, CacheEntry)) -> ProxyDirection -> NodeID -> NodeCache -> Maybe CacheEntry
-lookupWrapper f fRepeat direction key cache =
-    case f key cache of
-        -- the proxy entry found holds a
-        Just (_, ProxyEntry _ (Just entry@NodeEntry{})) -> Just entry
-        -- proxy entry holds another proxy entry, this should not happen
-        Just (_, ProxyEntry _ (Just (ProxyEntry _ _))) -> Nothing
-        -- proxy entry without own entry is a pointer on where to continue
-        -- if lookup direction is the same as pointer direction: follow pointer
-        Just (foundKey, ProxyEntry (pointerID, pointerDirection) Nothing) ->
-            let newKey = if pointerDirection == direction
-                            then pointerID
-                            else foundKey + (fromInteger . toInteger . fromEnum $ direction)
-            in if cacheNotEmpty cache
-               then lookupWrapper fRepeat fRepeat direction newKey cache
-               else Nothing
-        -- normal entries are returned
-        Just (_, entry@NodeEntry{}) -> Just entry
-        Nothing -> Nothing
-  where
-    cacheNotEmpty :: NodeCache -> Bool
-    cacheNotEmpty cache' = (Map.size cache' > 2)     -- there are more than the 2 ProxyEntries
-                   || isJust ( cacheLookup minBound cache') -- or one of the ProxyEntries holds a node
-                   || isJust (cacheLookup maxBound cache')
-
--- | find the successor node to a given key on a modular EpiChord ring cache.
--- Note: The EpiChord definition of "successor" includes the node at the key itself,
--- if existing.
-cacheLookupSucc :: NodeID           -- ^lookup key
-                -> NodeCache        -- ^ring cache
-                -> Maybe CacheEntry
-cacheLookupSucc = lookupWrapper Map.lookupGE Map.lookupGE Forwards
-
--- | find the predecessor node to a given key on a modular EpiChord ring cache.
-cacheLookupPred :: NodeID           -- ^lookup key
-                -> NodeCache        -- ^ring cache
-                -> Maybe CacheEntry
-cacheLookupPred = lookupWrapper Map.lookupLT Map.lookupLE Backwards
-
--- clean up cache entries: once now - entry > maxAge
--- transfer difference now - entry to other node
-
--- | return the @NodeState@ data from a cache entry without checking its validation status
-cacheGetNodeStateUnvalidated :: CacheEntry -> RemoteNodeState
-cacheGetNodeStateUnvalidated (NodeEntry _ nState _) = nState
-cacheGetNodeStateUnvalidated (ProxyEntry _ (Just entry)) = cacheGetNodeStateUnvalidated entry
-cacheGetNodeStateUnvalidated _ = error "trying to pure empty node state, please report a bug"
-
--- | converts a 'HostAddress6' IP address to a big-endian strict ByteString
-ipAddrAsBS :: HostAddress6 -> BS.ByteString
-ipAddrAsBS (a, b, c, d) = mconcat $ fmap NetworkBytes.bytestring32 [a, b, c, d]
-
--- | converts a ByteString in big endian order to an IPv6 address 'HostAddress6'
-bsAsIpAddr :: BS.ByteString -> HostAddress6
-bsAsIpAddr bytes = (a,b,c,d)
-    where
-        a:b:c:d:_ = fmap NetworkBytes.word32 . chunkBytes 4 $ bytes
-
-
--- | 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 ip nodeDomain vserver =
-    hashIpaddrUpper `BS.append` hashID nodeDomain' `BS.append` hashIpaddLower
-        where
-            vsBS = BS.pack [vserver] -- attention: only works for vserver IDs up to 255
-            ipaddrNet = BS.take 8 (ipAddrAsBS ip) `BS.append` vsBS
-            nodeDomain' = BSU.fromString nodeDomain `BS.append` vsBS
-            hashID bstr = BS.pack . BA.unpack $ (hash bstr :: Digest (SHAKE128 128))
-            (hashIpaddrUpper, hashIpaddLower) = BS.splitAt 64 $ hashID ipaddrNet
-
-
--- | generates a 256 bit long @NodeID@ using SHAKE128
-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 nodeDomain vs = NodeID . byteStringToUInteger $ genNodeIDBS ip nodeDomain vs
-
--- | generates a 256 bit long key identifier, represented as ByteString, for looking up its data on the DHT
-genKeyIDBS :: String            -- ^the key string
-           -> BS.ByteString     -- ^the key ID represented as a @ByteString@
-genKeyIDBS key = BS.pack . BA.unpack $ (hash (BSU.fromString key) :: Digest SHA3_256)
-
--- | generates a 256 bit long key identifier for looking up its data on the DHT
-genKeyID :: String              -- ^the key string
-         -> NodeID              -- ^the key ID
-genKeyID = NodeID . byteStringToUInteger . genKeyIDBS
-
-
--- | 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 uintBs = case BS.unsnoc uintBs 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: complete rewrite
--- |checks wether the cache entries fulfill the logarithmic EpiChord invariant
--- of having j entries per slice, and creates a list of necessary lookup actions.
--- Should be invoked periodically.
---checkCacheSlices :: NodeState -> IO [()]
---checkCacheSlices state = case getNodeCache state of
---    -- don't do anything on nodes without a cache
---    Nothing -> pure [()]
---    Just cache' -> checkSlice jEntries (nid state) startBound lastSucc =<< readIORef cache'
---    -- TODO: do the same for predecessors
---    where
---        jEntries = fromMaybe 0 $ getInternals_ jEntriesPerSlice state
---        lastSucc = last <$> maybeEmpty (fromMaybe [] $ getSuccessors state)
---        startBound = NodeID 2^(255::Integer) + nid state
---        checkSlice :: Int -> NodeID -> NodeID -> Maybe NodeID -> NodeCache -> [IO ()]
---        checkSlice _ _ _ Nothing _ = []
---        checkSlice j ownID upperBound (Just lastSuccNode) cache
---            | upperBound < lastSuccNode = []
---            | otherwise =
---                -- continuously half the DHT namespace, take the upper part as a slice,
---                -- check for existing entries in that slice and create a lookup action
---                -- and recursively do this on the lower half.
---                -- recursion edge case: all successors/ predecessors need to be in the
---                -- first slice.
---                let
---                  diff = getNodeID $ upperBound - ownID
---                  lowerBound = ownID + NodeID (diff `div` 2)
---                in
---                   -- TODO: replace empty IO actions with actual lookups to middle of slice
---                   -- TODO: validate ID before adding to cache
---                   case Map.lookupLT upperBound cache of
---                       Nothing -> pure () : checkSlice j ownID lowerBound (Just lastSuccNode) cache
---                       Just (matchID, _) ->
---                           if
---                               matchID <= lowerBound then pure () : checkSlice j ownID lowerBound (Just lastSuccNode) cache
---                           else
---                               checkSlice j ownID lowerBound (Just lastSuccNode) cache
-
-
--- Todo: DHT backend can learn potential initial bootstrapping points through the instances mentioned in the received AP-relay messages
--- persist them on disk so they can be used for all following bootstraps
-
--- | configuration values used for initialising the FediChord DHT
-data FediChordConf = FediChordConf
-    { confDomain  :: String
-    , confIP      :: HostAddress6
-    , confDhtPort :: Int
-    }
-    deriving (Show, Eq)
-
 -- | initialise data structures, compute own IDs and bind to listening socket
 -- ToDo: load persisted state, thus this function already operates in IO
 fediChordInit :: FediChordConf -> IO (Socket, LocalNodeState)
@@ -475,16 +109,42 @@ nodeStateInit conf = do
                                            }
     pure initialState
 
---fediChordJoin :: LocalNodeState              -- ^ the local 'NodeState'
+fediChordJoin :: LocalNodeState              -- ^ the local 'NodeState'
---              -> (String, PortNumber)   -- ^ domain and port of a bootstrapping node
+              -> (String, PortNumber)   -- ^ domain and port of a bootstrapping node
---              -> Socket                 -- ^ socket used for sending and receiving the join message
+              -> IO (Either String LocalNodeState) -- ^ the joined 'NodeState' after a
---              -> IO Either String NodeState -- ^ the joined 'NodeState' after a successful
+                                            -- successful join, otherwise an error message
---                                         -- join, otherwise an error message
+fediChordJoin ns (joinHost, joinPort) = do
---fediChordJoin ns (joinHost, joinPort) sock = do
+    -- can be invoked multiple times with all known bootstrapping nodes until successfully joined
---    -- 1. get routed to destination until FOUND
+    sock <- mkSendSocket joinHost joinPort
---    -- 2. then send a join to the currently responsible node
+    -- 1. get routed to placement of own ID until FOUND:
---    -- ToDo: implement cache management, as already all received replies should be stored in cache
+    -- Initialise an empty cache only with the responses from a bootstrapping node
---
+    bootstrapResponse <- sendQueryIdMessage (getNid ns) ns sock
+    if bootstrapResponse == Set.empty
+       then pure . Left $ "Bootstrapping node " <> show joinHost <> " gave no response."
+       else do
+           now <- getPOSIXTime
+           -- create new cache with all returned node responses
+           let bootstrapCache =
+                   -- traverse response parts
+                   foldr' (\resp cacheAcc -> case queryResult <$> payload resp of
+                       Nothing -> cacheAcc
+                       Just (FOUND result1) -> addCacheEntryPure now (RemoteCacheEntry result1 now) cacheAcc
+                       Just (FORWARD resultset) -> foldr' (addCacheEntryPure now) cacheAcc resultset
+                          )
+                       initCache bootstrapResponse
+           -- get routed to the currently responsible node, based on the response
+           -- from the bootstrapping node
+           currentlyResponsible <- queryIdLookupLoop bootstrapCache ns $ getNid ns
+           -- do actual join
+           joinResult <- requestJoin currentlyResponsible ns
+           case joinResult of
+             Nothing -> pure . Left $ "Error joining on " <> show currentlyResponsible
+             Just joinedNS -> pure . Right $ joinedNS
+
+
+    -- 2. then send a join to the currently responsible node
+    -- after successful join, finally add own node to the cache
+
 
 -- | cache updater thread that waits for incoming NodeCache update instructions on
 -- the node's cacheWriteQueue and then modifies the NodeCache as the single writer.
@@ -497,38 +157,3 @@ cacheWriter ns = do
           refModifier :: NodeCache -> (NodeCache, ())
           refModifier nc = (f nc, ())
       atomicModifyIORef' (nodeCacheRef ns) refModifier
-
--- ====== network socket operations ======
-
--- | resolve a specified host and return the 'AddrInfo' for it.
--- If no hostname or IP is specified, the 'AddrInfo' can be used to bind to all
--- addresses;
--- if no port is specified an arbitrary free port is selected.
-resolve :: Maybe String         -- ^ hostname or IP address to be resolved
-        -> Maybe PortNumber     -- ^ port number of either local bind or remote
-        -> IO AddrInfo
-resolve host port = let
-    hints = defaultHints { addrFamily = AF_INET6, addrSocketType = Datagram
-                         , addrFlags = [AI_PASSIVE] }
-    in
-    head <$> getAddrInfo (Just hints) host (show <$> port)
-
--- | create an unconnected UDP Datagram 'Socket' bound to the specified address
-mkServerSocket :: HostAddress6 -> PortNumber -> IO Socket
-mkServerSocket ip port = do
-    sockAddr <- addrAddress <$> resolve (Just $ show . fromHostAddress6 $ ip) (Just port)
-    sock <- socket AF_INET6 Datagram defaultProtocol
-    setSocketOption sock IPv6Only 1
-    bind sock sockAddr
-    pure sock
-
--- | create a UDP datagram socket, connected to a destination.
--- The socket gets an arbitrary free local port assigned.
-mkSendSocket :: String  -- ^ destination hostname or IP
-             -> PortNumber  -- ^ destination port
-             -> IO Socket   -- ^ a socket with an arbitrary source port
-mkSendSocket dest destPort = do
-    destAddr <- addrAddress <$> resolve (Just dest) (Just destPort)
-    sendSock <- socket AF_INET6 Datagram defaultProtocol
-    setSocketOption sendSock IPv6Only 1
-    pure sendSock

src/Hash2Pub/FediChordTypes.hs

@@ -0,0 +1,428 @@
+{-# LANGUAGE DataKinds                  #-}
+{-# LANGUAGE DerivingStrategies         #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings          #-}
+
+module Hash2Pub.FediChordTypes (
+    NodeID -- abstract, but newtype constructors cannot be hidden
+  , getNodeID
+  , toNodeID
+  , NodeState (..)
+  , LocalNodeState (..)
+  , RemoteNodeState (..)
+  , setSuccessors
+  , setPredecessors
+  , NodeCache
+  , CacheEntry(..)
+  , cacheGetNodeStateUnvalidated
+  , initCache
+  , cacheLookup
+  , cacheLookupSucc
+  , cacheLookupPred
+  , localCompare
+  , genNodeID
+  , genNodeIDBS
+  , genKeyID
+  , genKeyIDBS
+  , byteStringToUInteger
+  , ipAddrAsBS
+  , bsAsIpAddr
+  , FediChordConf(..)
+                           ) where
+
+import           Control.Exception
+import qualified Data.Map.Strict               as Map
+import           Data.Maybe                    (fromMaybe, isJust, mapMaybe)
+import qualified Data.Set                      as Set
+import           Data.Time.Clock.POSIX
+import           Network.Socket
+
+-- for hashing and ID conversion
+import           Control.Concurrent.STM
+import           Control.Concurrent.STM.TQueue
+import           Control.Monad                 (forever)
+import           Crypto.Hash
+import qualified Data.ByteArray                as BA
+import qualified Data.ByteString               as BS
+import qualified Data.ByteString.UTF8          as BSU
+import           Data.IORef
+import           Data.IP                       (IPv6, fromHostAddress6,
+                                                toHostAddress6)
+import           Data.Typeable                 (Typeable (..), typeOf)
+import           Data.Word
+import qualified Network.ByteOrder             as NetworkBytes
+
+import           Hash2Pub.Utils
+
+
+
+-- define protocol constants
+-- | static definition of ID length in bits
+idBits :: Integer
+idBits = 256
+
+-- |NodeIDs are Integers wrapped in a newtype, to be able to redefine
+-- their instance behaviour
+--
+-- for being able to check value bounds, the constructor should not be used directly
+-- and new values are created via @toNodeID@ (newtype constructors cannot be hidden)
+newtype NodeID = NodeID { getNodeID :: Integer } deriving stock (Show, Eq) deriving newtype 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@
+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
+    minBound = NodeID 0
+    maxBound = NodeID (2^idBits - 1)
+
+-- |calculations with NodeIDs are modular arithmetic operations
+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)
+    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 @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
+
+-- | use normal strict monotonic ordering of integers, realising the ring structure
+-- is done in the @NodeCache@ implementation
+instance Ord NodeID where
+    a `compare` b = getNodeID a `compare` getNodeID b
+
+-- | local comparison of 2 node IDs, only relevant for determining a successor or predecessor on caches with just 2 nodes
+localCompare :: NodeID -> NodeID -> Ordering
+a `localCompare` b
+  | getNodeID a == getNodeID b = EQ
+  | wayForwards > wayBackwards = GT
+  | otherwise = LT
+  where
+    wayForwards = getNodeID (b - a)
+    wayBackwards = getNodeID (a - b)
+
+
+-- | represents a node and all its important state
+data RemoteNodeState = RemoteNodeState
+    { nid         :: NodeID
+    , domain      :: String
+    -- ^ full public domain name the node is reachable under
+    , ipAddr      :: HostAddress6
+    -- the node's public IPv6 address
+    , dhtPort     :: PortNumber
+    -- ^ port of the DHT itself
+    , servicePort :: PortNumber
+    -- ^ port of the service provided on top of the DHT
+    , vServerID   :: Integer
+    -- ^ ID of this vserver
+    }
+    deriving (Show, Eq)
+
+-- | represents a node and encapsulates all data and parameters that are not present for remote nodes
+data LocalNodeState = LocalNodeState
+    { nodeState           :: RemoteNodeState
+    -- ^ represents common data present both in remote and local node representations
+    , nodeCacheRef        :: IORef NodeCache
+    -- ^ EpiChord node cache with expiry times for nodes
+    , cacheWriteQueue     :: TQueue (NodeCache -> NodeCache)
+    -- ^ cache updates are not written directly to the  'nodeCache' but queued and
+    , successors          :: [NodeID] -- could be a set instead as these are ordered as well
+    -- ^ successor nodes in ascending order by distance
+    , predecessors        :: [NodeID]
+    -- ^ predecessor nodes in ascending order by distance
+    , kNeighbours         :: Int
+    -- ^ desired length of predecessor and successor list
+    , lNumBestNodes       :: Int
+    -- ^ number of best next hops to provide
+    , pNumParallelQueries :: Int
+    -- ^ number of parallel sent queries
+    , jEntriesPerSlice    :: Int
+    -- ^ number of desired entries per cache slice
+    }
+    deriving (Show, Eq)
+
+-- | class for various NodeState representations, providing
+-- getters and setters for common values
+class NodeState a where
+    -- getters for common properties
+    getNid :: a -> NodeID
+    getDomain :: a -> String
+    getIpAddr :: a -> HostAddress6
+    getDhtPort :: a -> PortNumber
+    getServicePort :: a -> PortNumber
+    getVServerID :: a -> Integer
+    -- setters for common properties
+    setNid :: NodeID -> a -> a
+    setDomain :: String -> a -> a
+    setIpAddr :: HostAddress6 -> a -> a
+    setDhtPort :: PortNumber -> a -> a
+    setServicePort :: PortNumber -> a -> a
+    setVServerID :: Integer -> a -> a
+    toRemoteNodeState :: a -> RemoteNodeState
+
+instance NodeState RemoteNodeState where
+    getNid = nid
+    getDomain = domain
+    getIpAddr = ipAddr
+    getDhtPort = dhtPort
+    getServicePort = servicePort
+    getVServerID = vServerID
+    setNid nid' ns = ns {nid = nid'}
+    setDomain domain' ns = ns {domain = domain'}
+    setIpAddr ipAddr' ns = ns {ipAddr = ipAddr'}
+    setDhtPort dhtPort' ns = ns {dhtPort = dhtPort'}
+    setServicePort servicePort' ns = ns {servicePort = servicePort'}
+    setVServerID vServerID' ns = ns {vServerID = vServerID'}
+    toRemoteNodeState = id
+
+-- | helper function for setting values on the 'RemoteNodeState' contained in the 'LocalNodeState'
+propagateNodeStateSet_ :: (RemoteNodeState -> RemoteNodeState) -> LocalNodeState -> LocalNodeState
+propagateNodeStateSet_ func ns = let
+        newNs = func $ nodeState ns
+    in
+        ns {nodeState = newNs}
+
+
+instance NodeState LocalNodeState where
+    getNid = getNid . nodeState
+    getDomain = getDomain . nodeState
+    getIpAddr = getIpAddr . nodeState
+    getDhtPort = getDhtPort . nodeState
+    getServicePort = getServicePort . nodeState
+    getVServerID = getVServerID . nodeState
+    setNid nid' = propagateNodeStateSet_ $ setNid nid'
+    setDomain domain' = propagateNodeStateSet_ $ setDomain domain'
+    setIpAddr ipAddr' = propagateNodeStateSet_ $ setIpAddr ipAddr'
+    setDhtPort dhtPort' = propagateNodeStateSet_ $ setDhtPort dhtPort'
+    setServicePort servicePort' = propagateNodeStateSet_ $ setServicePort servicePort'
+    setVServerID vServerID' = propagateNodeStateSet_ $ setVServerID vServerID'
+    toRemoteNodeState = nodeState
+
+-- | defining Show instances to be able to print NodeState for debug purposes
+instance Typeable a => Show (IORef a) where
+    show x = show (typeOf x)
+
+instance Typeable a => Show (TQueue a) where
+    show x = show (typeOf x)
+
+-- | convenience function that updates the successors of a 'LocalNodeState'
+setSuccessors :: [NodeID] -> LocalNodeState -> LocalNodeState
+setSuccessors succ' ns = ns {successors = succ'}
+
+-- | convenience function that updates the predecessors of a 'LocalNodeState'
+setPredecessors :: [NodeID] -> LocalNodeState -> LocalNodeState
+setPredecessors pred' ns = ns {predecessors = pred'}
+
+type NodeCache = Map.Map NodeID CacheEntry
+
+-- | An entry of the 'nodeCache' can hold 2 different kinds of data.
+-- Type variable @a@ should be of type class 'NodeState', but I do not want to use GADTs here.
+data CacheEntry = NodeEntry Bool RemoteNodeState POSIXTime
+    | ProxyEntry (NodeID, ProxyDirection) (Maybe CacheEntry)
+    deriving (Show, Eq)
+
+-- | as a compromise, only NodeEntry components are ordered by their NodeID
+-- while ProxyEntry components should never be tried to be ordered.
+instance Ord CacheEntry where
+
+    a `compare` b = compare (extractID a) (extractID b)
+        where
+            extractID (NodeEntry _ eState _) = getNid eState
+            extractID (ProxyEntry _ _) = error "proxy entries should never appear outside of the NodeCache"
+
+data ProxyDirection = Backwards
+    | Forwards
+    deriving (Show, Eq)
+
+instance Enum ProxyDirection where
+    toEnum (-1) = Backwards
+    toEnum 1    = Forwards
+    toEnum _    = error "no such ProxyDirection"
+    fromEnum Backwards = - 1
+    fromEnum Forwards  = 1
+
+--- useful function for getting entries for a full cache transfer
+cacheEntries :: NodeCache -> [CacheEntry]
+cacheEntries ncache = mapMaybe extractNodeEntries $ Map.elems ncache
+    where
+  extractNodeEntries (ProxyEntry _ possibleEntry) = possibleEntry
+
+-- | An empty @NodeCache@ needs to be initialised with 2 proxy entries,
+-- linking the modular name space together by connecting @minBound@ and @maxBound@
+initCache :: NodeCache
+initCache = Map.fromList $ proxyEntry <$> [(maxBound, (minBound, Forwards)), (minBound, (maxBound, Backwards))]
+  where
+    proxyEntry (from,to) = (from, ProxyEntry to Nothing)
+
+-- | Maybe returns the cache entry stored at given key
+cacheLookup :: NodeID       -- ^lookup key
+            -> NodeCache    -- ^lookup cache
+            -> Maybe CacheEntry
+cacheLookup key cache = case Map.lookup key cache of
+                          Just (ProxyEntry _ result) -> result
+                          res                        -> res
+
+-- | a wrapper around lookup functions, making the lookup redirectable by a @ProxyEntry@
+-- to simulate a modular ring
+lookupWrapper :: (NodeID -> NodeCache -> Maybe (NodeID, CacheEntry)) -> (NodeID -> NodeCache -> Maybe (NodeID, CacheEntry)) -> ProxyDirection -> NodeID -> NodeCache -> Maybe CacheEntry
+lookupWrapper f fRepeat direction key cache =
+    case f key cache of
+        -- the proxy entry found holds a
+        Just (_, ProxyEntry _ (Just entry@NodeEntry{})) -> Just entry
+        -- proxy entry holds another proxy entry, this should not happen
+        Just (_, ProxyEntry _ (Just (ProxyEntry _ _))) -> Nothing
+        -- proxy entry without own entry is a pointer on where to continue
+        -- if lookup direction is the same as pointer direction: follow pointer
+        Just (foundKey, ProxyEntry (pointerID, pointerDirection) Nothing) ->
+            let newKey = if pointerDirection == direction
+                            then pointerID
+                            else foundKey + (fromInteger . toInteger . fromEnum $ direction)
+            in if cacheNotEmpty cache
+               then lookupWrapper fRepeat fRepeat direction newKey cache
+               else Nothing
+        -- normal entries are returned
+        Just (_, entry@NodeEntry{}) -> Just entry
+        Nothing -> Nothing
+  where
+    cacheNotEmpty :: NodeCache -> Bool
+    cacheNotEmpty cache' = (Map.size cache' > 2)     -- there are more than the 2 ProxyEntries
+                   || isJust ( cacheLookup minBound cache') -- or one of the ProxyEntries holds a node
+                   || isJust (cacheLookup maxBound cache')
+
+-- | find the successor node to a given key on a modular EpiChord ring cache.
+-- Note: The EpiChord definition of "successor" includes the node at the key itself,
+-- if existing.
+cacheLookupSucc :: NodeID           -- ^lookup key
+                -> NodeCache        -- ^ring cache
+                -> Maybe CacheEntry
+cacheLookupSucc = lookupWrapper Map.lookupGE Map.lookupGE Forwards
+
+-- | find the predecessor node to a given key on a modular EpiChord ring cache.
+cacheLookupPred :: NodeID           -- ^lookup key
+                -> NodeCache        -- ^ring cache
+                -> Maybe CacheEntry
+cacheLookupPred = lookupWrapper Map.lookupLT Map.lookupLE Backwards
+
+-- clean up cache entries: once now - entry > maxAge
+-- transfer difference now - entry to other node
+
+-- | return the @NodeState@ data from a cache entry without checking its validation status
+cacheGetNodeStateUnvalidated :: CacheEntry -> RemoteNodeState
+cacheGetNodeStateUnvalidated (NodeEntry _ nState _) = nState
+cacheGetNodeStateUnvalidated (ProxyEntry _ (Just entry)) = cacheGetNodeStateUnvalidated entry
+cacheGetNodeStateUnvalidated _ = error "trying to pure empty node state, please report a bug"
+
+-- | converts a 'HostAddress6' IP address to a big-endian strict ByteString
+ipAddrAsBS :: HostAddress6 -> BS.ByteString
+ipAddrAsBS (a, b, c, d) = mconcat $ fmap NetworkBytes.bytestring32 [a, b, c, d]
+
+-- | converts a ByteString in big endian order to an IPv6 address 'HostAddress6'
+bsAsIpAddr :: BS.ByteString -> HostAddress6
+bsAsIpAddr bytes = (a,b,c,d)
+    where
+        a:b:c:d:_ = fmap NetworkBytes.word32 . chunkBytes 4 $ bytes
+
+
+-- | 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 ip nodeDomain vserver =
+    hashIpaddrUpper `BS.append` hashID nodeDomain' `BS.append` hashIpaddLower
+        where
+            vsBS = BS.pack [vserver] -- attention: only works for vserver IDs up to 255
+            ipaddrNet = BS.take 8 (ipAddrAsBS ip) `BS.append` vsBS
+            nodeDomain' = BSU.fromString nodeDomain `BS.append` vsBS
+            hashID bstr = BS.pack . BA.unpack $ (hash bstr :: Digest (SHAKE128 128))
+            (hashIpaddrUpper, hashIpaddLower) = BS.splitAt 64 $ hashID ipaddrNet
+
+
+-- | generates a 256 bit long @NodeID@ using SHAKE128
+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 nodeDomain vs = NodeID . byteStringToUInteger $ genNodeIDBS ip nodeDomain vs
+
+-- | generates a 256 bit long key identifier, represented as ByteString, for looking up its data on the DHT
+genKeyIDBS :: String            -- ^the key string
+           -> BS.ByteString     -- ^the key ID represented as a @ByteString@
+genKeyIDBS key = BS.pack . BA.unpack $ (hash (BSU.fromString key) :: Digest SHA3_256)
+
+-- | generates a 256 bit long key identifier for looking up its data on the DHT
+genKeyID :: String              -- ^the key string
+         -> NodeID              -- ^the key ID
+genKeyID = NodeID . byteStringToUInteger . genKeyIDBS
+
+
+-- | 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 uintBs = case BS.unsnoc uintBs 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: complete rewrite
+-- |checks wether the cache entries fulfill the logarithmic EpiChord invariant
+-- of having j entries per slice, and creates a list of necessary lookup actions.
+-- Should be invoked periodically.
+--checkCacheSlices :: NodeState -> IO [()]
+--checkCacheSlices state = case getNodeCache state of
+--    -- don't do anything on nodes without a cache
+--    Nothing -> pure [()]
+--    Just cache' -> checkSlice jEntries (nid state) startBound lastSucc =<< readIORef cache'
+--    -- TODO: do the same for predecessors
+--    where
+--        jEntries = fromMaybe 0 $ getInternals_ jEntriesPerSlice state
+--        lastSucc = last <$> maybeEmpty (fromMaybe [] $ getSuccessors state)
+--        startBound = NodeID 2^(255::Integer) + nid state
+--        checkSlice :: Int -> NodeID -> NodeID -> Maybe NodeID -> NodeCache -> [IO ()]
+--        checkSlice _ _ _ Nothing _ = []
+--        checkSlice j ownID upperBound (Just lastSuccNode) cache
+--            | upperBound < lastSuccNode = []
+--            | otherwise =
+--                -- continuously half the DHT namespace, take the upper part as a slice,
+--                -- check for existing entries in that slice and create a lookup action
+--                -- and recursively do this on the lower half.
+--                -- recursion edge case: all successors/ predecessors need to be in the
+--                -- first slice.
+--                let
+--                  diff = getNodeID $ upperBound - ownID
+--                  lowerBound = ownID + NodeID (diff `div` 2)
+--                in
+--                   -- TODO: replace empty IO actions with actual lookups to middle of slice
+--                   -- TODO: validate ID before adding to cache
+--                   case Map.lookupLT upperBound cache of
+--                       Nothing -> pure () : checkSlice j ownID lowerBound (Just lastSuccNode) cache
+--                       Just (matchID, _) ->
+--                           if
+--                               matchID <= lowerBound then pure () : checkSlice j ownID lowerBound (Just lastSuccNode) cache
+--                           else
+--                               checkSlice j ownID lowerBound (Just lastSuccNode) cache
+
+
+-- Todo: DHT backend can learn potential initial bootstrapping points through the instances mentioned in the received AP-relay messages
+-- persist them on disk so they can be used for all following bootstraps
+
+-- | configuration values used for initialising the FediChord DHT
+data FediChordConf = FediChordConf
+    { confDomain  :: String
+    , confIP      :: HostAddress6
+    , confDhtPort :: Int
+    }
+    deriving (Show, Eq)
+
+

src/Hash2Pub/ProtocolTypes.hs

@@ -3,7 +3,7 @@ module Hash2Pub.ProtocolTypes where
 import qualified Data.Set                as Set
 import           Data.Time.Clock.POSIX   (POSIXTime)
 
-import           Hash2Pub.FediChord
+import           Hash2Pub.FediChordTypes
 
 data QueryResponse = FORWARD (Set.Set RemoteCacheEntry)
     | FOUND RemoteNodeState
@@ -37,6 +37,10 @@ data FediChordMessage = Request
     }
     deriving (Show, Eq)
 
+instance Ord FediChordMessage where
+    compare a b | requestID a == requestID b = part a `compare` part b
+                | otherwise = requestID a `compare` requestID b
+
 data ActionPayload = QueryIDRequestPayload
     { queryTargetID   :: NodeID
     , queryLBestNodes :: Integer