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

-- |
-- Module      :  Network.Ethereum.Account.Personal
-- Copyright   :  Aleksandr Krupenkin 2016-2021
-- License     :  Apache-2.0
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  unportable
--
-- Node managed unlockable account. Typically to send transaction from this account
-- password is required.
--

module Network.Ethereum.Account.Personal where

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

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

-- | Unlockable node managed account params
data Personal = Personal
    { Personal -> Address
personalAddress    :: !Address
    , Personal -> Passphrase
personalPassphrase :: !Passphrase
    }
    deriving (Personal -> Personal -> Bool
(Personal -> Personal -> Bool)
-> (Personal -> Personal -> Bool) -> Eq Personal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Personal -> Personal -> Bool
$c/= :: Personal -> Personal -> Bool
== :: Personal -> Personal -> Bool
$c== :: Personal -> Personal -> Bool
Eq, Int -> Personal -> ShowS
[Personal] -> ShowS
Personal -> String
(Int -> Personal -> ShowS)
-> (Personal -> String) -> ([Personal] -> ShowS) -> Show Personal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Personal] -> ShowS
$cshowList :: [Personal] -> ShowS
show :: Personal -> String
$cshow :: Personal -> String
showsPrec :: Int -> Personal -> ShowS
$cshowsPrec :: Int -> Personal -> ShowS
Show)

instance Default Personal where
    def :: Personal
def = Address -> Passphrase -> Personal
Personal Address
forall a. Default a => a
def Passphrase
""

type PersonalAccount = AccountT Personal

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

    send :: args -> PersonalAccount m TxReceipt
send (args
args :: a) = do
        CallParam{Integer
Maybe Integer
Maybe Address
DefaultBlock
Personal
_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 :: Personal
_block :: DefaultBlock
_gasPrice :: Maybe Integer
_gasLimit :: Maybe Integer
_value :: Integer
_to :: Maybe Address
..} <- AccountT Personal m (CallParam Personal)
forall s (m :: * -> *). MonadState s m => m s
get
        Call
c <- AccountT Personal m Call
forall p (m :: * -> *). MonadState (CallParam p) m => m Call
getCall
        m TxReceipt -> PersonalAccount m TxReceipt
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m TxReceipt -> PersonalAccount m TxReceipt)
-> m TxReceipt -> PersonalAccount m TxReceipt
forall a b. (a -> b) -> a -> b
$ do
            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 { callFrom :: Maybe Address
callFrom = Address -> Maybe Address
forall a. a -> Maybe a
Just (Address -> Maybe Address) -> Address -> Maybe Address
forall a b. (a -> b) -> a -> b
$ Personal -> Address
personalAddress Personal
_account
                           , 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 }

            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 -> Passphrase -> m HexString
forall (m :: * -> *).
JsonRpc m =>
Call -> Passphrase -> m HexString
Personal.sendTransaction Call
params' (Personal -> Passphrase
personalPassphrase Personal
_account)

    call :: args -> PersonalAccount m result
call (args
args :: a) = do
        CallParam Personal
s <- AccountT Personal m (CallParam Personal)
forall s (m :: * -> *). MonadState s m => m s
get
        case CallParam Personal
s of
            CallParam Maybe Address
_ Integer
_ Maybe Integer
_ Maybe Integer
_ DefaultBlock
block (Personal Address
address Passphrase
_) -> do
                Call
c <- AccountT Personal m Call
forall p (m :: * -> *). MonadState (CallParam p) m => m Call
getCall
                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 { callFrom :: Maybe Address
callFrom = Address -> Maybe Address
forall a. a -> Maybe a
Just Address
address, 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 }
                HexString
res <- m HexString -> AccountT Personal m HexString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m HexString -> AccountT Personal m HexString)
-> m HexString -> AccountT Personal m HexString
forall a b. (a -> b) -> a -> b
$ 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 -> PersonalAccount m result
forall (m :: * -> *) a. Monad m => a -> m a
return result
r
                    Left String
e  -> m result -> PersonalAccount 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)