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, bytestring, utf8-string ^>=1.0.1.1, network ^>=2.8.0.1, time ^>=1.8.0.2, cmdargs ^>= 0.10, cryptonite ^>= 0.25, memory, async, stm, asn1-encoding, asn1-types, asn1-parse, publicsuffix, network-byte-order, safe, iproute, mtl, random, servant, servant-server, servant-client, warp, text, http-api-data
+  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, async, stm, asn1-encoding, asn1-types, asn1-parse, publicsuffix, network-byte-order, safe, iproute, mtl, random, servant, servant-server, servant-client, warp, text, unordered-containers
   ghc-options:         -Wall
 
 
@@ -55,7 +55,7 @@ library
   import: deps
 
   -- Modules exported by the library.
-  exposed-modules:     Hash2Pub.FediChord, Hash2Pub.FediChordTypes, Hash2Pub.DHTProtocol, Hash2Pub.ASN1Coding, Hash2Pub.ProtocolTypes, Hash2Pub.PostService, Hash2Pub.ServiceTypes
+  exposed-modules:     Hash2Pub.FediChord, Hash2Pub.FediChordTypes, Hash2Pub.DHTProtocol, Hash2Pub.ASN1Coding, Hash2Pub.ProtocolTypes, Hash2Pub.PostService, Hash2Pub.ServiceTypes, Hash2Pub.RingMap
 
   -- Modules included in this library but not exported.
   other-modules: Hash2Pub.Utils

src/Hash2Pub/FediChordTypes.hs

@@ -84,6 +84,7 @@ import           Data.Typeable                 (Typeable (..), typeOf)
 import           Data.Word
 import qualified Network.ByteOrder             as NetworkBytes
 
+import           Hash2Pub.RingMap
 import           Hash2Pub.Utils
 
 import           Debug.Trace                   (trace)
