{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Network.Ethereum.Web3.Provider where
import Control.Concurrent.Async (Async, async)
import Control.Exception (Exception, try)
import Control.Monad.Catch (MonadThrow)
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Reader (MonadReader (..))
import Control.Monad.Trans.Reader (ReaderT, mapReaderT, runReaderT)
import Data.Aeson (FromJSON)
import Data.Default (Default (..))
import GHC.Generics (Generic)
import Network.HTTP.Client (Manager, newManager)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import Network.JsonRpc.TinyClient (Remote, ServerUri)
newtype Web3 a = Web3 { unWeb3 :: ReaderT (ServerUri, Manager) IO a }
deriving (Functor, Applicative, Monad, MonadIO, MonadThrow)
instance MonadReader (ServerUri, Manager) Web3 where
ask = Web3 ask
local f = Web3 . local f . unWeb3
instance FromJSON a => Remote Web3 (Web3 a)
data Web3Error
= JsonRpcFail !String
| ParserFail !String
| UserFail !String
deriving (Show, Eq, Generic)
instance Exception Web3Error
data Provider = HttpProvider ServerUri
deriving (Show, Eq, Generic)
instance Default Provider where
def = HttpProvider "http://localhost:8545"
runWeb3With :: MonadIO m => Manager -> Provider -> Web3 a -> m (Either Web3Error a)
runWeb3With manager (HttpProvider uri) f =
liftIO . try . flip runReaderT (uri, manager) . unWeb3 $ f
runWeb3' :: MonadIO m => Provider -> Web3 a -> m (Either Web3Error a)
runWeb3' provider f = do
manager <- liftIO $ newManager tlsManagerSettings
runWeb3With manager provider f
runWeb3 :: MonadIO m => Web3 a -> m (Either Web3Error a)
{-# INLINE runWeb3 #-}
runWeb3 = runWeb3' def
forkWeb3 :: Web3 a -> Web3 (Async a)
{-# INLINE forkWeb3 #-}
forkWeb3 = Web3 . mapReaderT async . unWeb3