diff --git a/app/Experiment.hs b/app/Experiment.hs index 51b8e88..deb4cae 100644 --- a/app/Experiment.hs +++ b/app/Experiment.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} module Main where -import System.Random -import Control.Concurrent -import Control.Monad (forM_) -import Control.Monad.State.Class -import Control.Monad.State.Strict (evalStateT) -import Control.Monad.IO.Class -import qualified Network.HTTP.Client as HTTP +import Control.Concurrent +import Control.Monad (forM_) +import Control.Monad.IO.Class +import Control.Monad.State.Class +import Control.Monad.State.Strict (evalStateT) +import qualified Network.HTTP.Client as HTTP +import System.Random -import Hash2Pub.PostService (clientPublishPost, Hashtag) +import Hash2Pub.PostService (Hashtag, clientPublishPost) -- placeholder post data definition diff --git a/src/Hash2Pub/DHTProtocol.hs b/src/Hash2Pub/DHTProtocol.hs index 45af727..fa5a54a 100644 --- a/src/Hash2Pub/DHTProtocol.hs +++ b/src/Hash2Pub/DHTProtocol.hs @@ -49,8 +49,8 @@ import Control.Concurrent.STM.TQueue import Control.Concurrent.STM.TVar import Control.Exception import Control.Monad (foldM, forM, forM_, void, when) -import Control.Monad.IO.Class (MonadIO(..)) -import Control.Monad.Except (MonadError(..), runExceptT) +import Control.Monad.Except (MonadError (..), runExceptT) +import Control.Monad.IO.Class (MonadIO (..)) import qualified Data.ByteString as BS import Data.Either (rights) import Data.Foldable (foldl', foldr', foldrM) @@ -516,7 +516,7 @@ requestJoin toJoinOn ownStateSTM = do ([], Set.empty, Set.empty) responses -- sort, slice and set the accumulated successors and predecessors - -- the contacted node itself is a successor as well and, with few + -- the contacted node itself is a successor as well and, with few -- nodes, can be a predecessor as well newState = setSuccessors (toRemoteNodeState toJoinOn:Set.elems succAccSet) . setPredecessors (toRemoteNodeState toJoinOn:Set.elems predAccSet) $ stateSnap writeTVar ownStateSTM newState @@ -596,7 +596,7 @@ sendQueryIdMessages targetID ns lParam targets = do now <- getPOSIXTime -- collect cache entries from all responses foldrM (\resp acc -> do - let + let responseResult = queryResult <$> payload resp entrySet = case responseResult of Just (FOUND result1) -> Set.singleton (RemoteCacheEntry result1 now) @@ -609,14 +609,14 @@ sendQueryIdMessages targetID ns lParam targets = do pure $ case acc of -- once a FOUND as been encountered, return this as a result FOUND{} -> acc - FORWARD accSet + FORWARD accSet | maybe False isFound responseResult -> fromJust responseResult | otherwise -> FORWARD $ entrySet `Set.union` accSet ) (FORWARD Set.empty) responses where isFound FOUND{} = True - isFound _ = False + isFound _ = False -- | Create a QueryID message to be supplied to 'sendRequestTo' lookupMessage :: Integral i diff --git a/src/Hash2Pub/FediChord.hs b/src/Hash2Pub/FediChord.hs index 15cee10..45d0bf9 100644 --- a/src/Hash2Pub/FediChord.hs +++ b/src/Hash2Pub/FediChord.hs @@ -504,7 +504,7 @@ stabiliseThread nsSTM = forever $ do forM_ [(length $ predecessors updatedNs)..(kNeighbours updatedNs)] (\_ -> do ns' <- readTVarIO nsSTM nextEntry <- runExceptT . requestQueryID ns' $ pred . getNid $ lastDef (toRemoteNodeState ns') (predecessors ns') - either + either (const $ pure ()) (\entry -> atomically $ do latestNs <- readTVar nsSTM @@ -782,7 +782,7 @@ updateLookupCache nodeSTM keyToLookup = do -- TODO: better retry management, because having no vserver joined yet should -- be treated differently than other reasons for not getting a result. newResponsible <- runExceptT $ requestQueryID n keyToLookup - either + either (const $ pure Nothing) (\result -> do let newEntry = (getDomain result, getServicePort result) diff --git a/src/Hash2Pub/PostService.hs b/src/Hash2Pub/PostService.hs index 92f784a..81cf552 100644 --- a/src/Hash2Pub/PostService.hs +++ b/src/Hash2Pub/PostService.hs @@ -11,27 +11,27 @@ module Hash2Pub.PostService where import Control.Concurrent import Control.Concurrent.Async import Control.Concurrent.STM -import Control.Exception (Exception (..), try) -import Control.Monad (foldM, forM, forM_, forever, when, void) -import Control.Monad.IO.Class (liftIO) +import Control.Exception (Exception (..), try) +import Control.Monad (foldM, forM, forM_, forever, void, + when) +import Control.Monad.IO.Class (liftIO) import Data.Bifunctor -import qualified Data.ByteString.Lazy.UTF8 as BSUL -import qualified Data.ByteString.UTF8 as BSU -import qualified Data.HashMap.Strict as HMap -import qualified Data.HashSet as HSet -import Data.Maybe (fromMaybe, isJust) -import Data.String (fromString) -import qualified Data.Text.Lazy as Txt -import Data.Text.Normalize (NormalizationMode (NFC), - normalize) +import qualified Data.ByteString.Lazy.UTF8 as BSUL +import qualified Data.ByteString.UTF8 as BSU +import qualified Data.HashMap.Strict as HMap +import qualified Data.HashSet as HSet +import Data.Maybe (fromMaybe, isJust) +import Data.String (fromString) +import qualified Data.Text.Lazy as Txt +import Data.Text.Normalize (NormalizationMode (NFC), normalize) import Data.Time.Clock.POSIX -import Data.Typeable (Typeable) -import qualified Network.HTTP.Client as HTTP -import qualified Network.HTTP.Types as HTTPT +import Data.Typeable (Typeable) +import qualified Network.HTTP.Client as HTTP +import qualified Network.HTTP.Types as HTTPT import System.Random -import Text.Read (readEither) +import Text.Read (readEither) -import qualified Network.Wai.Handler.Warp as Warp +import qualified Network.Wai.Handler.Warp as Warp import Servant import Servant.Client