{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Network.Ethereum.Api.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.State (MonadState (..))
import Control.Monad.Trans.State (StateT, evalStateT)
import Data.Default (Default (..))
import GHC.Generics (Generic)
import Lens.Micro.Mtl ((.=))
import Network.HTTP.Client (Manager)
import Network.JsonRpc.TinyClient (JsonRpc, JsonRpcClient,
defaultSettings, jsonRpcManager)
newtype Web3 a = Web3 { unWeb3 :: StateT JsonRpcClient IO a }
deriving (Functor, Applicative, Monad, MonadIO, MonadThrow, MonadState JsonRpcClient)
instance JsonRpc Web3
data Web3Error
= JsonRpcFail !String
| ParserFail !String
| UserFail !String
deriving (Show, Eq, Generic)
instance Exception Web3Error
data Provider = HttpProvider String
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 provider f =
runWeb3' provider $ jsonRpcManager .= manager >> f
runWeb3' :: MonadIO m
=> Provider
-> Web3 a
-> m (Either Web3Error a)
runWeb3' (HttpProvider uri) f = do
cfg <- defaultSettings uri
liftIO . try . flip evalStateT cfg . unWeb3 $ f
runWeb3 :: MonadIO m
=> Web3 a
-> m (Either Web3Error a)
{-# INLINE runWeb3 #-}
runWeb3 = runWeb3' def
forkWeb3 :: Web3 a -> Web3 (Async a)
forkWeb3 f = liftIO . async . evalStateT (unWeb3 f) =<< get