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

-- |
-- Module      :  Network.Ethereum.Account.Personal
-- Copyright   :  Aleksandr Krupenkin 2016-2024
-- 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
$c== :: Personal -> Personal -> Bool
== :: Personal -> Personal -> Bool
$c/= :: Personal -> Personal -> Bool
/= :: 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
$cshowsPrec :: Int -> Personal -> ShowS
showsPrec :: Int -> Personal -> ShowS
$cshow :: Personal -> String
show :: Personal -> String
$cshowList :: [Personal] -> ShowS
showList :: [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 :: forall (m :: * -> *) b.
JsonRpc m =>
Personal -> PersonalAccount m b -> m b
withAccount Personal
a =
        ((b, CallParam Personal) -> b) -> m (b, CallParam Personal) -> 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 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 :: forall (m :: * -> *) args.
(JsonRpc m, Method args) =>
args -> PersonalAccount m (Either HexString TxReceipt)
send (args
args :: a) = do
        CallParam{Integer
Maybe Int
Maybe Integer
Maybe Address
DefaultBlock
Personal
_to :: Maybe Address
_value :: Integer
_gasLimit :: Maybe Integer
_gasPrice :: Maybe Integer
_block :: DefaultBlock
_account :: Personal
_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
_timeout :: forall p. CallParam p -> Maybe Int
..} <- 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 (Either HexString TxReceipt)
-> PersonalAccount m (Either HexString TxReceipt)
forall (m :: * -> *) a. Monad m => m a -> AccountT Personal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either HexString TxReceipt)
 -> PersonalAccount m (Either HexString TxReceipt))
-> m (Either HexString TxReceipt)
-> PersonalAccount m (Either HexString 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 = Just $ personalAddress _account
                           , callData = Just $ BA.convert dat }

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

    call :: forall (m :: * -> *) args result.
(JsonRpc m, Method args, AbiGet result) =>
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
_) Maybe Int
_ -> 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 = Just address, callData = Just $ BA.convert dat }
                HexString
res <- m HexString -> AccountT Personal m HexString
forall (m :: * -> *) a. Monad m => m a -> AccountT Personal m a
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 a. a -> AccountT Personal m a
forall (m :: * -> *) a. Monad m => a -> m a
return result
r
                    Left String
e  -> m result -> PersonalAccount m result
forall (m :: * -> *) a. Monad m => m a -> AccountT Personal 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)