{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RecordWildCards            #-}

-- |
-- Module      :  Network.Web3.Provider
-- Copyright   :  Aleksandr Krupenkin 2016-2021
-- License     :  Apache-2.0
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  portable
--
-- Web3 service provider.
--

module Network.Web3.Provider where

import           Control.Concurrent.Async   (Async, async)
import           Control.Exception          (Exception, try)
import           Control.Monad.Catch        (MonadThrow)
import           Control.Monad.Fail         (MonadFail)
import           Control.Monad.IO.Class     (MonadIO (..))
import           Control.Monad.State        (MonadState (..))
import           Control.Monad.Trans.State  (StateT, evalStateT, withStateT)
import           Data.Default               (Default (..))
import           Data.Text                  (Text)
import           GHC.Generics               (Generic)
import           Network.HTTP.Client        (Manager)
import           Network.JsonRpc.TinyClient (JsonRpc, JsonRpcClient (..),
                                             defaultSettings, jsonRpcManager)
import qualified Network.Socket             as S
import qualified Network.WebSockets         as WS (Connection,
                                                   defaultConnectionOptions,
                                                   newClientConnection,
                                                   sendClose)
import qualified Network.WebSockets.Stream  as Stream

-- | Any communication with node wrapped with 'Web3' monad
newtype Web3 a = Web3 { Web3 a -> StateT JsonRpcClient IO a
unWeb3 :: StateT JsonRpcClient IO a }
    deriving (a -> Web3 b -> Web3 a
(a -> b) -> Web3 a -> Web3 b
(forall a b. (a -> b) -> Web3 a -> Web3 b)
-> (forall a b. a -> Web3 b -> Web3 a) -> Functor Web3
forall a b. a -> Web3 b -> Web3 a
forall a b. (a -> b) -> Web3 a -> Web3 b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Web3 b -> Web3 a
$c<$ :: forall a b. a -> Web3 b -> Web3 a
fmap :: (a -> b) -> Web3 a -> Web3 b
$cfmap :: forall a b. (a -> b) -> Web3 a -> Web3 b
Functor, Functor Web3
a -> Web3 a
Functor Web3
-> (forall a. a -> Web3 a)
-> (forall a b. Web3 (a -> b) -> Web3 a -> Web3 b)
-> (forall a b c. (a -> b -> c) -> Web3 a -> Web3 b -> Web3 c)
-> (forall a b. Web3 a -> Web3 b -> Web3 b)
-> (forall a b. Web3 a -> Web3 b -> Web3 a)
-> Applicative Web3
Web3 a -> Web3 b -> Web3 b
Web3 a -> Web3 b -> Web3 a
Web3 (a -> b) -> Web3 a -> Web3 b
(a -> b -> c) -> Web3 a -> Web3 b -> Web3 c
forall a. a -> Web3 a
forall a b. Web3 a -> Web3 b -> Web3 a
forall a b. Web3 a -> Web3 b -> Web3 b
forall a b. Web3 (a -> b) -> Web3 a -> Web3 b
forall a b c. (a -> b -> c) -> Web3 a -> Web3 b -> Web3 c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Web3 a -> Web3 b -> Web3 a
$c<* :: forall a b. Web3 a -> Web3 b -> Web3 a
*> :: Web3 a -> Web3 b -> Web3 b
$c*> :: forall a b. Web3 a -> Web3 b -> Web3 b
liftA2 :: (a -> b -> c) -> Web3 a -> Web3 b -> Web3 c
$cliftA2 :: forall a b c. (a -> b -> c) -> Web3 a -> Web3 b -> Web3 c
<*> :: Web3 (a -> b) -> Web3 a -> Web3 b
$c<*> :: forall a b. Web3 (a -> b) -> Web3 a -> Web3 b
pure :: a -> Web3 a
$cpure :: forall a. a -> Web3 a
$cp1Applicative :: Functor Web3
Applicative, Applicative Web3
a -> Web3 a
Applicative Web3
-> (forall a b. Web3 a -> (a -> Web3 b) -> Web3 b)
-> (forall a b. Web3 a -> Web3 b -> Web3 b)
-> (forall a. a -> Web3 a)
-> Monad Web3
Web3 a -> (a -> Web3 b) -> Web3 b
Web3 a -> Web3 b -> Web3 b
forall a. a -> Web3 a
forall a b. Web3 a -> Web3 b -> Web3 b
forall a b. Web3 a -> (a -> Web3 b) -> Web3 b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Web3 a
$creturn :: forall a. a -> Web3 a
>> :: Web3 a -> Web3 b -> Web3 b
$c>> :: forall a b. Web3 a -> Web3 b -> Web3 b
>>= :: Web3 a -> (a -> Web3 b) -> Web3 b
$c>>= :: forall a b. Web3 a -> (a -> Web3 b) -> Web3 b
$cp1Monad :: Applicative Web3
Monad, Monad Web3
Monad Web3 -> (forall a. IO a -> Web3 a) -> MonadIO Web3
IO a -> Web3 a
forall a. IO a -> Web3 a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> Web3 a
$cliftIO :: forall a. IO a -> Web3 a
$cp1MonadIO :: Monad Web3
MonadIO, Monad Web3
e -> Web3 a
Monad Web3
-> (forall e a. Exception e => e -> Web3 a) -> MonadThrow Web3
forall e a. Exception e => e -> Web3 a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> Web3 a
$cthrowM :: forall e a. Exception e => e -> Web3 a
$cp1MonadThrow :: Monad Web3
MonadThrow, Monad Web3
Monad Web3 -> (forall a. String -> Web3 a) -> MonadFail Web3
String -> Web3 a
forall a. String -> Web3 a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> Web3 a
$cfail :: forall a. String -> Web3 a
$cp1MonadFail :: Monad Web3
MonadFail, MonadState JsonRpcClient)

instance JsonRpc Web3

-- | Some peace of error response
data Web3Error = JsonRpcFail !String
    | ParserFail !String
    | UserFail !String
    deriving (Int -> Web3Error -> ShowS
[Web3Error] -> ShowS
Web3Error -> String
(Int -> Web3Error -> ShowS)
-> (Web3Error -> String)
-> ([Web3Error] -> ShowS)
-> Show Web3Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Web3Error] -> ShowS
$cshowList :: [Web3Error] -> ShowS
show :: Web3Error -> String
$cshow :: Web3Error -> String
showsPrec :: Int -> Web3Error -> ShowS
$cshowsPrec :: Int -> Web3Error -> ShowS
Show, Web3Error -> Web3Error -> Bool
(Web3Error -> Web3Error -> Bool)
-> (Web3Error -> Web3Error -> Bool) -> Eq Web3Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Web3Error -> Web3Error -> Bool
$c/= :: Web3Error -> Web3Error -> Bool
== :: Web3Error -> Web3Error -> Bool
$c== :: Web3Error -> Web3Error -> Bool
Eq, (forall x. Web3Error -> Rep Web3Error x)
-> (forall x. Rep Web3Error x -> Web3Error) -> Generic Web3Error
forall x. Rep Web3Error x -> Web3Error
forall x. Web3Error -> Rep Web3Error x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Web3Error x -> Web3Error
$cfrom :: forall x. Web3Error -> Rep Web3Error x
Generic)

