Commit e2497bfa authored by Pranay Sashank's avatar Pranay Sashank

Make P2PEnv take a m parameter

parent dc708ae1
Pipeline #32262349 failed with stage
in 0 seconds
......@@ -123,11 +123,14 @@ executable Main
, base >=4.9 && <4.11
, directory
, bytestring
, exceptions
, hashtables <= 1.2.6.1
, lifted-async
, monad-control
, monad-logger
, mtl
, stm >= 2.4.4.1
, transformers-base
, time
, arivi-crypto
, arivi-utils
......
......@@ -6,6 +6,9 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
module Main
( module Main
......@@ -22,8 +25,11 @@ import Arivi.P2P.Handler (newIncomingConnectionHandler)
import Arivi.P2P.Kademlia.LoadDefaultPeers
import Control.Concurrent.Async.Lifted (async, wait)
import Control.Monad.Base
import Control.Monad.Catch
import Control.Monad.Logger
import Control.Monad.Reader
import Control.Monad.Trans.Control
import Data.ByteString.Lazy as BSL (ByteString)
import Data.ByteString.Lazy.Char8 as BSLC (pack)
import Data.Monoid ((<>))
......@@ -32,7 +38,20 @@ import Data.Text
import System.Directory (doesPathExist)
import System.Environment (getArgs)
type AppM = ReaderT (P2PEnv ByteString ByteString ByteString ByteString) (LoggingT IO)
newtype AppM a =
AppM (ReaderT (P2PEnv AppM ByteString ByteString ByteString ByteString) (LoggingT IO) a)
deriving ( Functor
, Applicative
, Monad
, MonadReader (P2PEnv AppM ByteString ByteString ByteString ByteString)
, MonadIO
, MonadThrow
, MonadCatch
, MonadLogger
)
deriving instance MonadBase IO AppM
deriving instance MonadBaseControl IO AppM
instance HasNetworkEnv AppM where
getEnv = asks (ariviNetworkEnv . nodeEndpointEnv)
......@@ -59,10 +78,10 @@ instance HasPRT AppM where
getKClosestVsRandomTVar = asks (tvKClosestVsRandom . prtEnv)
runAppM ::
P2PEnv ByteString ByteString ByteString ByteString
P2PEnv AppM ByteString ByteString ByteString ByteString
-> AppM a
-> LoggingT IO a
runAppM = flip runReaderT
runAppM env (AppM app) = runReaderT app env
{--
writeConfigs path = do
......
......@@ -3,7 +3,7 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DataKinds, FunctionalDependencies #-}
module Arivi.P2P.P2PEnv
( module Arivi.P2P.P2PEnv
......@@ -46,7 +46,7 @@ type HasP2PEnv env m r t rmsg pmsg
, HasPRT m
, MonadReader env m
, HasNetworkConfig env NetworkConfig
, HasPSGlobalHandler env r t rmsg pmsg
, HasPSGlobalHandler env m r t rmsg pmsg
)
data NodeEndpointEnv = NodeEndpointEnv {
......@@ -76,20 +76,20 @@ mkKademlia NetworkConfig{..} sbound pingThreshold kademliaConcurrencyFactor hopB
hopBound
data P2PEnv r t rmsg pmsg = P2PEnv {
data P2PEnv m r t rmsg pmsg = P2PEnv {
nodeEndpointEnv :: NodeEndpointEnv
, rEnv :: RpcEnv r rmsg
, psEnv :: PubSubEnv t pmsg
, kademliaEnv :: KademliaEnv
, statsdClient :: StatsdClient
, prtEnv :: PRTEnv
, psHandler :: forall env m . (HasP2PEnv env m r t rmsg pmsg) => pmsg -> m Status
, psHandler :: pmsg -> m Status
}
class HasPSGlobalHandler env r t rmsg pmsg where
psGlobalHandler :: env -> (forall env' m . (HasP2PEnv env' m r t rmsg pmsg) => pmsg -> m Status)
class HasPSGlobalHandler env m r t rmsg pmsg | env -> m r t rmsg where
psGlobalHandler :: env -> (pmsg -> m Status)
instance HasPSGlobalHandler (P2PEnv r t rmsg pmsg) r t rmsg pmsg where
instance HasPSGlobalHandler (P2PEnv m r t rmsg pmsg) m r t rmsg pmsg where
psGlobalHandler = psHandler
class (HasSecretKey m) => HasNodeEndpoint m where
......@@ -130,7 +130,7 @@ data Handlers = Handlers {
, pubsub :: forall env m r t rmsg pmsg. (HasP2PEnv env m r t rmsg pmsg, MonadIO m) => NodeId -> PubSub -> ByteString -> m ByteString
}
instance HasNetworkConfig (P2PEnv r t rmsg pmsg) NetworkConfig where
instance HasNetworkConfig (P2PEnv m r t rmsg pmsg) NetworkConfig where
networkConfig f p2p =
fmap
(\nc ->
......@@ -140,19 +140,19 @@ instance HasNetworkConfig (P2PEnv r t rmsg pmsg) NetworkConfig where
})
(f ((Arivi.P2P.P2PEnv._networkConfig . nodeEndpointEnv) p2p))
instance HasTopics (P2PEnv r t rmsg pmsg) t where
instance HasTopics (P2PEnv m r t rmsg pmsg) t where
topics = pubSubTopics . psEnv
instance HasSubscribers (P2PEnv r t rmsg pmsg) t where
instance HasSubscribers (P2PEnv m r t rmsg pmsg) t where
subscribers = pubSubSubscribers . psEnv
instance HasNotifiers (P2PEnv r t rmsg pmsg) t where
instance HasNotifiers (P2PEnv m r t rmsg pmsg) t where
notifiers = pubSubNotifiers . psEnv
instance HasInbox (P2PEnv r t rmsg pmsg) pmsg where
instance HasInbox (P2PEnv m r t rmsg pmsg) pmsg where
inbox = pubSubInbox . psEnv
instance HasCache (P2PEnv r t rmsg pmsg) pmsg where
instance HasCache (P2PEnv m r t rmsg pmsg) pmsg where
cache = pubSubCache . psEnv
instance HasPubSubEnv (P2PEnv r t rmsg pmsg) t pmsg where
instance HasPubSubEnv (P2PEnv m r t rmsg pmsg) t pmsg where
pubSubEnv = psEnv
instance HasRpcEnv (P2PEnv r t rmsg pmsg) r rmsg where
instance HasRpcEnv (P2PEnv m r t rmsg pmsg) r rmsg where
rpcEnv = rEnv
......@@ -26,11 +26,10 @@ mkP2PEnv ::
(Ord t, Hashable t, Ord r, Hashable r)
=> Config.Config
-> ResourceHandler rmsg
-> (forall env m. (HasP2PEnv env m r t rmsg pmsg) =>
pmsg -> m Status)
-> (pmsg -> m Status)
-> [r]
-> [t]
-> IO (P2PEnv r t rmsg pmsg)
-> IO (P2PEnv m r t rmsg pmsg)
mkP2PEnv config rh psH resources topics = do
let nc =
NetworkConfig
......
......@@ -6,6 +6,9 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
module Main
( module Main
......@@ -25,8 +28,11 @@ import Arivi.P2P.RPC.Types
import Arivi.P2P.PubSub.Types
import Control.Concurrent (threadDelay)
import Control.Monad.Base
import Control.Monad.Catch
import Control.Monad.Logger
import Control.Monad.Reader
import Control.Monad.Trans.Control
import Data.ByteString.Lazy as BSL (ByteString)
import Data.ByteString.Lazy.Char8 as BSLC (pack)
import qualified Data.HashMap.Strict as HM
......@@ -36,7 +42,20 @@ import Data.Text
import System.Directory (doesPathExist)
import System.Environment (getArgs)
type AppM = ReaderT (P2PEnv ServiceResource ServiceTopic String String) (LoggingT IO)
newtype AppM a =
AppM (ReaderT (P2PEnv AppM ServiceResource ServiceTopic String String) (LoggingT IO) a)
deriving ( Functor
, Applicative
, Monad
, MonadReader (P2PEnv AppM ServiceResource ServiceTopic String String)
, MonadIO
, MonadThrow
, MonadCatch
, MonadLogger
)
deriving instance MonadBase IO AppM
deriving instance MonadBaseControl IO AppM
instance HasNetworkEnv AppM where
getEnv = asks (ariviNetworkEnv . nodeEndpointEnv)
......@@ -62,8 +81,11 @@ instance HasPRT AppM where
getReputedVsOtherTVar = asks (tvReputedVsOther . prtEnv)
getKClosestVsRandomTVar = asks (tvKClosestVsRandom . prtEnv)
runAppM :: P2PEnv ServiceResource ServiceTopic String String-> AppM a -> LoggingT IO a
runAppM = flip runReaderT
runAppM ::
P2PEnv AppM ServiceResource ServiceTopic String String
-> AppM a
-> LoggingT IO a
runAppM env (AppM app) = runReaderT app env
defaultConfig :: FilePath -> IO ()
defaultConfig path = do
......
......@@ -78,16 +78,19 @@ executable HelloWorldApp
, yaml
, text
, bytestring
, exceptions
, cryptonite
, unordered-containers <= 0.2.9.0
, arivi-network
, network
, arivi-crypto
, memory
, transformers-base
, time
, string-conv
, directory
, mtl
, monad-control
, monad-logger
, async
, arivi-utils
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment