From bd70e2dff02ea98b7d892d3a97d92f6df84fd4fe Mon Sep 17 00:00:00 2001 From: Trolli Schmittlauch Date: Wed, 29 Jul 2020 00:06:16 +0200 Subject: [PATCH 1/5] implement multiple post fetch (with placeholder content) --- src/Hash2Pub/PostService.hs | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/src/Hash2Pub/PostService.hs b/src/Hash2Pub/PostService.hs index ef22e29..169d2b7 100644 --- a/src/Hash2Pub/PostService.hs +++ b/src/Hash2Pub/PostService.hs @@ -14,7 +14,7 @@ import Control.Concurrent.STM import Control.Concurrent.STM.TChan import Control.Concurrent.STM.TQueue import Control.Concurrent.STM.TVar -import Control.Monad (forM_, forever) +import Control.Monad (foldM, forM_, forever) import Control.Monad.IO.Class (liftIO) import qualified Data.ByteString.Lazy.UTF8 as BSU import qualified Data.HashMap.Strict as HMap @@ -150,7 +150,7 @@ relayInbox serv post = do let containedTags = fmap (normaliseTag . Txt.tail) . filter ((==) '#' . Txt.head) . Txt.words $ post -- generate post ID - postId <- liftIO $ Txt.pack . show <$> (randomRIO (0, 2^128-1) :: IO Integer) + postId <- liftIO $ Txt.pack . show <$> (randomRIO (0, 2^(128::Integer)-1) :: IO Integer) -- add ID to own posts liftIO . atomically $ modifyTVar' (ownPosts serv) (HSet.insert postId) -- enqueue a relay job for each tag @@ -186,9 +186,17 @@ postFetch serv postID = do then pure placeholderPost else throwError $ err404 { errBody = "No post found with this ID" } + postMultiFetch :: PostService d -> Txt.Text -> Handler Txt.Text -postMultiFetch serv postIDs = pure $ "Here be multiple post dragons: " - <> (Txt.unwords . Txt.lines $ postIDs) +postMultiFetch serv postIDs = do + let idList = Txt.lines postIDs + postSet <- liftIO . readTVarIO . ownPosts $ serv + -- look up existence of all given post IDs, fail if even one is missing + foldM (\response postID -> + if HSet.member postID postSet + then pure $ placeholderPost <> "\n" <> response + else throwError $ err404 { errBody = "No post found with this ID" } + ) "" idList tagDelivery :: PostService d -> Txt.Text -> Txt.Text -> Handler Txt.Text tagDelivery serv hashtag posts = pure $ "Here be #" <> hashtag <> " dragons with " <> posts From ad52a017aa18c92188ddf89a3edc8e16340d1132 Mon Sep 17 00:00:00 2001 From: Trolli Schmittlauch Date: Wed, 29 Jul 2020 22:15:14 +0200 Subject: [PATCH 2/5] add relay inbox endpoint --- src/Hash2Pub/PostService.hs | 74 ++++++++++++++++++++++++++++--------- 1 file changed, 56 insertions(+), 18 deletions(-) diff --git a/src/Hash2Pub/PostService.hs b/src/Hash2Pub/PostService.hs index 169d2b7..059ebe5 100644 --- a/src/Hash2Pub/PostService.hs +++ b/src/Hash2Pub/PostService.hs @@ -56,10 +56,11 @@ type PostID = Txt.Text type PostContent = Txt.Text -- | For each handled tag, store its subscribers and provide a -- broadcast 'TChan' for enqueuing posts -type RelayTags = RingMap NodeID (TagSubscribers, TChan PostID, Hashtag) +type RelayTags = RingMap NodeID (TagSubscribersSTM, TChan PostID, Hashtag) +type TagSubscribersSTM = TVar TagSubscribers -- | each subscriber is identified by its contact data "hostname" "port" -- and holds a TChan duplicated from the broadcast TChan of the tag -type TagSubscribers = TVar (HMap.HashMap (String, Int) (TChan PostID)) +type TagSubscribers = (HMap.HashMap (String, Int) (TChan PostID)) instance DHT d => Service PostService d where @@ -115,7 +116,7 @@ placeholderPost = Txt.take 5120 . Txt.repeat $ 'O' -- size 5KiB -- ========= HTTP API and handlers ============= -type PostServiceAPI = "relay" :> "inbox" :> ReqBody '[PlainText] Txt.Text :> PutCreated '[PlainText] NoContent +type PostServiceAPI = "relay" :> "inbox" :> Capture "hashtag" Txt.Text :> ReqBody '[PlainText] Txt.Text :> PutCreated '[PlainText] NoContent -- ^ delivery endpoint of newly published posts of the relay's instance :<|> "relay" :> "subscribers" :> ReqBody '[PlainText] Txt.Text :> PostNoContent '[PlainText] NoContent -- ^ endpoint for delivering the subscriptions and outstanding queue @@ -123,6 +124,8 @@ type PostServiceAPI = "relay" :> "inbox" :> ReqBody '[PlainText] Txt.Text :> Put -- ^ fetch endpoint for posts, full post ID is http://$domain/post/$postid :<|> "posts" :> ReqBody '[PlainText] Txt.Text :> Post '[PlainText] Txt.Text -- ^ endpoint for fetching multiple posts at once + :<|> "posts" :> "inbox" :> ReqBody '[PlainText] Txt.Text :> PutCreated '[PlainText] NoContent + -- ^ delivery endpoint of newly published posts of the relay's instance :<|> "tags" :> Capture "hashtag" Txt.Text :> ReqBody '[PlainText] Txt.Text :> PostCreated '[PlainText] Txt.Text -- ^ delivery endpoint for posts of $tag at subscribing instance :<|> "tags" :> Capture "hashtag" Txt.Text :> "subscribe" :> Header "Origin" Txt.Text :> Get '[PlainText] Integer @@ -139,28 +142,28 @@ postServer service = relayInbox service :<|> subscriptionDelivery service :<|> postFetch service :<|> postMultiFetch service + :<|> postInbox service :<|> tagDelivery service :<|> tagSubscribe service :<|> tagUnsubscribe service -relayInbox :: PostService d -> Txt.Text -> Handler NoContent -relayInbox serv post = do - -- extract contained hashtags +relayInbox :: PostService d -> Hashtag -> Txt.Text -> Handler NoContent +relayInbox serv tag posts = do let - containedTags = fmap (normaliseTag . Txt.tail) . filter ((==) '#' . Txt.head) . Txt.words $ post - -- generate post ID - postId <- liftIO $ Txt.pack . show <$> (randomRIO (0, 2^(128::Integer)-1) :: IO Integer) - -- add ID to own posts - liftIO . atomically $ modifyTVar' (ownPosts serv) (HSet.insert postId) - -- enqueue a relay job for each tag - liftIO $ forM_ (containedTags :: [Txt.Text]) (\tag -> - atomically $ writeTQueue (relayInQueue serv) (tag, postId, post) - ) + -- skip checking whether the post actually contains the tag, just drop full post + postIDs = head . Txt.splitOn "," <$> Txt.lines posts + broadcastChan <- liftIO $ atomically $ getTagBroadcastChannel serv tag + -- if tag is not in own responsibility, return a 410 Gone + maybe + (throwError $ err410 { errBody = "Relay is not responsible for this tag"}) + -- otherwise enqueue posts into broadcast queue of the tag + (\queue -> + liftIO $ forM_ postIDs (atomically . writeTChan queue) + ) + broadcastChan pure NoContent - - subscriptionDelivery :: PostService d -> Txt.Text -> Handler NoContent subscriptionDelivery serv subList = do let @@ -198,6 +201,23 @@ postMultiFetch serv postIDs = do else throwError $ err404 { errBody = "No post found with this ID" } ) "" idList + +postInbox :: PostService d -> Txt.Text -> Handler NoContent +postInbox serv post = do + -- extract contained hashtags + let + containedTags = fmap (normaliseTag . Txt.tail) . filter ((==) '#' . Txt.head) . Txt.words $ post + -- generate post ID + postId <- liftIO $ Txt.pack . show <$> (randomRIO (0, 2^(128::Integer)-1) :: IO Integer) + -- add ID to own posts + liftIO . atomically $ modifyTVar' (ownPosts serv) (HSet.insert postId) + -- enqueue a relay job for each tag + liftIO $ forM_ (containedTags :: [Txt.Text]) (\tag -> + atomically $ writeTQueue (relayInQueue serv) (tag, postId, post) + ) + pure NoContent + + tagDelivery :: PostService d -> Txt.Text -> Txt.Text -> Handler Txt.Text tagDelivery serv hashtag posts = pure $ "Here be #" <> hashtag <> " dragons with " <> posts @@ -225,7 +245,7 @@ enqueueSubscriptions tagMapSTM tag subscriber posts = do setupSubscriberChannel :: STM (TChan PostID) setupSubscriberChannel = do tagMap <- readTVar tagMapSTM - case rMapLookup (genKeyID . Txt.unpack $ tag) tagMap of + case lookupRelayTags tag tagMap of Nothing -> do -- if no collision/ tag doesn't exist yet, just initialize a -- new subscriber map @@ -247,6 +267,24 @@ enqueueSubscriptions tagMapSTM tag subscriber posts = do Just tagOutChan -> pure tagOutChan +-- | returns the broadcast channel of a hashtag if there are any subscribers to it +getTagBroadcastChannel :: PostService d -> Hashtag -> STM (Maybe (TChan PostID)) +getTagBroadcastChannel serv tag = do + tagMap <- readTVar $ subscribers serv + case lookupRelayTags tag tagMap of + Nothing -> pure Nothing + Just (subscriberSTM, broadcastChan, _) -> do + subscriberMap <- readTVar subscriberSTM + if HMap.null subscriberMap + then pure Nothing + else pure (Just broadcastChan) + + +-- | look up the subscription data of a tag +lookupRelayTags :: Hashtag -> RelayTags -> Maybe (TagSubscribersSTM, TChan PostID, Hashtag) +lookupRelayTags tag = rMapLookup (genKeyID . Txt.unpack $ tag) + + -- normalise the unicode representation of a string to NFC normaliseTag :: Txt.Text -> Txt.Text normaliseTag = Txt.fromStrict . normalize NFC . Txt.toStrict From da47f8062fc155f3d4b163b4fb9770969f423c23 Mon Sep 17 00:00:00 2001 From: Trolli Schmittlauch Date: Wed, 29 Jul 2020 23:06:07 +0200 Subject: [PATCH 3/5] add lease time to subscription entries --- src/Hash2Pub/PostService.hs | 67 ++++++++++++++++++++----------------- 1 file changed, 37 insertions(+), 30 deletions(-) diff --git a/src/Hash2Pub/PostService.hs b/src/Hash2Pub/PostService.hs index 059ebe5..81b00a3 100644 --- a/src/Hash2Pub/PostService.hs +++ b/src/Hash2Pub/PostService.hs @@ -60,7 +60,8 @@ type RelayTags = RingMap NodeID (TagSubscribersSTM, TChan PostID, Hashtag) type TagSubscribersSTM = TVar TagSubscribers -- | each subscriber is identified by its contact data "hostname" "port" -- and holds a TChan duplicated from the broadcast TChan of the tag -type TagSubscribers = (HMap.HashMap (String, Int) (TChan PostID)) +-- + an expiration timestamp +type TagSubscribers = (HMap.HashMap (String, Int) (TChan PostID, POSIXTime)) instance DHT d => Service PostService d where @@ -175,10 +176,12 @@ subscriptionDelivery serv subList = do processTag :: TVar RelayTags -> Txt.Text -> IO () processTag subscriberSTM tagData = do let - tag:subText:posts:_ = Txt.splitOn "," tagData + tag:subText:lease:posts:_ = Txt.splitOn "," tagData + -- ignore checking of lease time + leaseTime = fromIntegral (read . Txt.unpack $ lease :: Integer) sub = read . Txt.unpack $ subText :: (String, Int) postList = Txt.words posts - enqueueSubscriptions subscriberSTM (normaliseTag tag) sub postList + enqueueSubscription subscriberSTM (normaliseTag tag) sub postList leaseTime postFetch :: PostService d -> Txt.Text -> Handler Txt.Text @@ -232,39 +235,43 @@ tagUnsubscribe serv hashtag origin = pure $ "Here be a dragon unsubscription fro -- | Write all pending posts of a subscriber-tag-combination to its queue. -- Sets up all necessary data structures if they are still missing. -enqueueSubscriptions :: TVar RelayTags -- tag-subscriber map +enqueueSubscription :: TVar RelayTags -- tag-subscriber map -> Hashtag -- hashtag of pending posts -> (String, Int) -- subscriber's connection information -> [PostID] -- pending posts + -> POSIXTime -- lease expiry time -> IO () -enqueueSubscriptions tagMapSTM tag subscriber posts = do +enqueueSubscription tagMapSTM tag subscriber posts leaseTime = do -- get the tag output queue and, if necessary, create it - subChan <- atomically setupSubscriberChannel + subChan <- atomically $ setupSubscriberChannel tagMapSTM tag subscriber leaseTime forM_ posts (atomically . writeTChan subChan) - where - setupSubscriberChannel :: STM (TChan PostID) - setupSubscriberChannel = do - tagMap <- readTVar tagMapSTM - case lookupRelayTags tag tagMap of - Nothing -> do - -- if no collision/ tag doesn't exist yet, just initialize a - -- new subscriber map - broadcastChan <- newBroadcastTChan - tagOutChan <- dupTChan broadcastChan - newSubMapSTM <- newTVar $ HMap.singleton subscriber tagOutChan - writeTVar tagMapSTM $ addRMapEntry (genKeyID . Txt.unpack $ tag) (newSubMapSTM, broadcastChan, tag) tagMap - pure tagOutChan - Just (foundSubMapSTM, broadcastChan, _) -> do - -- otherwise use the existing subscriber map - foundSubMap <- readTVar foundSubMapSTM - case HMap.lookup subscriber foundSubMap of - Nothing -> do - -- for new subscribers, create new output channel - tagOutChan <- dupTChan broadcastChan - writeTVar foundSubMapSTM $ HMap.insert subscriber tagOutChan foundSubMap - pure tagOutChan - -- existing subscriber's channels are just returned - Just tagOutChan -> pure tagOutChan + + +-- | STM operation to return the outgoing post queue of a tag to a specified subscriber. +-- If the queue doesn't exist yet, all necessary data structures are set up accordingly. +setupSubscriberChannel :: TVar RelayTags -> Hashtag -> (String, Int) -> POSIXTime -> STM (TChan PostID) +setupSubscriberChannel tagMapSTM tag subscriber leaseTime = do + tagMap <- readTVar tagMapSTM + case lookupRelayTags tag tagMap of + Nothing -> do + -- if no collision/ tag doesn't exist yet, just initialize a + -- new subscriber map + broadcastChan <- newBroadcastTChan + tagOutChan <- dupTChan broadcastChan + newSubMapSTM <- newTVar $ HMap.singleton subscriber (tagOutChan, leaseTime) + writeTVar tagMapSTM $ addRMapEntry (genKeyID . Txt.unpack $ tag) (newSubMapSTM, broadcastChan, tag) tagMap + pure tagOutChan + Just (foundSubMapSTM, broadcastChan, _) -> do + -- otherwise use the existing subscriber map + foundSubMap <- readTVar foundSubMapSTM + case HMap.lookup subscriber foundSubMap of + Nothing -> do + -- for new subscribers, create new output channel + tagOutChan <- dupTChan broadcastChan + writeTVar foundSubMapSTM $ HMap.insert subscriber (tagOutChan, leaseTime) foundSubMap + pure tagOutChan + -- existing subscriber's channels are just returned + Just (tagOutChan, _) -> pure tagOutChan -- | returns the broadcast channel of a hashtag if there are any subscribers to it From 98ca0ff13e2996aa45d7bcfab695143689ae8650 Mon Sep 17 00:00:00 2001 From: Trolli Schmittlauch Date: Thu, 30 Jul 2020 01:21:56 +0200 Subject: [PATCH 4/5] service config, integrate service launch into DHT launch TODO: hold a reference from DHT to service --- Hash2Pub.cabal | 2 +- app/Main.hs | 20 +++++++++++++++----- src/Hash2Pub/FediChord.hs | 11 +++++++++-- src/Hash2Pub/FediChordTypes.hs | 25 +++++++++++++++++++++++++ src/Hash2Pub/PostService.hs | 15 ++++++--------- src/Hash2Pub/ServiceTypes.hs | 15 --------------- 6 files changed, 56 insertions(+), 32 deletions(-) delete mode 100644 src/Hash2Pub/ServiceTypes.hs diff --git a/Hash2Pub.cabal b/Hash2Pub.cabal index 56441ad..54cb29d 100644 --- a/Hash2Pub.cabal +++ b/Hash2Pub.cabal @@ -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, Hash2Pub.RingMap + exposed-modules: Hash2Pub.FediChord, Hash2Pub.FediChordTypes, Hash2Pub.DHTProtocol, Hash2Pub.ASN1Coding, Hash2Pub.ProtocolTypes, Hash2Pub.PostService, Hash2Pub.RingMap -- Modules included in this library but not exported. other-modules: Hash2Pub.Utils diff --git a/app/Main.hs b/app/Main.hs index 8887ee8..98961c0 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -10,15 +10,17 @@ import Data.IP (IPv6, toHostAddress6) import System.Environment import Hash2Pub.FediChord +import Hash2Pub.FediChordTypes +import Hash2Pub.PostService (PostService (..)) main :: IO () main = do -- ToDo: parse and pass config -- probably use `tomland` for that - conf <- readConfig + (fConf, sConf) <- readConfig -- TODO: first initialise 'RealNode', then the vservers -- ToDo: load persisted caches, bootstrapping nodes … - (serverSock, thisNode) <- fediChordInit conf + (serverSock, thisNode) <- fediChordInit fConf (runService sConf :: DHT d => d -> IO (PostService d)) -- currently no masking is necessary, as there is nothing to clean up nodeCacheWriterThread <- forkIO $ nodeCacheWriter thisNode -- try joining the DHT using one of the provided bootstrapping nodes @@ -41,10 +43,11 @@ main = do pure () -readConfig :: IO FediChordConf +readConfig :: IO (FediChordConf, ServiceConf) readConfig = do - confDomainString : ipString : portString : bootstrapHost : bootstrapPortString : _ <- getArgs - pure $ FediChordConf { + confDomainString : ipString : portString : bootstrapHost : bootstrapPortString : servicePortString : speedup : _ <- getArgs + let + fConf = FediChordConf { confDomain = confDomainString , confIP = toHostAddress6 . read $ ipString , confDhtPort = read portString @@ -53,3 +56,10 @@ readConfig = do , confBootstrapSamplingInterval = 180 , confMaxLookupCacheAge = 300 } + sConf = ServiceConf { + confSubscriptionExpiryTime = 2*3600 `div` read speedup + , confServicePort = read servicePortString + , confServiceHost = confDomainString + } + pure (fConf, sConf) + diff --git a/src/Hash2Pub/FediChord.hs b/src/Hash2Pub/FediChord.hs index 26a373c..7a5abb0 100644 --- a/src/Hash2Pub/FediChord.hs +++ b/src/Hash2Pub/FediChord.hs @@ -95,16 +95,23 @@ import Debug.Trace (trace) -- | 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, LocalNodeStateSTM) -fediChordInit initConf = do +--fediChordInit :: (DHT d, Service s d) +-- => FediChordConf +-- -> (d -> s d) -- ^ runner function for service +-- -> IO (Socket, LocalNodeStateSTM) +fediChordInit initConf serviceRunner = do emptyLookupCache <- newTVarIO Map.empty let realNode = RealNode { vservers = [] , nodeConfig = initConf , bootstrapNodes = confBootstrapNodes initConf , lookupCacheSTM = emptyLookupCache + --, service = undefined } realNodeSTM <- newTVarIO realNode + -- launch service and set the reference in the RealNode + serv <- serviceRunner realNodeSTM + --atomically . writeTVar $ realNode { service = serv } initialState <- nodeStateInit realNodeSTM initialStateSTM <- newTVarIO initialState serverSock <- mkServerSocket (getIpAddr initialState) (getDhtPort initialState) diff --git a/src/Hash2Pub/FediChordTypes.hs b/src/Hash2Pub/FediChordTypes.hs index d764b71..604519e 100644 --- a/src/Hash2Pub/FediChordTypes.hs +++ b/src/Hash2Pub/FediChordTypes.hs @@ -58,11 +58,14 @@ module Hash2Pub.FediChordTypes ( , bsAsIpAddr , FediChordConf(..) , DHT(..) + , Service(..) + , ServiceConf(..) ) where import Control.Exception import Data.Foldable (foldr') import Data.Function (on) +import qualified Data.Hashable as Hashable import Data.List (delete, nub, sortBy) import qualified Data.Map.Strict as Map import Data.Maybe (fromJust, fromMaybe, isJust, @@ -144,6 +147,7 @@ a `localCompare` b -- | Data for managing the virtual server nodes of this real node. -- Also contains shared data and config values. -- TODO: more data structures for k-choices bookkeeping +--data RealNode s = RealNode data RealNode = RealNode { vservers :: [LocalNodeStateSTM] -- ^ references to all active versers @@ -155,6 +159,7 @@ data RealNode = RealNode -- ^ a global cache of looked up keys and their associated nodes } +--type RealNodeSTM s = TVar (RealNode s) type RealNodeSTM = TVar RealNode -- | represents a node and all its important state @@ -411,6 +416,26 @@ data FediChordConf = FediChordConf } deriving (Show, Eq) +-- ====== Service Types ============ + +class Service s d where + -- | run the service + runService :: ServiceConf -> d -> IO (s d) + getServicePort' :: (Integral i) => s d -> i + +instance Hashable.Hashable NodeID where + hashWithSalt salt = Hashable.hashWithSalt salt . getNodeID + hash = Hashable.hash . getNodeID + +data ServiceConf = ServiceConf + { confSubscriptionExpiryTime :: Integer + -- ^ subscription lease expiration in seconds + , confServicePort :: Int + -- ^ listening port for service + , confServiceHost :: String + -- ^ hostname of service + } + class DHT d where -- | lookup the responsible host handling a given key string, -- possiblggy from a lookup cache diff --git a/src/Hash2Pub/PostService.hs b/src/Hash2Pub/PostService.hs index 81b00a3..264bccb 100644 --- a/src/Hash2Pub/PostService.hs +++ b/src/Hash2Pub/PostService.hs @@ -32,12 +32,10 @@ import Servant import Hash2Pub.FediChordTypes import Hash2Pub.RingMap -import Hash2Pub.ServiceTypes data PostService d = PostService - { psPort :: Warp.Port - , psHost :: String + { serviceConf :: ServiceConf -- queues, other data structures , baseDHT :: (DHT d) => d , serviceThread :: TVar ThreadId @@ -66,7 +64,7 @@ type TagSubscribers = (HMap.HashMap (String, Int) (TChan PostID, POSIXTime)) instance DHT d => Service PostService d where -- | initialise 'PostService' data structures and run server - runService dht host port = do + runService conf dht = do -- create necessary TVars threadVar <- newTVarIO =<< myThreadId -- own thread ID as placeholder subscriberVar <- newTVarIO emptyRMap @@ -75,8 +73,7 @@ instance DHT d => Service PostService d where relayInQueue' <- newTQueueIO let thisService = PostService { - psPort = port' - , psHost = host + serviceConf = conf , baseDHT = dht , serviceThread = threadVar , subscribers = subscriberVar @@ -84,8 +81,8 @@ instance DHT d => Service PostService d where , ownPosts = ownPostVar , relayInQueue = relayInQueue' } - port' = fromIntegral port - warpSettings = Warp.setPort port' . Warp.setHost (fromString host) $ Warp.defaultSettings + port' = fromIntegral (confServicePort conf) + warpSettings = Warp.setPort port' . Warp.setHost (fromString . confServiceHost $ conf) $ Warp.defaultSettings -- Run 'concurrently_' from another thread to be able to return the -- 'PostService'. -- Terminating that parent thread will make all child threads terminate as well. @@ -98,7 +95,7 @@ instance DHT d => Service PostService d where atomically $ writeTVar threadVar servThreadID pure thisService - getServicePort s = fromIntegral $ psPort s + getServicePort' = fromIntegral . confServicePort . serviceConf -- | return a WAI application diff --git a/src/Hash2Pub/ServiceTypes.hs b/src/Hash2Pub/ServiceTypes.hs deleted file mode 100644 index 5e2b37c..0000000 --- a/src/Hash2Pub/ServiceTypes.hs +++ /dev/null @@ -1,15 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses #-} -module Hash2Pub.ServiceTypes where - -import Data.Hashable (Hashable (..)) - -import Hash2Pub.FediChord (DHT (..), NodeID (..)) - -class Service s d where - -- | run the service - runService :: (Integral i) => d -> String -> i -> IO (s d) - getServicePort :: (Integral i) => s d -> i - -instance Hashable NodeID where - hashWithSalt salt = hashWithSalt salt . getNodeID - hash = hash . getNodeID From 4bf80911432da8db7b1d5bc9278885310c1517c7 Mon Sep 17 00:00:00 2001 From: Trolli Schmittlauch Date: Thu, 30 Jul 2020 01:30:42 +0200 Subject: [PATCH 5/5] fix type signature of fediChordInit --- src/Hash2Pub/FediChord.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Hash2Pub/FediChord.hs b/src/Hash2Pub/FediChord.hs index 7a5abb0..70c9ff7 100644 --- a/src/Hash2Pub/FediChord.hs +++ b/src/Hash2Pub/FediChord.hs @@ -95,10 +95,10 @@ import Debug.Trace (trace) -- | initialise data structures, compute own IDs and bind to listening socket -- ToDo: load persisted state, thus this function already operates in IO ---fediChordInit :: (DHT d, Service s d) --- => FediChordConf --- -> (d -> s d) -- ^ runner function for service --- -> IO (Socket, LocalNodeStateSTM) +fediChordInit :: (Service s RealNodeSTM) + => FediChordConf + -> (RealNodeSTM -> IO (s RealNodeSTM)) -- ^ runner function for service + -> IO (Socket, LocalNodeStateSTM) fediChordInit initConf serviceRunner = do emptyLookupCache <- newTVarIO Map.empty let realNode = RealNode {