{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE RecordWildCards            #-}

-- |
-- Module      :  Network.Ethereum.Account.Internal
-- Copyright   :  Aleksandr Krupenkin 2016-2021
-- License     :  Apache-2.0
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  unportable
--
-- Internal types and functions of 'Account' module.
--

module Network.Ethereum.Account.Internal where

import           Control.Concurrent             (threadDelay)
import           Control.Monad.IO.Class         (liftIO)
import           Control.Monad.State.Strict     (MonadState (..), StateT (..),
                                                 withStateT)
import           Control.Monad.Trans            (MonadTrans (..))
import           Data.Default                   (Default (..))
import           Data.Maybe                     (fromMaybe)
import           Lens.Micro                     (Lens', lens)

import           Data.ByteArray.HexString       (HexString)
import           Data.Solidity.Prim             (Address)
import           Network.Ethereum.Account.Class (Account)
import qualified Network.Ethereum.Api.Eth       as Eth (getTransactionReceipt)
import           Network.Ethereum.Api.Types     (Call (..),
                                                 DefaultBlock (Latest),
                                                 TxReceipt (receiptTransactionHash))
import           Network.Ethereum.Unit          (Unit (..))
import           Network.JsonRpc.TinyClient     (JsonRpc)

-- | Account is needed to send transactions to blockchain

-- | Transaction parametrization data type
data CallParam p = CallParam
    { CallParam p -> Maybe Address
_to       :: Maybe Address
    -- ^ Transaction recepient
    , CallParam p -> Integer
_value    :: Integer
    -- ^ Transaction value
    , CallParam p -> Maybe Integer
_gasLimit :: Maybe Integer
    -- ^ Transaction gas limit
    , CallParam p -> Maybe Integer
_gasPrice :: Maybe Integer
    -- ^ Transaction gas price
    , CallParam p -> DefaultBlock
_block    :: DefaultBlock
    -- ^ Call block number
    , CallParam p -> p
_account  :: p
    -- ^ Account params to sign transaction
    } deriving CallParam p -> CallParam p -> Bool
(CallParam p -> CallParam p -> Bool)
-> (CallParam p -> CallParam p -> Bool) -> Eq (CallParam p)
forall p. Eq p => CallParam p -> CallParam p -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CallParam p -> CallParam p -> Bool
$c/= :: forall p. Eq p => CallParam p -> CallParam p -> Bool
== :: CallParam p -> CallParam p -> Bool
$c== :: forall p. Eq p => CallParam p -> CallParam p -> Bool
Eq

-- | Transaction recipient lens
to :: Lens' (CallParam p) Address
to :: (Address -> f Address) -> CallParam p -> f (CallParam p)
to = (CallParam p -> Address)
-> (CallParam p -> Address -> CallParam p)
-> Lens (CallParam p) (CallParam p) Address Address
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (Address -> Maybe Address -> Address
forall a. a -> Maybe a -> a
fromMaybe Address
forall a. Default a => a
def (Maybe Address -> Address)
-> (CallParam p -> Maybe Address) -> CallParam p -> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CallParam p -> Maybe Address
forall p. CallParam p -> Maybe Address
_to) ((CallParam p -> Address -> CallParam p)
 -> Lens (CallParam p) (CallParam p) Address Address)
-> (CallParam p -> Address -> CallParam p)
-> Lens (CallParam p) (CallParam p) Address Address
forall a b. (a -> b) -> a -> b
$ \CallParam p
a Address
b -> CallParam p
a { _to :: Maybe Address
_to = Address -> Maybe Address
forall a. a -> Maybe a
Just Address
b }

-- | Transaction value lens
value :: Unit value => Lens' (CallParam p) value
value :: Lens' (CallParam p) value
value = (CallParam p -> value)
-> (CallParam p -> value -> CallParam p)
-> Lens' (CallParam p) value
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (Integer -> value
forall a b. (Unit a, Integral b) => b -> a
fromWei (Integer -> value)
-> (CallParam p -> Integer) -> CallParam p -> value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CallParam p -> Integer
forall p. CallParam p -> Integer
_value) ((CallParam p -> value -> CallParam p)
 -> Lens' (CallParam p) value)
-> (CallParam p -> value -> CallParam p)
-> Lens' (CallParam p) value
forall a b. (a -> b) -> a -> b
$ \CallParam p
a value
b -> CallParam p
a { _value :: Integer
_value = value -> Integer
forall a b. (Unit a, Integral b) => a -> b
toWei value
b }

-- | Transaction gas limit lens
gasLimit :: Lens' (CallParam p) Integer
gasLimit :: (Integer -> f Integer) -> CallParam p -> f (CallParam p)
gasLimit = (CallParam p -> Integer)
-> (CallParam p -> Integer -> CallParam p)
-> Lens (CallParam p) (CallParam p) Integer Integer
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe Integer
forall a. Default a => a
def (Maybe Integer -> Integer)
-> (CallParam p -> Maybe Integer) -> CallParam p -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CallParam p -> Maybe Integer
forall p. CallParam p -> Maybe Integer
_gasLimit) ((CallParam p -> Integer -> CallParam p)
 -> Lens (CallParam p) (CallParam p) Integer Integer)
-> (CallParam p -> Integer -> CallParam p)
-> Lens (CallParam p) (CallParam p) Integer Integer
forall a b. (a -> b) -> a -> b
$ \CallParam p
a Integer
b -> CallParam p
a { _gasLimit :: Maybe Integer
_gasLimit = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
b }

-- | Transaction gas price lens
gasPrice :: Unit gasprice => Lens' (CallParam p) gasprice
gasPrice :: Lens' (CallParam p) gasprice
gasPrice = (CallParam p -> gasprice)
-> (CallParam p -> gasprice -> CallParam p)
-> Lens' (CallParam p) gasprice
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (Integer -> gasprice
forall a b. (Unit a, Integral b) => b -> a
fromWei (Integer -> gasprice)
-> (CallParam p -> Integer) -> CallParam p -> gasprice
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe Integer
forall a. Default a => a
def (Maybe Integer -> Integer)
-> (CallParam p -> Maybe Integer) -> CallParam p -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CallParam p -> Maybe Integer
forall p. CallParam p -> Maybe Integer
_gasPrice) ((CallParam p -> gasprice -> CallParam p)
 -> Lens' (CallParam p) gasprice)
-> (CallParam p -> gasprice -> CallParam p)
-> Lens' (CallParam p) gasprice
forall a b. (a -> b) -> a -> b
$ \CallParam p
a gasprice
b -> CallParam p
a { _gasPrice :: Maybe Integer
_gasPrice = Integer -> Maybe Integer
forall a. a -> Maybe a
Just (gasprice -> Integer
forall a b. (Unit a, Integral b) => a -> b
toWei gasprice
b) }

-- | Call execution block lens
block :: Lens' (CallParam p) DefaultBlock
block :: (DefaultBlock -> f DefaultBlock) -> CallParam p -> f (CallParam p)
block = (CallParam p -> DefaultBlock)
-> (CallParam p -> DefaultBlock -> CallParam p)
-> Lens (CallParam p) (CallParam p) DefaultBlock DefaultBlock
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CallParam p -> DefaultBlock
forall p. CallParam p -> DefaultBlock
_block ((CallParam p -> DefaultBlock -> CallParam p)
 -> Lens (CallParam p) (CallParam p) DefaultBlock DefaultBlock)
-> (CallParam p -> DefaultBlock -> CallParam p)
-> Lens (CallParam p) (CallParam p) DefaultBlock DefaultBlock
forall a b. (a -> b) -> a -> b
$ \CallParam p
a DefaultBlock
b -> CallParam p
a { _block :: DefaultBlock
_block = DefaultBlock
b }

-- | EOA params lens
account :: Lens' (CallParam p) p
account :: (p -> f p) -> CallParam p -> f (CallParam p)
account = (CallParam p -> p)
-> (CallParam p -> p -> CallParam p)
-> Lens (CallParam p) (CallParam p) p p
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens CallParam p -> p
forall p. CallParam p -> p
_account ((CallParam p -> p -> CallParam p)
 -> Lens (CallParam p) (CallParam p) p p)
-> (CallParam p -> p -> CallParam p)
-> Lens (CallParam p) (CallParam p) p p
forall a b. (a -> b) -> a -> b
$ \CallParam p
a p
b -> CallParam p
a { _account :: p
_account = p
b }

-- | Monad transformer for sending parametrized transactions from account
newtype AccountT p m a = AccountT
    { AccountT p m a -> StateT (CallParam p) m a
runAccountT :: StateT (CallParam p) m a }
  deriving (a -> AccountT p m b -> AccountT p m a
(a -> b) -> AccountT p m a -> AccountT p m b
(forall a b. (a -> b) -> AccountT p m a -> AccountT p m b)
-> (forall a b. a -> AccountT p m b -> AccountT p m a)
-> Functor (AccountT p m)
forall a b. a -> AccountT p m b -> AccountT p m a
forall a b. (a -> b) -> AccountT p m a -> AccountT p m b
forall p (m :: * -> *) a b.
Functor m =>
a -> AccountT p m b -> AccountT p m a
forall p (m :: * -> *) a b.
Functor m =>
(a -> b) -> AccountT p m a -> AccountT p m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> AccountT p m b -> AccountT p m a
$c<$ :: forall p (m :: * -> *) a b.
Functor m =>
a -> AccountT p m b -> AccountT p m a
fmap :: (a -> b) -> AccountT p m a -> AccountT p m b
$cfmap :: forall p (m :: * -> *) a b.
Functor m =>
(a -> b) -> AccountT p m a -> AccountT p m b
Functor, Functor (AccountT p m)
a -> AccountT p m a
Functor (AccountT p m)
-> (forall a. a -> AccountT p m a)
-> (forall a b.
    AccountT p m (a -> b) -> AccountT p m a -> AccountT p m b)
-> (forall a b c.
    (a -> b -> c)
    -> AccountT p m a -> AccountT p m b -> AccountT p m c)
-> (forall a b. AccountT p m a -> AccountT p m b -> AccountT p m b)
-> (forall a b. AccountT p m a -> AccountT p m b -> AccountT p m a)
-> Applicative (AccountT p m)
AccountT p m a -> AccountT p m b -> AccountT p m b
AccountT p m a -> AccountT p m b -> AccountT p m a
AccountT p m (a -> b) -> AccountT p m a -> AccountT p m b
(a -> b -> c) -> AccountT p m a -> AccountT p m b -> AccountT p m c
forall a. a -> AccountT p m a
forall a b. AccountT p m a -> AccountT p m b -> AccountT p m a
forall a b. AccountT p m a -> AccountT p m b -> AccountT p m b
forall a b.
AccountT p m (a -> b) -> AccountT p m a -> AccountT p m b
forall a b c.
(a -> b -> c) -> AccountT p m a -> AccountT p m b -> AccountT p m c
forall p (m :: * -> *). Monad m => Functor (AccountT p m)
forall p (m :: * -> *) a. Monad m => a -> AccountT p m a
forall p (m :: * -> *) a b.
Monad m =>
AccountT p m a -> AccountT p m b -> AccountT p m a
forall p (m :: * -> *) a b.
Monad m =>
AccountT p m a -> AccountT p m b -> AccountT p m b
forall p (m :: * -> *) a b.
Monad m =>
AccountT p m (a -> b) -> AccountT p m a -> AccountT p m b
forall p (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> AccountT p m a -> AccountT p m b -> AccountT p m 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
<* :: AccountT p m a -> AccountT p m b -> AccountT p m a
$c<* :: forall p (m :: * -> *) a b.
Monad m =>
AccountT p m a -> AccountT p m b -> AccountT p m a
*> :: AccountT p m a -> AccountT p m b -> AccountT p m b
$c*> :: forall p (m :: * -> *) a b.
Monad m =>
AccountT p m a -> AccountT p m b -> AccountT p m b
liftA2 :: (a -> b -> c) -> AccountT p m a -> AccountT p m b -> AccountT p m c
$cliftA2 :: forall p (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> AccountT p m a -> AccountT p m b -> AccountT p m c
<*> :: AccountT p m (a -> b) -> AccountT p m a -> AccountT p m b
$c<*> :: forall p (m :: * -> *) a b.
Monad m =>
AccountT p m (a -> b) -> AccountT p m a -> AccountT p m b
pure :: a -> AccountT p m a
$cpure :: forall p (m :: * -> *) a. Monad m => a -> AccountT p m a
$cp1Applicative :: forall p (m :: * -> *). Monad m => Functor (AccountT p m)
Applicative, Applicative (AccountT p m)
a -> AccountT p m a
Applicative (AccountT p m)
-> (forall a b.
    AccountT p m a -> (a -> AccountT p m b) -> AccountT p m b)
-> (forall a b. AccountT p m a -> AccountT p m b -> AccountT p m b)
-> (forall a. a -> AccountT p m a)
-> Monad (AccountT p m)
AccountT p m a -> (a -> AccountT p m b) -> AccountT p m b
AccountT p m a -> AccountT p m b -> AccountT p m b
forall a. a -> AccountT p m a
forall a b. AccountT p m a -> AccountT p m b -> AccountT p m b
forall a b.
AccountT p m a -> (a -> AccountT p m b) -> AccountT p m b
forall p (m :: * -> *). Monad m => Applicative (AccountT p m)
forall p (m :: * -> *) a. Monad m => a -> AccountT p m a
forall p (m :: * -> *) a b.
Monad m =>
AccountT p m a -> AccountT p m b -> AccountT p m b
forall p (m :: * -> *) a b.
Monad m =>
AccountT p m a -> (a -> AccountT p m b) -> AccountT p m 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 -> AccountT p m a
$creturn :: forall p (m :: * -> *) a. Monad m => a -> AccountT p m a
>> :: AccountT p m a -> AccountT p m b -> AccountT p m b
$c>> :: forall p (m :: * -> *) a b.
Monad m =>
AccountT p m a -> AccountT p m b -> AccountT p m b
>>= :: AccountT p m a -> (a -> AccountT p m b) -> AccountT p m b
$c>>= :: forall p (m :: * -> *) a b.
Monad m =>
AccountT p m a -> (a -> AccountT p m b) -> AccountT p m b
$cp1Monad :: forall p (m :: * -> *). Monad m => Applicative (AccountT p m)
Monad, m a -> AccountT p m a
(forall (m :: * -> *) a. Monad m => m a -> AccountT p m a)
-> MonadTrans (AccountT p)
forall p (m :: * -> *) a. Monad m => m a -> AccountT p m a
forall (m :: * -> *) a. Monad m => m a -> AccountT p m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> AccountT p m a
$clift :: forall p (m :: * -> *) a. Monad m => m a -> AccountT p m a
MonadTrans)

instance Monad m => MonadState (CallParam p) (AccountT p m) where
    get :: AccountT p m (CallParam p)
get = StateT (CallParam p) m (CallParam p) -> AccountT p m (CallParam p)
forall p (m :: * -> *) a.
StateT (CallParam p) m a -> AccountT p m a
AccountT StateT (CallParam p) m (CallParam p)
forall s (m :: * -> *). MonadState s m => m s
get
    put :: CallParam p -> AccountT p m ()
put = StateT (CallParam p) m () -> AccountT p m ()
forall p (m :: * -> *) a.
StateT (CallParam p) m a -> AccountT p m a
AccountT (StateT (CallParam p) m () -> AccountT p m ())
-> (CallParam p -> StateT (CallParam p) m ())
-> CallParam p
-> AccountT p m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CallParam p -> StateT (CallParam p) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put

-- | @withParam@ is very similar to @withStateT@ function, it's used
-- to set parameters of transaction locally and revert params after out of scope.
--
--  @
--  withAccount () $
--    withParam (to .~ tokenAddress) $
--      transfer alice 42
--  @
withParam :: Account p (AccountT p)
          => (CallParam p -> CallParam p)
          -> AccountT p m a
          -> AccountT p m a
{-# INLINE withParam #-}
withParam :: (CallParam p -> CallParam p) -> AccountT p m a -> AccountT p m a
withParam CallParam p -> CallParam p
f AccountT p m a
m = StateT (CallParam p) m a -> AccountT p m a
forall p (m :: * -> *) a.
StateT (CallParam p) m a -> AccountT p m a
AccountT (StateT (CallParam p) m a -> AccountT p m a)
-> StateT (CallParam p) m a -> AccountT p m a
forall a b. (a -> b) -> a -> b
$ (CallParam p -> CallParam p)
-> StateT (CallParam p) m a -> StateT (CallParam p) m a
forall s (m :: * -> *) a. (s -> s) -> StateT s m a -> StateT s m a
withStateT CallParam p -> CallParam p
f (StateT (CallParam p) m a -> StateT (CallParam p) m a)
-> StateT (CallParam p) m a -> StateT (CallParam p) m a
forall a b. (a -> b) -> a -> b
$ AccountT p m a -> StateT (CallParam p) m a
forall p (m :: * -> *) a.
AccountT p m a -> StateT (CallParam p) m a
runAccountT AccountT p m a
m

defaultCallParam :: a -> CallParam a
{-# INLINE defaultCallParam #-}
defaultCallParam :: a -> CallParam a
defaultCallParam = Maybe Address
-> Integer
-> Maybe Integer
-> Maybe Integer
-> DefaultBlock
-> a
-> CallParam a
forall p.
Maybe Address
-> Integer
-> Maybe Integer
-> Maybe Integer
-> DefaultBlock
-> p
-> CallParam p
CallParam Maybe Address
forall a. Default a => a
def Integer
0 Maybe Integer
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing DefaultBlock
Latest

getCall :: MonadState (CallParam p) m => m Call
getCall :: m Call
getCall = do
    CallParam{p
Integer
Maybe Integer
Maybe Address
DefaultBlock
_account :: p
_block :: DefaultBlock
_gasPrice :: Maybe Integer
_gasLimit :: Maybe Integer
_value :: Integer
_to :: Maybe Address
_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
..} <- m (CallParam p)
forall s (m :: * -> *). MonadState s m => m s
get
    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
forall a. Default a => a
def { callTo :: Maybe Address
callTo       = Maybe Address
_to
                 , callValue :: Maybe Quantity
callValue    = Quantity -> Maybe Quantity
forall a. a -> Maybe a
Just (Quantity -> Maybe Quantity) -> Quantity -> Maybe Quantity
forall a b. (a -> b) -> a -> b
$ Integer -> Quantity
forall a. Num a => Integer -> a
fromInteger Integer
_value
                 , callGas :: Maybe Quantity
callGas      = Integer -> Quantity
forall a. Num a => Integer -> a
fromInteger (Integer -> Quantity) -> Maybe Integer -> Maybe Quantity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
_gasLimit
                 , callGasPrice :: Maybe Quantity
callGasPrice = Integer -> Quantity
forall a. Num a => Integer -> a
fromInteger (Integer -> Quantity) -> Maybe Integer -> Maybe Quantity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
_gasPrice
                 }

getReceipt :: JsonRpc m => HexString -> m TxReceipt
getReceipt :: HexString -> m TxReceipt
getReceipt HexString
tx = do
    Maybe TxReceipt
mbreceipt <- HexString -> m (Maybe TxReceipt)
forall (m :: * -> *). JsonRpc m => HexString -> m (Maybe TxReceipt)
Eth.getTransactionReceipt HexString
tx
    case Maybe TxReceipt
mbreceipt of
        Just TxReceipt
receipt -> TxReceipt -> m TxReceipt
forall (m :: * -> *) a. Monad m => a -> m a
return TxReceipt
receipt
        Maybe TxReceipt
Nothing -> do
            IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
100000
            -- TODO: avoid inifinite loop
            HexString -> m TxReceipt
forall (m :: * -> *). JsonRpc m => HexString -> m TxReceipt
getReceipt HexString
tx

updateReceipt :: JsonRpc m => TxReceipt -> m TxReceipt
{-# INLINE updateReceipt #-}
updateReceipt :: TxReceipt -> m TxReceipt
updateReceipt = HexString -> m TxReceipt
forall (m :: * -> *). JsonRpc m => HexString -> m TxReceipt
getReceipt (HexString -> m TxReceipt)
-> (TxReceipt -> HexString) -> TxReceipt -> m TxReceipt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxReceipt -> HexString
receiptTransactionHash