instance Exception Web3Error

--TODO: Change to `HttpProvider ServerUri | IpcProvider FilePath` to support IPC
-- | Web3 Provider
data Provider = HttpProvider String
    | WsProvider String Int
    deriving (Int -> Provider -> ShowS
[Provider] -> ShowS
Provider -> String
(Int -> Provider -> ShowS)
-> (Provider -> String) -> ([Provider] -> ShowS) -> Show Provider
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Provider] -> ShowS
$cshowList :: [Provider] -> ShowS
show :: Provider -> String
$cshow :: Provider -> String
showsPrec :: Int -> Provider -> ShowS
$cshowsPrec :: Int -> Provider -> ShowS
Show, Provider -> Provider -> Bool
(Provider -> Provider -> Bool)
-> (Provider -> Provider -> Bool) -> Eq Provider
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Provider -> Provider -> Bool
$c/= :: Provider -> Provider -> Bool
== :: Provider -> Provider -> Bool
$c== :: Provider -> Provider -> Bool
Eq, (forall x. Provider -> Rep Provider x)
-> (forall x. Rep Provider x -> Provider) -> Generic Provider
forall x. Rep Provider x -> Provider
forall x. Provider -> Rep Provider x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Provider x -> Provider
$cfrom :: forall x. Provider -> Rep Provider x
Generic)

-- | Default Provider URI
instance Default Provider where
  def :: Provider
def = String -> Provider
HttpProvider String
"http://localhost:8545"

-- | 'Web3' monad runner, using the supplied Manager
runWeb3With :: MonadIO m
            => Manager
            -> Provider
            -> Web3 a
            -> m (Either Web3Error a)
runWeb3With :: Manager -> Provider -> Web3 a -> m (Either Web3Error a)
runWeb3With Manager
manager Provider
provider Web3 a
f = do
    Provider -> Web3 a -> m (Either Web3Error a)
forall (m :: * -> *) a.
MonadIO m =>
Provider -> Web3 a -> m (Either Web3Error a)
runWeb3' Provider
provider Web3 :: forall a. StateT JsonRpcClient IO a -> Web3 a
Web3 { unWeb3 :: StateT JsonRpcClient IO a
unWeb3 = (JsonRpcClient -> JsonRpcClient)
-> StateT JsonRpcClient IO a -> StateT JsonRpcClient IO a
forall s (m :: * -> *) a. (s -> s) -> StateT s m a -> StateT s m a
withStateT JsonRpcClient -> JsonRpcClient
changeManager (StateT JsonRpcClient IO a -> StateT JsonRpcClient IO a)
-> StateT JsonRpcClient IO a -> StateT JsonRpcClient IO a
forall a b. (a -> b) -> a -> b
$ Web3 a -> StateT JsonRpcClient IO a
forall a. Web3 a -> StateT JsonRpcClient IO a
unWeb3 Web3 a
f}
    where
      changeManager :: JsonRpcClient -> JsonRpcClient
changeManager JsonRpcClient
jRpcClient = case JsonRpcClient
jRpcClient of
        JsonRpcHttpClient{String
Manager
jsonRpcServer :: JsonRpcClient -> String
jsonRpcServer :: String
jsonRpcManager :: Manager
jsonRpcManager :: JsonRpcClient -> Manager
..} -> JsonRpcClient
jRpcClient { jsonRpcManager :: Manager
jsonRpcManager = Manager
manager }
        JsonRpcWsClient{Connection
jsonRpcWsConnection :: JsonRpcClient -> Connection
jsonRpcWsConnection :: Connection
..}   -> JsonRpcClient
jRpcClient

-- | 'Web3' monad runner
runWeb3' :: MonadIO m
         => Provider
         -> Web3 a
         -> m (Either Web3Error a)
runWeb3' :: Provider -> Web3 a -> m (Either Web3Error a)
runWeb3' (HttpProvider String
uri) Web3 a
f = do
    JsonRpcClient
cfg <- String -> m JsonRpcClient
forall (m :: * -> *). MonadIO m => String -> m JsonRpcClient
defaultSettings String
uri
    IO (Either Web3Error a) -> m (Either Web3Error a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either Web3Error a) -> m (Either Web3Error a))
-> (Web3 a -> IO (Either Web3Error a))
-> Web3 a
-> m (Either Web3Error a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> IO (Either Web3Error a)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO a -> IO (Either Web3Error a))
-> (Web3 a -> IO a) -> Web3 a -> IO (Either Web3Error a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT JsonRpcClient IO a -> JsonRpcClient -> IO a)
-> JsonRpcClient -> StateT JsonRpcClient IO a -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT JsonRpcClient IO a -> JsonRpcClient -> IO a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT JsonRpcClient
cfg (StateT JsonRpcClient IO a -> IO a)
-> (Web3 a -> StateT JsonRpcClient IO a) -> Web3 a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Web3 a -> StateT JsonRpcClient IO a
forall a. Web3 a -> StateT JsonRpcClient IO a
unWeb3 (Web3 a -> m (Either Web3Error a))
-> Web3 a -> m (Either Web3Error a)
forall a b. (a -> b) -> a -> b
$ Web3 a
f

runWeb3' (WsProvider String
host Int
port) Web3 a
f = do
    Connection
connection <- IO Connection -> m Connection
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Connection -> m Connection) -> IO Connection -> m Connection
forall a b. (a -> b) -> a -> b
$ String -> Int -> String -> IO Connection
getConnection String
host Int
port String
"/"
    let currentClient :: JsonRpcClient
currentClient = JsonRpcWsClient :: Connection -> JsonRpcClient
JsonRpcWsClient { jsonRpcWsConnection :: Connection
jsonRpcWsConnection = Connection
connection }
    Either Web3Error a
response <- IO (Either Web3Error a) -> m (Either Web3Error a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either Web3Error a) -> m (Either Web3Error a))
-> IO (Either Web3Error a) -> m (Either Web3Error a)
forall a b. (a -> b) -> a -> b
$ IO a -> IO (Either Web3Error a)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO a -> IO (Either Web3Error a))
-> (Web3 a -> IO a) -> Web3 a -> IO (Either Web3Error a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT JsonRpcClient IO a -> JsonRpcClient -> IO a)
-> JsonRpcClient -> StateT JsonRpcClient IO a -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT JsonRpcClient IO a -> JsonRpcClient -> IO a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT JsonRpcClient
currentClient (StateT JsonRpcClient IO a -> IO a)
-> (Web3 a -> StateT JsonRpcClient IO a) -> Web3 a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Web3 a -> StateT JsonRpcClient IO a
forall a. Web3 a -> StateT JsonRpcClient IO a
unWeb3 (Web3 a -> IO (Either Web3Error a))
-> Web3 a -> IO (Either Web3Error a)
forall a b. (a -> b) -> a -> b
$ Web3 a
f
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Connection -> MethodName -> IO ()
forall a. WebSocketsData a => Connection -> a -> IO ()
WS.sendClose Connection
connection (MethodName
"Bye-" :: Text)
    Either Web3Error a -> m (Either Web3Error a)
forall (m :: * -> *) a. Monad m => a -> m a
return Either Web3Error a
response

-- | 'Web3' runner for default Http provider
runWeb3 :: MonadIO m
        => Web3 a
        -> m (Either Web3Error a)
{-# INLINE runWeb3 #-}
runWeb3 :: Web3 a -> m (Either Web3Error a)
runWeb3 = Provider -> Web3 a -> m (Either Web3Error a)
forall (m :: * -> *) a.
MonadIO m =>
Provider -> Web3 a -> m (Either Web3Error a)
runWeb3' Provider
forall a. Default a => a
def

-- | Fork 'Web3' with the same 'Provider' and 'Manager'
forkWeb3 :: Web3 a -> Web3 (Async a)
forkWeb3 :: Web3 a -> Web3 (Async a)
forkWeb3 Web3 a
f = IO (Async a) -> Web3 (Async a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Async a) -> Web3 (Async a))
-> (JsonRpcClient -> IO (Async a))
-> JsonRpcClient
-> Web3 (Async a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> IO (Async a)
forall a. IO a -> IO (Async a)
async (IO a -> IO (Async a))
-> (JsonRpcClient -> IO a) -> JsonRpcClient -> IO (Async a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT JsonRpcClient IO a -> JsonRpcClient -> IO a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (Web3 a -> StateT JsonRpcClient IO a
forall a. Web3 a -> StateT JsonRpcClient IO a
unWeb3 Web3 a
f) (JsonRpcClient -> Web3 (Async a))
-> Web3 JsonRpcClient -> Web3 (Async a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Web3 JsonRpcClient
forall s (m :: * -> *). MonadState s m => m s
get

-- | Returns a WebSocket Connection Instance
getConnection :: String           -- ^ Host
              -> Int              -- ^ Port
              -> String           -- ^ Path
              -> IO WS.Connection
{-# INLINE getConnection #-}
getConnection :: String -> Int -> String -> IO Connection
getConnection String
host Int
port String
path = do
    -- Create and connect socket
    let hints :: AddrInfo
hints = AddrInfo
S.defaultHints
                    {addrSocketType :: SocketType
S.addrSocketType = SocketType
S.Stream}

        -- Correct host and path.
        fullHost :: String
fullHost = if Int
port Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
80 then String
host else (String
host String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
port)
        path0 :: String
path0     = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
path then String
"/" else String
path

    AddrInfo
addr:[AddrInfo]
_ <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
S.getAddrInfo (AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just AddrInfo
hints) (String -> Maybe String
forall a. a -> Maybe a
Just String
host) (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
port)
    Socket
sock      <- Family -> SocketType -> ProtocolNumber -> IO Socket
S.socket (AddrInfo -> Family
S.addrFamily AddrInfo
addr) SocketType
S.Stream ProtocolNumber
S.defaultProtocol
    Socket -> SocketOption -> Int -> IO ()
S.setSocketOption Socket
sock SocketOption
S.NoDelay Int
1

    -- Connect WebSocket and run client

    Connection
res <-  ( Socket -> SockAddr -> IO ()
S.connect Socket
sock (AddrInfo -> SockAddr
S.addrAddress AddrInfo
addr) IO () -> IO Stream -> IO Stream
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
            Socket -> IO Stream
Stream.makeSocketStream Socket
sock) IO Stream -> (Stream -> IO Connection) -> IO Connection
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
              (\Stream
stream ->
                    Stream
-> String
-> String
-> ConnectionOptions
-> Headers
-> IO Connection
WS.newClientConnection Stream
stream String
fullHost
                    String
path0 ConnectionOptions
WS.defaultConnectionOptions [] )
    Connection -> IO Connection
forall (m :: * -> *) a. Monad m => a -> m a
return Connection
res