...
 
Commits (2)
......@@ -46,6 +46,7 @@ type HasP2PEnv env m r t rmsg pmsg
, HasPRT m
, MonadReader env m
, HasNetworkConfig env NetworkConfig
, HasRpcGlobalHandler env m r t rmsg pmsg
, HasPSGlobalHandler env m r t rmsg pmsg
)
......@@ -83,6 +84,7 @@ data P2PEnv m r t rmsg pmsg = P2PEnv {
, kademliaEnv :: KademliaEnv
, statsdClient :: StatsdClient
, prtEnv :: PRTEnv
, rHandler :: rmsg -> m (Maybe rmsg)
, psHandler :: pmsg -> m Status
}
......@@ -92,6 +94,12 @@ class HasPSGlobalHandler env m r t rmsg pmsg | env -> m r t rmsg where
instance HasPSGlobalHandler (P2PEnv m r t rmsg pmsg) m r t rmsg pmsg where
psGlobalHandler = psHandler
class HasRpcGlobalHandler env m r t rmsg pmsg | env -> m r t pmsg where
rpcGlobalHandler :: env -> (rmsg -> m (Maybe rmsg))
instance HasRpcGlobalHandler (P2PEnv m r t rmsg pmsg) m r t rmsg pmsg where
rpcGlobalHandler = rHandler
class (HasSecretKey m) => HasNodeEndpoint m where
getEndpointEnv :: m NodeEndpointEnv
getNetworkConfig :: m NetworkConfig
......@@ -124,7 +132,7 @@ mkPRTEnv = do
return (PRTEnv peerReputationHashTable servicesReputationHashMapTVar p2pReputationHashMapTVar reputedVsOtherTVar kClosestVsRandomTVar)
data Handlers = Handlers {
rpc :: forall env m r msg. (MonadReader env m, HasNodeEndpoint m, HasRpc env r msg, MonadIO m) => Request 'Rpc (RpcPayload r msg) -> m (Response 'Rpc (RpcPayload r msg))
rpc :: forall env m r t rmsg pmsg . (HasP2PEnv env m r t rmsg pmsg, MonadIO m) => Request 'Rpc (RpcPayload r rmsg) -> m (Response 'Rpc (RpcPayload r rmsg))
, kademlia :: forall env m r t rmsg pmsg. (HasP2PEnv env m r t rmsg pmsg) => Request 'Kademlia T.PayLoad -> m (Response 'Kademlia T.PayLoad)
, option :: forall env m r msg. (MonadReader env m, HasNodeEndpoint m, HasRpc env r msg, MonadIO m) => m (Response 'Option (Supported [r]))
, pubsub :: forall env m r t rmsg pmsg. (HasP2PEnv env m r t rmsg pmsg, MonadIO m) => NodeId -> PubSub -> ByteString -> m ByteString
......
......@@ -18,7 +18,6 @@ import Data.Set as Set
data RpcEnv r msg = RpcEnv {
rpcResourcers :: Resourcers r
, rpcHandlers :: ResourceHandler msg
}
class HasRpcEnv env r msg | env -> r msg where
......@@ -30,8 +29,7 @@ type HasRpc env r msg =
, Eq msg, Hashable msg, Serialise msg
)
mkRpc :: (Ord r, Hashable r) => ResourceHandler msg -> [r] -> IO (RpcEnv r msg)
mkRpc rh resourceList = do
mkRpc :: (Ord r, Hashable r) => [r] -> IO (RpcEnv r msg)
mkRpc resourceList = do
resTVars <- mapM (\_ -> newTVarIO Set.empty) resourceList
RpcEnv <$> pure (Resourcers (HM.fromList (zip resourceList resTVars)))
<*> pure rh
......@@ -7,6 +7,7 @@ module Arivi.P2P.RPC.Handler
, rpcHandler
) where
import Arivi.P2P.P2PEnv
import Arivi.P2P.Types
import Arivi.P2P.RPC.Types
import Arivi.P2P.RPC.Env
......@@ -14,14 +15,12 @@ import Arivi.P2P.RPC.Env
import Control.Monad.Reader
import qualified Data.HashMap.Strict as HM
rpcHandler ::
( MonadReader env m
, HasRpc env r msg, MonadIO m)
=> Request 'Rpc (RpcPayload r msg)
-> m (Response 'Rpc (RpcPayload r msg))
rpcHandler :: forall env m r t rmsg pmsg .
( HasP2PEnv env m r t rmsg pmsg)
=> Request 'Rpc (RpcPayload r rmsg)
-> m (Response 'Rpc (RpcPayload r rmsg))
rpcHandler (RpcRequest (RpcPayload resource msg)) = do
rpcRecord <- asks rpcEnv
let ResourceHandler h = rpcHandlers rpcRecord
h <- asks rpcGlobalHandler
resp <- h msg
case resp of
Just response -> return (RpcResponse (RpcPayload resource response))
......
......@@ -8,7 +8,6 @@ module Arivi.P2P.RPC.Types
import Arivi.P2P.MessageHandler.HandlerTypes (NodeId)
import Codec.Serialise (Serialise)
import Control.Concurrent.STM.TVar
import Control.Monad.IO.Class
import Data.HashMap.Strict as HM
import Data.Hashable
import Data.Set (Set)
......@@ -17,8 +16,6 @@ import GHC.Generics (Generic)
newtype Resourcers r = Resourcers (HM.HashMap r (TVar (Set NodeId)))
newtype ResourceHandler msg = ResourceHandler (forall m. (MonadIO m) => msg -> m (Maybe msg))
data Options r = Options deriving (Eq, Ord, Show, Generic, Serialise)
data Supported r = Supported r deriving(Eq, Ord, Generic, Serialise, Hashable)
......@@ -13,7 +13,6 @@ import Arivi.P2P.Kademlia.MessageHandler
import Arivi.P2P.P2PEnv
import Arivi.P2P.RPC.Handler
import Arivi.P2P.RPC.Env
import Arivi.P2P.RPC.Types
import Arivi.P2P.Types
import Arivi.Utils.Statsd
......@@ -25,7 +24,7 @@ mkHandlers = Handlers rpcHandler kademliaMessageHandler optionsHandler pubSubHan
mkP2PEnv ::
(Ord t, Hashable t, Ord r, Hashable r)
=> Config.Config
-> ResourceHandler rmsg
-> (rmsg -> m (Maybe rmsg))
-> (pmsg -> m Status)
-> [r]
-> [t]
......@@ -43,7 +42,7 @@ mkP2PEnv config rh psH resources topics = do
(read $ show $ Config.udpPort config)
(Config.secretKey config)
nep <- mkNodeEndpoint nc mkHandlers networkEnv
nrpc <- mkRpc rh resources
nrpc <- mkRpc resources
nps <- mkPubSub topics
nk <-
mkKademlia
......@@ -62,6 +61,7 @@ mkP2PEnv config rh psH resources topics = do
, kademliaEnv = nk
, statsdClient = ncsc
, prtEnv = nprt
, rHandler = rh
, psHandler = psH
}
......
......@@ -43,11 +43,11 @@ import System.Directory (doesPathExist)
import System.Environment (getArgs)
newtype AppM a =
AppM (ReaderT (P2PEnv AppM ServiceResource ServiceTopic String String) (LoggingT IO) a)
AppM (ReaderT (ServiceEnv AppM ServiceResource ServiceTopic String String) (LoggingT IO) a)
deriving ( Functor
, Applicative
, Monad
, MonadReader (P2PEnv AppM ServiceResource ServiceTopic String String)
, MonadReader (ServiceEnv AppM ServiceResource ServiceTopic String String)
, MonadIO
, MonadThrow
, MonadCatch
......@@ -58,31 +58,32 @@ deriving instance MonadBase IO AppM
deriving instance MonadBaseControl IO AppM
instance HasNetworkEnv AppM where
getEnv = asks (ariviNetworkEnv . nodeEndpointEnv)
getEnv = asks (ariviNetworkEnv . nodeEndpointEnv . p2pEnv)
instance HasSecretKey AppM
instance HasKbucket AppM where
getKb = asks (kbucket . kademliaEnv)
getKb = asks (kbucket . kademliaEnv . p2pEnv)
instance HasStatsdClient AppM where
getStatsdClient = asks statsdClient
getStatsdClient = asks (statsdClient . p2pEnv)
instance HasNodeEndpoint AppM where
getEndpointEnv = asks nodeEndpointEnv
getNetworkConfig = asks (PE._networkConfig . nodeEndpointEnv)
getHandlers = asks (handlers . nodeEndpointEnv)
getNodeIdPeerMapTVarP2PEnv = asks (tvarNodeIdPeerMap . nodeEndpointEnv)
getEndpointEnv = asks (nodeEndpointEnv . p2pEnv)
getNetworkConfig = asks (PE._networkConfig . nodeEndpointEnv . p2pEnv)
getHandlers = asks (handlers . nodeEndpointEnv . p2pEnv)
getNodeIdPeerMapTVarP2PEnv = asks (tvarNodeIdPeerMap . nodeEndpointEnv . p2pEnv)
instance HasPRT AppM where
getPeerReputationHistoryTableTVar = asks (tvPeerReputationHashTable . prtEnv)
getServicesReputationHashMapTVar = asks (tvServicesReputationHashMap . prtEnv)
getP2PReputationHashMapTVar = asks (tvP2PReputationHashMap . prtEnv)
getReputedVsOtherTVar = asks (tvReputedVsOther . prtEnv)
getKClosestVsRandomTVar = asks (tvKClosestVsRandom . prtEnv)
getPeerReputationHistoryTableTVar = asks (tvPeerReputationHashTable . prtEnv . p2pEnv)
getServicesReputationHashMapTVar = asks (tvServicesReputationHashMap . prtEnv . p2pEnv)
getP2PReputationHashMapTVar = asks (tvP2PReputationHashMap . prtEnv . p2pEnv)
getReputedVsOtherTVar = asks (tvReputedVsOther . prtEnv . p2pEnv)
getKClosestVsRandomTVar = asks (tvKClosestVsRandom . prtEnv . p2pEnv)
runAppM ::
P2PEnv AppM ServiceResource ServiceTopic String String
ServiceEnv AppM ServiceResource ServiceTopic String String
-> AppM a
-> LoggingT IO a
runAppM env (AppM app) = runReaderT app env
......@@ -108,10 +109,12 @@ defaultConfig path = do
runNode :: String -> IO ()
runNode configPath = do
config <- Config.readConfig configPath
env <- mkP2PEnv config (ResourceHandler globalHandlerRpc) globalHandlerPubSub [HelloWorld] [HelloWorldHeader]
env <- mkP2PEnv config globalHandlerRpc globalHandlerPubSub [HelloWorld] [HelloWorldHeader]
let something = SomeEnv "Hello"
let serviceEnv = ServiceEnv something env
runFileLoggingT (toS $ Config.logFile config) $
runAppM
env
serviceEnv
(do initP2P config
liftIO $ threadDelay 5000000
liftIO $ putStrLn "Publish (y/n)?"
......@@ -121,6 +124,7 @@ runNode configPath = do
else return ()
-- getHelloWorld
liftIO $ threadDelay 500000000)
return ()
main :: IO ()
main = do
......
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
module Service.HelloWorld
( module Service.HelloWorld
......@@ -11,12 +15,16 @@ import Arivi.P2P.RPC.Fetch
import Arivi.P2P.Types
import Arivi.P2P.PubSub.Types
import Arivi.P2P.PubSub.Publish
import Arivi.P2P.MessageHandler.HandlerTypes
import Arivi.P2P.PubSub.Env
import Arivi.P2P.PubSub.Class
import Arivi.P2P.RPC.Env
import GHC.Generics
import Codec.Serialise
import Control.Concurrent.Async.Lifted
import Control.Monad.IO.Class
import Control.Monad.Reader
import Data.ByteString.Lazy as Lazy
import Data.Hashable
......@@ -33,8 +41,10 @@ instance Serialise ServiceTopic
instance Hashable ServiceTopic
globalHandlerPubSub :: (HasP2PEnv env m ServiceResource ServiceTopic String String) => String -> m Status
globalHandlerPubSub msg =
globalHandlerPubSub :: (HasService env m) => String -> m Status
globalHandlerPubSub msg = do
val <- asks getSomeVal
liftIO $ print val
if msg == "HelloworldHeader"
then do
liftIO (Prelude.putStrLn "Ok")
......@@ -42,8 +52,31 @@ globalHandlerPubSub msg =
return Ok
else liftIO (Prelude.putStrLn "Error") >> return Error
globalHandlerRpc :: (MonadIO m) => String -> m (Maybe String)
globalHandlerRpc msg =
data SomeEnv = SomeEnv {
someVal :: String
} deriving(Eq, Ord, Show)
class HasSomeEnv env where
getSomeVal :: env -> SomeEnv
instance HasSomeEnv (ServiceEnv m r t rmsg pmsg) where
getSomeVal = someEnv
data ServiceEnv m r t rmsg pmsg = ServiceEnv {
someEnv :: SomeEnv
, p2pEnv :: P2PEnv m r t rmsg pmsg
}
type HasService env m =
( HasP2PEnv env m ServiceResource ServiceTopic String String
, HasSomeEnv env
, MonadReader env m
)
globalHandlerRpc :: (HasService env m) => String -> m (Maybe String)
globalHandlerRpc msg = do
val <- asks getSomeVal
liftIO $ print ((someVal val) ++ "rpc")
if msg == "HelloWorld" then return (Just (msg ++ " Praise Satoshi"))
else return Nothing
......@@ -55,3 +88,37 @@ getHelloWorld msg = do
stuffPublisher :: (HasP2PEnv env m ServiceResource ServiceTopic String String) => m ()
stuffPublisher = publish (PubSubPayload (HelloWorldHeader, "HelloworldHeader"))
instance HasNetworkConfig (ServiceEnv m r t rmsg pmsg) NetworkConfig where
networkConfig f se =
fmap
(\nc ->
se
{ p2pEnv =
(p2pEnv se)
{ nodeEndpointEnv =
(nodeEndpointEnv (p2pEnv se))
{Arivi.P2P.P2PEnv._networkConfig = nc}
}
})
(f ((Arivi.P2P.P2PEnv._networkConfig . nodeEndpointEnv . p2pEnv) se))
instance HasTopics (ServiceEnv m r t rmsg pmsg) t where
topics = pubSubTopics . psEnv . p2pEnv
instance HasSubscribers (ServiceEnv m r t rmsg pmsg) t where
subscribers = pubSubSubscribers . psEnv. p2pEnv
instance HasNotifiers (ServiceEnv m r t rmsg pmsg) t where
notifiers = pubSubNotifiers . psEnv . p2pEnv
instance HasInbox (ServiceEnv m r t rmsg pmsg) pmsg where
inbox = pubSubInbox . psEnv . p2pEnv
instance HasCache (ServiceEnv m r t rmsg pmsg) pmsg where
cache = pubSubCache . psEnv . p2pEnv
instance HasPubSubEnv (ServiceEnv m r t rmsg pmsg) t pmsg where
pubSubEnv = psEnv . p2pEnv
instance HasRpcEnv (ServiceEnv m r t rmsg pmsg) r rmsg where
rpcEnv = rEnv . p2pEnv
instance HasPSGlobalHandler (ServiceEnv m r t rmsg pmsg) m r t rmsg pmsg where
psGlobalHandler = psHandler . p2pEnv
instance HasRpcGlobalHandler (ServiceEnv m r t rmsg pmsg) m r t rmsg pmsg where
rpcGlobalHandler = rHandler . p2pEnv
\ No newline at end of file