@@ -282,11 +283,6 @@ addPredecessors preds ns = ns {predecessors = takeRMapPredecessors (getNid ns) (
 addSuccessors :: [RemoteNodeState] -> LocalNodeState -> LocalNodeState
 addSuccessors succs ns = ns {successors = takeRMapSuccessors (getNid ns) (kNeighbours ns) . addRMapEntries (filter ((/=) (getNid ns) . getNid) succs) . rMapFromList  $ successors ns}
 
--- | Class for all types that can be identified via an EpiChord key.
--- Used for restricting the types a 'RingMap' can store
-class (Eq a, Show a) => HasKeyID a where
-    getKeyID :: a -> NodeID
-
 instance HasKeyID RemoteNodeState where
     getKeyID = getNid
 
@@ -302,235 +298,32 @@ type NodeCache = RingMap NodeCacheEntry
 type LookupCacheEntry = CacheEntry (String, PortNumber)
 type LookupCache = Map.Map NodeID LookupCacheEntry
 
--- | generic data structure for holding elements with a key and modular lookup
-newtype RingMap a = RingMap { getRingMap :: HasKeyID a => Map.Map NodeID (RingEntry a) }
-
-instance (HasKeyID a) => Eq (RingMap a) where
-    a == b = getRingMap a == getRingMap b
-
-instance (HasKeyID a) => Show (RingMap a) where
-    show rmap = shows "RingMap " (show $ getRingMap rmap)
-
--- | entry of a 'RingMap' that holds a value and can also
--- wrap around the lookup direction at the edges of the name space.
-data RingEntry a = KeyEntry a
-    | ProxyEntry (NodeID, ProxyDirection) (Maybe (RingEntry a))
-    deriving (Show, Eq)
-
 -- | 'RingEntry' type for usage as a node cache
 data CacheEntry a = CacheEntry Bool a POSIXTime
     deriving (Show, Eq)
 
-
--- | as a compromise, only KeyEntry components are ordered by their NodeID
--- while ProxyEntry components should never be tried to be ordered.
-instance (HasKeyID a, Eq a) => Ord (RingEntry a) where
-    a `compare` b = compare (extractID a) (extractID b)
-        where
-            extractID (KeyEntry e) = getKeyID e
-            extractID ProxyEntry{} = error "proxy entries should never appear outside of the RingMap"
-
-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
-
--- | helper function for getting the a from a RingEntry a
-extractRingEntry :: HasKeyID a => RingEntry a -> Maybe a
-extractRingEntry (KeyEntry entry)                       = Just entry
-extractRingEntry (ProxyEntry _ (Just (KeyEntry entry))) = Just entry
-extractRingEntry _                                      = Nothing
-
 --- useful function for getting entries for a full cache transfer
 nodeCacheEntries :: NodeCache -> [NodeCacheEntry]
 nodeCacheEntries = mapMaybe extractRingEntry . Map.elems . getRingMap
 
--- | An empty 'RingMap' needs to be initialised with 2 proxy entries,
--- linking the modular name space together by connecting @minBound@ and @maxBound@
-emptyRMap :: HasKeyID a => RingMap a
-emptyRMap = RingMap . Map.fromList $ proxyEntry <$> [(maxBound, (minBound, Forwards)), (minBound, (maxBound, Backwards))]
-  where
-    proxyEntry (from,to) = (from, ProxyEntry to Nothing)
-
 initCache :: NodeCache
 initCache = emptyRMap
 
--- | Maybe returns the entry stored at given key
-rMapLookup :: HasKeyID a
-           => NodeID       -- ^lookup key
-           -> RingMap a    -- ^lookup cache
-           -> Maybe a
-rMapLookup key rmap =  extractRingEntry =<< Map.lookup key (getRingMap rmap)
-
 cacheLookup :: NodeID       -- ^lookup key
             -> NodeCache    -- ^lookup cache
             -> Maybe NodeCacheEntry
 cacheLookup = rMapLookup
 
--- | returns number of present 'KeyEntry' in a properly initialised 'RingMap'
-rMapSize :: (HasKeyID a, Integral i)
-         => RingMap a
-         -> i
-rMapSize rmap = fromIntegral $ Map.size innerMap - oneIfEntry minBound - oneIfEntry maxBound
-  where
-    innerMap = getRingMap rmap
-    oneIfEntry :: Integral i => NodeID -> i
-    oneIfEntry nid
-      | isNothing (rMapLookup nid rmap) = 1
-      | otherwise = 0
-
--- | a wrapper around lookup functions, making the lookup redirectable by a @ProxyEntry@
--- to simulate a modular ring
-lookupWrapper :: HasKeyID a
-              => (NodeID -> Map.Map NodeID (RingEntry a) -> Maybe (NodeID, RingEntry a))
-              -> (NodeID -> Map.Map NodeID (RingEntry a) -> Maybe (NodeID, RingEntry a))
-              -> ProxyDirection
-              -> NodeID
-              -> RingMap a
-              -> Maybe a
-lookupWrapper f fRepeat direction key rmap =
-    case f key $ getRingMap rmap of
-        -- the proxy entry found holds a
-        Just (_, ProxyEntry _ (Just (KeyEntry entry))) -> 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 rMapNotEmpty rmap
-               then lookupWrapper fRepeat fRepeat direction newKey rmap
-               else Nothing
-        -- normal entries are returned
-        Just (_, KeyEntry entry) -> Just entry
-        Nothing -> Nothing
-  where
-    rMapNotEmpty :: (HasKeyID a) => RingMap a -> Bool
-    rMapNotEmpty rmap' = (Map.size (getRingMap rmap') > 2)     -- there are more than the 2 ProxyEntries
-                   || isJust (rMapLookup minBound rmap') -- or one of the ProxyEntries holds a node
-                   || isJust (rMapLookup maxBound rmap')
-
--- | find the successor node to a given key on a modular EpiChord ring.
--- Note: The EpiChord definition of "successor" includes the node at the key itself,
--- if existing.
-rMapLookupSucc :: HasKeyID a
-               => NodeID           -- ^lookup key
-               -> RingMap a        -- ^ring cache
-               -> Maybe a
-rMapLookupSucc = lookupWrapper Map.lookupGE Map.lookupGE Forwards
-
 cacheLookupSucc :: NodeID           -- ^lookup key
                 -> NodeCache        -- ^ring cache
                 -> Maybe NodeCacheEntry
 cacheLookupSucc = rMapLookupSucc
 
--- | find the predecessor node to a given key on a modular EpiChord ring.
-rMapLookupPred :: HasKeyID a
-               => NodeID           -- ^lookup key
-               -> RingMap a        -- ^ring cache
-               -> Maybe a
-rMapLookupPred = lookupWrapper Map.lookupLT Map.lookupLE Backwards
-
 cacheLookupPred :: NodeID           -- ^lookup key
                 -> NodeCache        -- ^ring cache
                 -> Maybe NodeCacheEntry
 cacheLookupPred = rMapLookupPred
 
-addRMapEntryWith :: HasKeyID a
-                 => (RingEntry a -> RingEntry a -> RingEntry a)
-                 -> a
-                 -> RingMap a
-                 -> RingMap a
-addRMapEntryWith combineFunc entry = RingMap
-    . Map.insertWith combineFunc (getKeyID entry) (KeyEntry entry)
-    . getRingMap
-
-addRMapEntry :: HasKeyID a
-             => a
-             -> RingMap a
-             -> RingMap a
-addRMapEntry = addRMapEntryWith insertCombineFunction
-  where
-    insertCombineFunction newVal oldVal =
-        case oldVal of
-          ProxyEntry n _ -> ProxyEntry n (Just newVal)
-          KeyEntry _     -> newVal
-
-
-addRMapEntries :: (Foldable t, HasKeyID a)
-               => t a
-               -> RingMap a
-               -> RingMap a
-addRMapEntries entries rmap = foldr' addRMapEntry rmap entries
-
-setRMapEntries :: (Foldable t, HasKeyID a)
-               => t a
-               -> RingMap a
-setRMapEntries entries = addRMapEntries entries emptyRMap
-
-deleteRMapEntry :: (HasKeyID a)
-                => NodeID
-                -> RingMap a
-                -> RingMap a
-deleteRMapEntry nid = RingMap . Map.update modifier nid . getRingMap
-  where
-    modifier (ProxyEntry idPointer _) = Just (ProxyEntry idPointer Nothing)
-    modifier KeyEntry {}              = Nothing
-
-rMapToList :: (HasKeyID a) => RingMap a -> [a]
-rMapToList = mapMaybe extractRingEntry . Map.elems . getRingMap
-
-rMapFromList :: (HasKeyID a) => [a] -> RingMap a
-rMapFromList = setRMapEntries
-
--- | takes up to i entries from a 'RingMap' by calling a getter function on a
--- *startAt* value and after that on the previously returned value.
--- Stops once i entries have been taken or an entry has been encountered twice
--- (meaning the ring has been traversed completely).
--- Forms the basis for 'takeRMapSuccessors' and 'takeRMapPredecessors'.
-takeRMapEntries_ :: (HasKeyID a, Integral i)
-                 => (NodeID -> RingMap a -> Maybe a)
-                 -> NodeID
-                 -> i
-                 -> RingMap a
-                 -> [a]
--- TODO: might be more efficient with dlists
-takeRMapEntries_ getterFunc startAt num rmap = reverse $
-    case getterFunc startAt rmap of
-      Nothing -> []
-      Just anEntry -> takeEntriesUntil (getKeyID anEntry) (getKeyID anEntry) (num-1) [anEntry]
-  where
-    takeEntriesUntil havingReached previousEntry remaining takeAcc
-      | remaining <= 0 = takeAcc
-      | getKeyID (fromJust $ getterFunc previousEntry rmap) == havingReached = takeAcc
-      | otherwise = let (Just gotEntry) = getterFunc previousEntry rmap
-                    in takeEntriesUntil havingReached (getKeyID gotEntry) (remaining-1) (gotEntry:takeAcc)
-
-takeRMapPredecessors :: (HasKeyID a, Integral i)
-                 => NodeID
-                 -> i
-                 -> RingMap a
-                 -> [a]
-takeRMapPredecessors = takeRMapEntries_ rMapLookupPred
-
-takeRMapSuccessors :: (HasKeyID a, Integral i)
-                 => NodeID
-                 -> i
-                 -> RingMap a
-                 -> [a]
-takeRMapSuccessors = takeRMapEntries_ rMapLookupSucc
-
--- 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 -> RemoteNodeState
 cacheGetNodeStateUnvalidated (CacheEntry _ nState _) = nState

src/Hash2Pub/RingMap.hs

@@ -0,0 +1,213 @@
+module Hash2Pub.RingMap where
+
+
+-- | Class for all types that can be identified via an EpiChord key.
+-- Used for restricting the types a 'RingMap' can store
+class (Eq a, Show a) => HasKeyID a where
+    getKeyID :: a -> NodeID
+
+
+-- | generic data structure for holding elements with a key and modular lookup
+newtype RingMap a = RingMap { getRingMap :: HasKeyID a => Map.Map NodeID (RingEntry a) }
+
+instance (HasKeyID a) => Eq (RingMap a) where
+    a == b = getRingMap a == getRingMap b
+
+instance (HasKeyID a) => Show (RingMap a) where
+    show rmap = shows "RingMap " (show $ getRingMap rmap)
+
+-- | entry of a 'RingMap' that holds a value and can also
+-- wrap around the lookup direction at the edges of the name space.
+data RingEntry a = KeyEntry a
+    | ProxyEntry (NodeID, ProxyDirection) (Maybe (RingEntry a))
+    deriving (Show, Eq)
+
+--
+-- | as a compromise, only KeyEntry components are ordered by their NodeID
+-- while ProxyEntry components should never be tried to be ordered.
+instance (HasKeyID a, Eq a) => Ord (RingEntry a) where
+    a `compare` b = compare (extractID a) (extractID b)
+        where
+            extractID (KeyEntry e) = getKeyID e
+            extractID ProxyEntry{} = error "proxy entries should never appear outside of the RingMap"
+
+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
+
+-- | helper function for getting the a from a RingEntry a
+extractRingEntry :: HasKeyID a => RingEntry a -> Maybe a
+extractRingEntry (KeyEntry entry)                       = Just entry
+extractRingEntry (ProxyEntry _ (Just (KeyEntry entry))) = Just entry
+extractRingEntry _                                      = Nothing
+
+-- | An empty 'RingMap' needs to be initialised with 2 proxy entries,
+-- linking the modular name space together by connecting @minBound@ and @maxBound@
+emptyRMap :: HasKeyID a => RingMap a
+emptyRMap = RingMap . Map.fromList $ proxyEntry <$> [(maxBound, (minBound, Forwards)), (minBound, (maxBound, Backwards))]
+  where
+    proxyEntry (from,to) = (from, ProxyEntry to Nothing)
+
+-- | Maybe returns the entry stored at given key
+rMapLookup :: HasKeyID a
+           => NodeID       -- ^lookup key
+           -> RingMap a    -- ^lookup cache
+           -> Maybe a
+rMapLookup key rmap =  extractRingEntry =<< Map.lookup key (getRingMap rmap)
+
+-- | returns number of present 'KeyEntry' in a properly initialised 'RingMap'
+rMapSize :: (HasKeyID a, Integral i)
+         => RingMap a
+         -> i
+rMapSize rmap = fromIntegral $ Map.size innerMap - oneIfEntry minBound - oneIfEntry maxBound
+  where
+    innerMap = getRingMap rmap
+    oneIfEntry :: Integral i => NodeID -> i
+    oneIfEntry nid
+      | isNothing (rMapLookup nid rmap) = 1
+      | otherwise = 0
+
+-- | a wrapper around lookup functions, making the lookup redirectable by a @ProxyEntry@
+-- to simulate a modular ring
+lookupWrapper :: HasKeyID a
+              => (NodeID -> Map.Map NodeID (RingEntry a) -> Maybe (NodeID, RingEntry a))
+              -> (NodeID -> Map.Map NodeID (RingEntry a) -> Maybe (NodeID, RingEntry a))
+              -> ProxyDirection
+              -> NodeID
+              -> RingMap a
+              -> Maybe a
+lookupWrapper f fRepeat direction key rmap =
+    case f key $ getRingMap rmap of
+        -- the proxy entry found holds a
+        Just (_, ProxyEntry _ (Just (KeyEntry entry))) -> 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 rMapNotEmpty rmap
+               then lookupWrapper fRepeat fRepeat direction newKey rmap
+               else Nothing
+        -- normal entries are returned
+        Just (_, KeyEntry entry) -> Just entry
+        Nothing -> Nothing
+  where
+    rMapNotEmpty :: (HasKeyID a) => RingMap a -> Bool
+    rMapNotEmpty rmap' = (Map.size (getRingMap rmap') > 2)     -- there are more than the 2 ProxyEntries
+                   || isJust (rMapLookup minBound rmap') -- or one of the ProxyEntries holds a node
+                   || isJust (rMapLookup maxBound rmap')
+
+-- | find the successor node to a given key on a modular EpiChord ring.
+-- Note: The EpiChord definition of "successor" includes the node at the key itself,
+-- if existing.
+rMapLookupSucc :: HasKeyID a
+               => NodeID           -- ^lookup key
+               -> RingMap a        -- ^ring cache
+               -> Maybe a
+rMapLookupSucc = lookupWrapper Map.lookupGE Map.lookupGE Forwards
+
+-- | find the predecessor node to a given key on a modular EpiChord ring.
+rMapLookupPred :: HasKeyID a
+               => NodeID           -- ^lookup key
+               -> RingMap a        -- ^ring cache
+               -> Maybe a
+rMapLookupPred = lookupWrapper Map.lookupLT Map.lookupLE Backwards
+
+addRMapEntryWith :: HasKeyID a
+                 => (RingEntry a -> RingEntry a -> RingEntry a)
+                 -> a
+                 -> RingMap a
+                 -> RingMap a
+addRMapEntryWith combineFunc entry = RingMap
+    . Map.insertWith combineFunc (getKeyID entry) (KeyEntry entry)
+    . getRingMap
+
+addRMapEntry :: HasKeyID a
+             => a
+             -> RingMap a
+             -> RingMap a
+addRMapEntry = addRMapEntryWith insertCombineFunction
+  where
+    insertCombineFunction newVal oldVal =
+        case oldVal of
+          ProxyEntry n _ -> ProxyEntry n (Just newVal)
+          KeyEntry _     -> newVal
+
+
+addRMapEntries :: (Foldable t, HasKeyID a)
+               => t a
+               -> RingMap a
+               -> RingMap a
+addRMapEntries entries rmap = foldr' addRMapEntry rmap entries
+
+setRMapEntries :: (Foldable t, HasKeyID a)
+               => t a
+               -> RingMap a
+setRMapEntries entries = addRMapEntries entries emptyRMap
+
+deleteRMapEntry :: (HasKeyID a)
+                => NodeID
+                -> RingMap a
+                -> RingMap a
+deleteRMapEntry nid = RingMap . Map.update modifier nid . getRingMap
+  where
+    modifier (ProxyEntry idPointer _) = Just (ProxyEntry idPointer Nothing)
+    modifier KeyEntry {}              = Nothing
+
+rMapToList :: (HasKeyID a) => RingMap a -> [a]
+rMapToList = mapMaybe extractRingEntry . Map.elems . getRingMap
+
+rMapFromList :: (HasKeyID a) => [a] -> RingMap a
+rMapFromList = setRMapEntries
+
+-- | takes up to i entries from a 'RingMap' by calling a getter function on a
+-- *startAt* value and after that on the previously returned value.
+-- Stops once i entries have been taken or an entry has been encountered twice
+-- (meaning the ring has been traversed completely).
+-- Forms the basis for 'takeRMapSuccessors' and 'takeRMapPredecessors'.
+takeRMapEntries_ :: (HasKeyID a, Integral i)
+                 => (NodeID -> RingMap a -> Maybe a)
+                 -> NodeID
+                 -> i
+                 -> RingMap a
+                 -> [a]
+-- TODO: might be more efficient with dlists
+takeRMapEntries_ getterFunc startAt num rmap = reverse $
+    case getterFunc startAt rmap of
+      Nothing -> []
+      Just anEntry -> takeEntriesUntil (getKeyID anEntry) (getKeyID anEntry) (num-1) [anEntry]
+  where
+    takeEntriesUntil havingReached previousEntry remaining takeAcc
+      | remaining <= 0 = takeAcc
+      | getKeyID (fromJust $ getterFunc previousEntry rmap) == havingReached = takeAcc
+      | otherwise = let (Just gotEntry) = getterFunc previousEntry rmap
+                    in takeEntriesUntil havingReached (getKeyID gotEntry) (remaining-1) (gotEntry:takeAcc)
+
+takeRMapPredecessors :: (HasKeyID a, Integral i)
+                 => NodeID
+                 -> i
+                 -> RingMap a
+                 -> [a]
+takeRMapPredecessors = takeRMapEntries_ rMapLookupPred
+
+takeRMapSuccessors :: (HasKeyID a, Integral i)
+                 => NodeID
+                 -> i
+                 -> RingMap a
+                 -> [a]
+takeRMapSuccessors = takeRMapEntries_ rMapLookupSucc
+
+-- clean up cache entries: once now - entry > maxAge
+-- transfer difference now - entry to other node
+
+