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

-- |
-- Module      :  Network.Ethereum.Account.Default
-- Copyright   :  Aleksandr Krupenkin 2016-2021
-- 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 :: () -> DefaultAccount m b -> m b
withAccount ()
_ =
        ((b, CallParam ()) -> b) -> m (b, CallParam ()) -> 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 :: args -> DefaultAccount m TxReceipt
send (args
args :: a) = do
        Call
c <- AccountT () m Call
forall p (m :: * -> *). MonadState (CallParam p) m => m Call
getCall
        m TxReceipt -> DefaultAccount m TxReceipt
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m TxReceipt -> DefaultAccount m TxReceipt)
-> m TxReceipt -> DefaultAccount m 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 :: Maybe HexString
callData = HexString -> Maybe HexString
forall a. a -> Maybe a
Just (HexString -> Maybe HexString) -> HexString -> Maybe HexString
forall a b. (a -> b) -> a -> b
$ Bytes -> HexString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert Bytes
dat
                           , callFrom :: Maybe Address
callFrom = [Address] -> Maybe Address
forall a. [a] -> Maybe a
listToMaybe [Address]
accounts }

            Call
params' <- case Call -> Maybe Quantity
callGas Call
params of
                Just Quantity
_  -> Call -> m Call
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 (m :: * -> *) a. Monad m => a -> m a
return (Call -> m Call) -> Call -> m Call
forall a b. (a -> b) -> a -> b
$ Call
params { callGas :: Maybe Quantity
callGas = Quantity -> Maybe Quantity
forall a. a -> Maybe a
Just Quantity
gasLimit }

            HexString -> m TxReceipt
forall (m :: * -> *). JsonRpc m => HexString -> m TxReceipt
getReceipt (HexString -> m TxReceipt) -> m HexString -> m 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 :: 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 Integer
Maybe Address
()
DefaultBlock
_account :: forall p. CallParam p -> p
_block :: forall p. CallParam p -> DefaultBlock
_gasPrice :: forall p. CallParam p -> Maybe Integer
_gasLimit :: forall p. CallParam p -> Maybe Integer
_value :: forall p. CallParam p -> Integer
_to :: forall p. CallParam p -> Maybe Address
_account :: ()
_block :: DefaultBlock
_gasPrice :: Maybe Integer
_gasLimit :: Maybe Integer
_value :: Integer
_to :: Maybe Address
..} <- AccountT () m (CallParam ())
forall s (m :: * -> *). MonadState s m => m s
get
        HexString
res <- m HexString -> AccountT () m HexString
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 :: Maybe HexString
callData = HexString -> Maybe HexString
forall a. a -> Maybe a
Just (HexString -> Maybe HexString) -> HexString -> Maybe HexString
forall a b. (a -> b) -> a -> b
$ Bytes -> HexString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert Bytes
dat
                           , callFrom :: Maybe Address
callFrom = [Address] -> Maybe Address
forall a. [a] -> Maybe a
listToMaybe [Address]
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 (m :: * -> *) a. Monad m => a -> m a
return result
r
            Left String
e  -> m result -> DefaultAccount m result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TypeError -> m result
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TypeError -> m result) -> TypeError -> m result
forall a b. (a -> b) -> a -> b
$ String -> TypeError
TypeError String
e)