src/Hash2Pub/DHTProtocol.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE FlexibleContexts #-}
+
 module Hash2Pub.DHTProtocol
     ( QueryResponse (..)
     , queryLocalCache
@@ -128,8 +130,8 @@ closestCachePredecessors remainingLookups lastID nCache
 -- Looks up the successor of the lookup key on a 'RingMap' representation of the
 -- predecessor list with the node itself added. If the result is the same as the node
 -- itself then it falls into the responsibility interval.
-isInOwnResponsibilitySlice :: HasKeyID a => a -> LocalNodeState -> Bool
+isInOwnResponsibilitySlice :: HasKeyID a NodeID => a -> LocalNodeState -> Bool
-isInOwnResponsibilitySlice lookupTarget ownNs = (getKeyID <$> rMapLookupSucc (getKeyID lookupTarget) predecessorRMap) == pure (getNid ownNs)
+isInOwnResponsibilitySlice lookupTarget ownNs = (getKeyID <$> rMapLookupSucc (getKeyID lookupTarget :: NodeID) predecessorRMap) == pure (getNid ownNs)
   where
     predecessorList = predecessors ownNs
     -- add node itself to RingMap representation, to distinguish between
@@ -137,11 +139,11 @@ isInOwnResponsibilitySlice lookupTarget ownNs = (getKeyID <$> rMapLookupSucc (ge
     predecessorRMap = addRMapEntry (toRemoteNodeState ownNs) $ rMapFromList predecessorList
     closestPredecessor = headMay predecessorList
 
-isPossiblePredecessor :: HasKeyID a => a -> LocalNodeState -> Bool
+isPossiblePredecessor :: HasKeyID a NodeID => a -> LocalNodeState -> Bool
 isPossiblePredecessor = isInOwnResponsibilitySlice
 
-isPossibleSuccessor :: HasKeyID a => a -> LocalNodeState -> Bool
+isPossibleSuccessor :: HasKeyID a NodeID => a -> LocalNodeState -> Bool
-isPossibleSuccessor lookupTarget ownNs = (getKeyID <$> rMapLookupPred (getKeyID lookupTarget) successorRMap) == pure (getNid ownNs)
+isPossibleSuccessor lookupTarget ownNs = (getKeyID <$> rMapLookupPred (getKeyID lookupTarget :: NodeID) successorRMap) == pure (getNid ownNs)
   where
     successorList = successors ownNs
     successorRMap = addRMapEntry (toRemoteNodeState ownNs) $ rMapFromList successorList

src/Hash2Pub/FediChordTypes.hs

@@ -1,6 +1,8 @@
 {-# LANGUAGE DataKinds                  #-}
 {-# LANGUAGE DerivingStrategies         #-}
+{-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
 {-# LANGUAGE OverloadedStrings          #-}
 {-# LANGUAGE RankNTypes                 #-}
 
@@ -283,17 +285,17 @@ 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}
 
-instance HasKeyID RemoteNodeState where
+instance HasKeyID RemoteNodeState NodeID where
     getKeyID = getNid
 
-instance HasKeyID a => HasKeyID (CacheEntry a) where
+instance HasKeyID a k => HasKeyID (CacheEntry a) k where
     getKeyID (CacheEntry _ obj _) = getKeyID obj
 
-instance HasKeyID NodeID where
+instance HasKeyID NodeID NodeID where
     getKeyID = id
 
 type NodeCacheEntry = CacheEntry RemoteNodeState
-type NodeCache = RingMap NodeCacheEntry
+type NodeCache = RingMap NodeCacheEntry NodeID
 
 type LookupCacheEntry = CacheEntry (String, PortNumber)
 type LookupCache = Map.Map NodeID LookupCacheEntry

src/Hash2Pub/PostService.hs

@@ -16,7 +16,6 @@ import qualified Data.Text                 as Txt
 
 import qualified Network.Wai.Handler.Warp  as Warp
 import           Servant
-import           Web.HttpApiData           (showTextData)
 
 import           Hash2Pub.FediChord
 import           Hash2Pub.ServiceTypes

src/Hash2Pub/RingMap.hs

@@ -1,4 +1,5 @@
-{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes            #-}
 
 module Hash2Pub.RingMap where
 
@@ -7,19 +8,19 @@ import qualified Data.Map.Strict as Map
 import           Data.Maybe      (fromJust, isJust, isNothing, mapMaybe)
 
 
--- | Class for all types that can be identified via an EpiChord key.
+-- | Class for all types that can be identified via a EpiChord key.
 -- Used for restricting the types a 'RingMap' can store
-class (Eq a, Show a) => HasKeyID a where
+class (Eq a, Show a, Bounded k, Ord k) => HasKeyID a k where
-    getKeyID :: (Bounded k, Ord k) => a -> k
+    getKeyID :: a -> k
 
 
 -- | generic data structure for holding elements with a key and modular lookup
-newtype RingMap a k = RingMap { getRingMap :: (HasKeyID a, Bounded k, Ord k) => Map.Map k (RingEntry a k) }
+newtype RingMap a k = RingMap { getRingMap :: (HasKeyID a k, Bounded k, Ord k) => Map.Map k (RingEntry a k) }
 
-instance (HasKeyID a, Bounded k, Ord k) => Eq (RingMap a k) where
+instance (HasKeyID a k, Bounded k, Ord k) => Eq (RingMap a k) where
     a == b = getRingMap a == getRingMap b
 
-instance (HasKeyID a, Bounded k, Ord k, Show k) => Show (RingMap a k) where
+instance (HasKeyID a k, Bounded k, Ord k, Show k) => Show (RingMap a k) where
     show rmap = shows "RingMap " (show $ getRingMap rmap)
 
 -- | entry of a 'RingMap' that holds a value and can also
@@ -30,10 +31,10 @@ data RingEntry a k = KeyEntry a
 
 -- | as a compromise, only KeyEntry components are ordered by their key
 -- while ProxyEntry components should never be tried to be ordered.
-instance (HasKeyID a, Eq k, Ord a, Bounded k, Ord k) => Ord (RingEntry a k) where
+instance (HasKeyID a k, Eq k, Ord a, Bounded k, Ord k) => Ord (RingEntry a k) where
     a `compare` b = compare (extractID a) (extractID b)
         where
-            extractID :: (HasKeyID a, Ord a, Bounded k, Ord k) => RingEntry a k -> k
+            extractID :: (HasKeyID a k, Ord a, Bounded k, Ord k) => RingEntry a k -> k
             extractID (KeyEntry e) = getKeyID e
             extractID ProxyEntry{} = error "proxy entries should never appear outside of the RingMap"
 
@@ -49,40 +50,40 @@ instance Enum ProxyDirection where
     fromEnum Forwards  = 1
 
 -- | helper function for getting the a from a RingEntry a k
-extractRingEntry :: (HasKeyID a, Bounded k, Ord k) => RingEntry a k -> Maybe a
+extractRingEntry :: (HasKeyID a k, Bounded k, Ord k) => RingEntry a k -> 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, Bounded k, Ord k) => RingMap a k
+emptyRMap :: (HasKeyID a k, Bounded k, Ord k) => RingMap a k
 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, Bounded k, Ord k)
+rMapLookup :: (HasKeyID a k, Bounded k, Ord k)
            => k       -- ^lookup key
            -> RingMap a k    -- ^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, Bounded k, Ord k)
+rMapSize :: (HasKeyID a k, Integral i, Bounded k, Ord k)
          => RingMap a k
          -> i
 rMapSize rmap = fromIntegral $ Map.size innerMap - oneIfEntry rmap minBound - oneIfEntry rmap maxBound
   where
     innerMap = getRingMap rmap
-    oneIfEntry :: (HasKeyID a, Integral i, Bounded k, Ord k) => RingMap a k -> k -> i
+    oneIfEntry :: (HasKeyID a k, Integral i, Bounded k, Ord k) => RingMap a k -> k -> i
     oneIfEntry rmap' 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, Bounded k, Ord k, Num k)
+lookupWrapper :: (HasKeyID a k, Bounded k, Ord k, Num k)
               => (k -> Map.Map k (RingEntry a k) -> Maybe (k, RingEntry a k))
               -> (k -> Map.Map k (RingEntry a k) -> Maybe (k, RingEntry a k))
               -> ProxyDirection
@@ -108,7 +109,7 @@ lookupWrapper f fRepeat direction key rmap =
         Just (_, KeyEntry entry) -> Just entry
         Nothing -> Nothing
   where
-    rMapNotEmpty :: (HasKeyID a, Bounded k, Ord k) => RingMap a k -> Bool
+    rMapNotEmpty :: (HasKeyID a k, Bounded k, Ord k) => RingMap a k -> 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')
@@ -116,20 +117,20 @@ lookupWrapper f fRepeat direction key 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, Bounded k, Ord k, Num k)
+rMapLookupSucc :: (HasKeyID a k, Bounded k, Ord k, Num k)
                => k           -- ^lookup key
                -> RingMap a k       -- ^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, Bounded k, Ord k, Num k)
+rMapLookupPred :: (HasKeyID a k, Bounded k, Ord k, Num k)
                => k           -- ^lookup key
                -> RingMap a k        -- ^ring cache
                -> Maybe a
 rMapLookupPred = lookupWrapper Map.lookupLT Map.lookupLE Backwards
 
-addRMapEntryWith :: (HasKeyID a, Bounded k, Ord k)
+addRMapEntryWith :: (HasKeyID a k, Bounded k, Ord k)
                  => (RingEntry a k -> RingEntry a k -> RingEntry a k)
                  -> a
                  -> RingMap a k
@@ -138,7 +139,7 @@ addRMapEntryWith combineFunc entry = RingMap
     . Map.insertWith combineFunc (getKeyID entry) (KeyEntry entry)
     . getRingMap
 
-addRMapEntry :: (HasKeyID a, Bounded k, Ord k)
+addRMapEntry :: (HasKeyID a k, Bounded k, Ord k)
              => a
              -> RingMap a k
              -> RingMap a k
@@ -150,18 +151,18 @@ addRMapEntry = addRMapEntryWith insertCombineFunction
           KeyEntry _     -> newVal
 
 
-addRMapEntries :: (Foldable t, HasKeyID a, Bounded k, Ord k)
+addRMapEntries :: (Foldable t, HasKeyID a k, Bounded k, Ord k)
                => t a
                -> RingMap a k
                -> RingMap a k
 addRMapEntries entries rmap = foldr' addRMapEntry rmap entries
 
-setRMapEntries :: (Foldable t, HasKeyID a, Bounded k, Ord k)
+setRMapEntries :: (Foldable t, HasKeyID a k, Bounded k, Ord k)
                => t a
                -> RingMap a k
 setRMapEntries entries = addRMapEntries entries emptyRMap
 
-deleteRMapEntry :: (HasKeyID a, Bounded k, Ord k)
+deleteRMapEntry :: (HasKeyID a k, Bounded k, Ord k)
                 => k
                 -> RingMap a k
                 -> RingMap a k
@@ -170,10 +171,10 @@ deleteRMapEntry nid = RingMap . Map.update modifier nid . getRingMap
     modifier (ProxyEntry idPointer _) = Just (ProxyEntry idPointer Nothing)
     modifier KeyEntry {}              = Nothing
 
-rMapToList :: (HasKeyID a, Bounded k, Ord k) => RingMap a k -> [a]
+rMapToList :: (HasKeyID a k, Bounded k, Ord k) => RingMap a k -> [a]
 rMapToList = mapMaybe extractRingEntry . Map.elems . getRingMap
 
-rMapFromList :: (HasKeyID a, Bounded k, Ord k) => [a] -> RingMap a k
+rMapFromList :: (HasKeyID a k, Bounded k, Ord k) => [a] -> RingMap a k
 rMapFromList = setRMapEntries
 
 -- | takes up to i entries from a 'RingMap' by calling a getter function on a
@@ -181,7 +182,7 @@ rMapFromList = setRMapEntries
 -- 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, Bounded k, Ord k)
+takeRMapEntries_ :: (HasKeyID a k, Integral i, Bounded k, Ord k)
                  => (k -> RingMap a k -> Maybe a)
                  -> k
                  -> i
@@ -195,7 +196,7 @@ takeRMapEntries_ getterFunc startAt num rmap = reverse $
   where
     -- for some reason, just reusing the already-bound @rmap@ and @getterFunc@
     -- variables leads to a type error, these need to be passed explicitly
-    takeEntriesUntil :: (HasKeyID a, Integral i, Bounded k, Ord k)
+    takeEntriesUntil :: (HasKeyID a k, Integral i, Bounded k, Ord k)
                      => RingMap a k
                      -> (k -> RingMap a k -> Maybe a) -- getter function
                      -> k
@@ -209,14 +210,14 @@ takeRMapEntries_ getterFunc startAt num rmap = reverse $
       | otherwise = let (Just gotEntry) = getterFunc' previousEntry rmap'
                     in takeEntriesUntil rmap' getterFunc' havingReached (getKeyID gotEntry) (remaining-1) (gotEntry:takeAcc)
 
-takeRMapPredecessors :: (HasKeyID a, Integral i, Bounded k, Ord k, Num k)
+takeRMapPredecessors :: (HasKeyID a k, Integral i, Bounded k, Ord k, Num k)
                  => k
                  -> i
                  -> RingMap a k
                  -> [a]
 takeRMapPredecessors = takeRMapEntries_ rMapLookupPred
 
-takeRMapSuccessors :: (HasKeyID a, Integral i, Bounded k, Ord k, Num k)
+takeRMapSuccessors :: (HasKeyID a k, Integral i, Bounded k, Ord k, Num k)
                  => k
                  -> i
                  -> RingMap a k