{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE ScopedTypeVariables   #-}

-- |
-- Module      :  Network.Ethereum.Account.Default
-- Copyright   :  Aleksandr Krupenkin 2016-2024
-- License     :  Apache-2.0
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  unportable
--
-- Default node managed account (typically the first of accounts list).
--

module Network.Ethereum.Account.Default where

import           Control.Exception                 (TypeError (..))
import           Control.Monad.Catch               (throwM)
import           Control.Monad.State.Strict        (get, runStateT)
import           Control.Monad.Trans               (MonadTrans (..))
import qualified Data.ByteArray                    as BA (convert)
import           Data.Maybe                        (listToMaybe)
import           Data.Proxy                        (Proxy (..))

import           Data.Solidity.Abi.Codec           (decode, encode)
import           Network.Ethereum.Account.Class    (Account (..))
import           Network.Ethereum.Account.Internal (AccountT (..),
                                                    CallParam (..),
                                                    defaultCallParam, getCall,
                                                    getReceipt)
import qualified Network.Ethereum.Api.Eth          as Eth (accounts, call,
                                                           estimateGas,
                                                           sendTransaction)
import           Network.Ethereum.Api.Types        (Call (callData, callFrom, callGas))
import           Network.Ethereum.Contract.Method  (Method (..))

type DefaultAccount = AccountT ()

instance Account () DefaultAccount where
    withAccount :: forall (m :: * -> *) b.
JsonRpc m =>
() -> DefaultAccount m b -> m b
withAccount ()
_ =
        ((b, CallParam ()) -> b) -> m (b, CallParam ()) -> m b
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, CallParam ()) -> b
forall a b. (a, b) -> a
fst (m (b, CallParam ()) -> m b)
-> (DefaultAccount m b -> m (b, CallParam ()))
-> DefaultAccount m b
-> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT (CallParam ()) m b -> CallParam () -> m (b, CallParam ()))
-> CallParam () -> StateT (CallParam ()) m b -> m (b, CallParam ())
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT (CallParam ()) m b -> CallParam () -> m (b, CallParam ())
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (() -> CallParam ()
forall a. a -> CallParam a
defaultCallParam ()) (StateT (CallParam ()) m b -> m (b, CallParam ()))
-> (DefaultAccount m b -> StateT (CallParam ()) m b)
-> DefaultAccount m b
-> m (b, CallParam ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DefaultAccount m b -> StateT (CallParam ()) m b
forall p (m :: * -> *) a.
AccountT p m a -> StateT (CallParam p) m a
runAccountT

    send :: forall (m :: * -> *) args.
(JsonRpc m, Method args) =>
args -> DefaultAccount m (Either HexString TxReceipt)
send (args
args :: a) = do
        Call
c <- AccountT () m Call
forall p (m :: * -> *). MonadState (CallParam p) m => m Call
getCall
        Maybe Int
timeout <- CallParam () -> Maybe Int
forall p. CallParam p -> Maybe Int
_timeout (CallParam () -> Maybe Int)
-> AccountT () m (CallParam ()) -> AccountT () m (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AccountT () m (CallParam ())
forall s (m :: * -> *). MonadState s m => m s
get
        m (Either HexString TxReceipt)
-> DefaultAccount m (Either HexString TxReceipt)
forall (m :: * -> *) a. Monad m => m a -> AccountT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either HexString TxReceipt)
 -> DefaultAccount m (Either HexString TxReceipt))
-> m (Either HexString TxReceipt)
-> DefaultAccount m (Either HexString TxReceipt)
forall a b. (a -> b) -> a -> b
$ do
            [Address]
accounts <- m [Address]
forall (m :: * -> *). JsonRpc m => m [Address]
Eth.accounts
            let dat :: Bytes
dat = Proxy args -> Bytes
forall a. Method a => Proxy a -> Bytes
selector (Proxy args
forall {k} (t :: k). Proxy t
Proxy :: Proxy a) Bytes -> Bytes -> Bytes
forall a. Semigroup a => a -> a -> a
<> args -> Bytes
forall a ba. (AbiPut a, ByteArray ba) => a -> ba
encode args
args
                params :: Call
params = Call
c { callData = Just $ BA.convert dat
                           , callFrom = listToMaybe accounts }

            Call
params' <- case Call -> Maybe Quantity
callGas Call
params of
                Just Quantity
_  -> Call -> m Call
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Call
params
                Maybe Quantity
Nothing -> do
                    Quantity
gasLimit <- Call -> m Quantity
forall (m :: * -> *). JsonRpc m => Call -> m Quantity
Eth.estimateGas Call
params
                    Call -> m Call
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Call -> m Call) -> Call -> m Call
forall a b. (a -> b) -> a -> b
$ Call
params { callGas = Just gasLimit }

            Maybe Int -> HexString -> m (Either HexString TxReceipt)
forall (m :: * -> *).
JsonRpc m =>
Maybe Int -> HexString -> m (Either HexString TxReceipt)
getReceipt Maybe Int
timeout (HexString -> m (Either HexString TxReceipt))
-> m HexString -> m (Either HexString TxReceipt)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Call -> m HexString
forall (m :: * -> *). JsonRpc m => Call -> m HexString
Eth.sendTransaction Call
params'

    call :: forall (m :: * -> *) args result.
(JsonRpc m, Method args, AbiGet result) =>
args -> DefaultAccount m result
call (args
args :: a) = do
        Call
c <- AccountT () m Call
forall p (m :: * -> *). MonadState (CallParam p) m => m Call
getCall
        CallParam{Integer
Maybe Int
Maybe Integer
Maybe Address
()
DefaultBlock
_timeout :: forall p. CallParam p -> Maybe Int
_to :: Maybe Address
_value :: Integer
_gasLimit :: Maybe Integer
_gasPrice :: Maybe Integer
_block :: DefaultBlock
_account :: ()
_timeout :: Maybe Int
_to :: forall p. CallParam p -> Maybe Address
_value :: forall p. CallParam p -> Integer
_gasLimit :: forall p. CallParam p -> Maybe Integer
_gasPrice :: forall p. CallParam p -> Maybe Integer
_block :: forall p. CallParam p -> DefaultBlock
_account :: forall p. CallParam p -> p
..} <- AccountT () m (CallParam ())
forall s (m :: * -> *). MonadState s m => m s
get
        HexString
res <- m HexString -> AccountT () m HexString
forall (m :: * -> *) a. Monad m => m a -> AccountT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m HexString -> AccountT () m HexString)
-> m HexString -> AccountT () m HexString
forall a b. (a -> b) -> a -> b
$ do
            [Address]
accounts <- m [Address]
forall (m :: * -> *). JsonRpc m => m [Address]
Eth.accounts
            let dat :: Bytes
dat    = Proxy args -> Bytes
forall a. Method a => Proxy a -> Bytes
selector (Proxy args
forall {k} (t :: k). Proxy t
Proxy :: Proxy a) Bytes -> Bytes -> Bytes
forall a. Semigroup a => a -> a -> a
<> args -> Bytes
forall a ba. (AbiPut a, ByteArray ba) => a -> ba
encode args
args
                params :: Call
params = Call
c { callData = Just $ BA.convert dat
                           , callFrom = listToMaybe accounts }
            Call -> DefaultBlock -> m HexString
forall (m :: * -> *).
JsonRpc m =>
Call -> DefaultBlock -> m HexString
Eth.call Call
params DefaultBlock
_block
        case HexString -> Either String result
forall ba a.
(ByteArrayAccess ba, AbiGet a) =>
ba -> Either String a
decode HexString
res of
            Right result
r -> result -> DefaultAccount m result
forall a. a -> AccountT () m a
forall (m :: * -> *) a. Monad m => a -> m a
return result
r
            Left String
e  -> m result -> DefaultAccount m result
forall (m :: * -> *) a. Monad m => m a -> AccountT () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TypeError -> m result
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (TypeError -> m result) -> TypeError -> m result
forall a b. (a -> b) -> a -> b
$ String -> TypeError
TypeError String
e)