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

-- |
-- Module      :  Network.Ethereum.Account.LocalKey
-- Copyright   :  Aleksandr Krupenkin 2016-2024
--                Roy Blankman 2018
-- License     :  Apache-2.0
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  unportable
--
-- Using ECC for singing transactions locally, e.g. out of Ethereum node.
-- Transaction will send using 'eth_sendRawTransacion' JSON-RPC method.
--

module Network.Ethereum.Account.LocalKey where

import           Control.Exception                 (TypeError (..))
import           Control.Monad.Catch               (throwM)
import           Control.Monad.State.Strict        (get, runStateT)
import           Control.Monad.Trans               (lift)
import           Crypto.Ethereum                   (PrivateKey)
import           Data.ByteArray                    (convert)
import           Data.ByteString                   (empty)
import           Data.Default                      (Default (..))
import           Data.Proxy                        (Proxy (..))

import           Crypto.Ethereum                   (derivePubKey, importKey)
import           Crypto.Ethereum.Signature         (signTransaction)
import           Data.Solidity.Abi.Codec           (decode, encode)
import           Data.Solidity.Prim.Address        (fromPubKey)
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,
                                                           getTransactionCount,
                                                           sendRawTransaction)
import           Network.Ethereum.Api.Types        (Call (..))
import           Network.Ethereum.Chain            (foundation)
import           Network.Ethereum.Contract.Method  (selector)
import           Network.Ethereum.Transaction      (encodeTransaction)

-- | Local EOA params
data LocalKey = LocalKey
    { LocalKey -> PrivateKey
localKeyPrivate :: !PrivateKey
    , LocalKey -> Integer
localKeyChainId :: !Integer
    }
    deriving (LocalKey -> LocalKey -> Bool
(LocalKey -> LocalKey -> Bool)
-> (LocalKey -> LocalKey -> Bool) -> Eq LocalKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LocalKey -> LocalKey -> Bool
== :: LocalKey -> LocalKey -> Bool
$c/= :: LocalKey -> LocalKey -> Bool
/= :: LocalKey -> LocalKey -> Bool
Eq, Int -> LocalKey -> ShowS
[LocalKey] -> ShowS
LocalKey -> String
(Int -> LocalKey -> ShowS)
-> (LocalKey -> String) -> ([LocalKey] -> ShowS) -> Show LocalKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LocalKey -> ShowS
showsPrec :: Int -> LocalKey -> ShowS
$cshow :: LocalKey -> String
show :: LocalKey -> String
$cshowList :: [LocalKey] -> ShowS
showList :: [LocalKey] -> ShowS
Show)

instance Default LocalKey where
    def :: LocalKey
def = PrivateKey -> Integer -> LocalKey
LocalKey (ByteString -> PrivateKey
forall privateKey.
ByteArrayAccess privateKey =>
privateKey -> PrivateKey
importKey ByteString
empty) Integer
foundation

type LocalKeyAccount = AccountT LocalKey

instance Account LocalKey LocalKeyAccount where
    withAccount :: forall (m :: * -> *) b.
JsonRpc m =>
LocalKey -> LocalKeyAccount m b -> m b
withAccount LocalKey
a =
        ((b, CallParam LocalKey) -> b) -> m (b, CallParam LocalKey) -> 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 LocalKey) -> b
forall a b. (a, b) -> a
fst (m (b, CallParam LocalKey) -> m b)
-> (LocalKeyAccount m b -> m (b, CallParam LocalKey))
-> LocalKeyAccount m b
-> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT (CallParam LocalKey) m b
 -> CallParam LocalKey -> m (b, CallParam LocalKey))
-> CallParam LocalKey
-> StateT (CallParam LocalKey) m b
-> m (b, CallParam LocalKey)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT (CallParam LocalKey) m b
-> CallParam LocalKey -> m (b, CallParam LocalKey)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (LocalKey -> CallParam LocalKey
forall a. a -> CallParam a
defaultCallParam LocalKey
a) (StateT (CallParam LocalKey) m b -> m (b, CallParam LocalKey))
-> (LocalKeyAccount m b -> StateT (CallParam LocalKey) m b)
-> LocalKeyAccount m b
-> m (b, CallParam LocalKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalKeyAccount m b -> StateT (CallParam LocalKey) 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 -> LocalKeyAccount m (Either HexString TxReceipt)
send (args
args :: a) = do
        CallParam{Integer
Maybe Int
Maybe Integer
Maybe Address
DefaultBlock
LocalKey
_to :: Maybe Address
_value :: Integer
_gasLimit :: Maybe Integer
_gasPrice :: Maybe Integer
_block :: DefaultBlock
_account :: LocalKey
_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 LocalKey m (CallParam LocalKey)
forall s (m :: * -> *). MonadState s m => m s
get
        Call
c <- AccountT LocalKey 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
            address :: Address
address = PublicKey -> Address
fromPubKey (PrivateKey -> PublicKey
derivePubKey (PrivateKey -> PublicKey) -> PrivateKey -> PublicKey
forall a b. (a -> b) -> a -> b
$ LocalKey -> PrivateKey
localKeyPrivate LocalKey
_account)

        Quantity
nonce <- m Quantity -> AccountT LocalKey m Quantity
forall (m :: * -> *) a. Monad m => m a -> AccountT LocalKey m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Quantity -> AccountT LocalKey m Quantity)
-> m Quantity -> AccountT LocalKey m Quantity
forall a b. (a -> b) -> a -> b
$ Address -> DefaultBlock -> m Quantity
forall (m :: * -> *).
JsonRpc m =>
Address -> DefaultBlock -> m Quantity
Eth.getTransactionCount Address
address DefaultBlock
_block
        let params :: Call
params = Call
c { callFrom  = Just address
                       , callNonce = Just nonce
                       , callData  = Just $ convert dat }

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

        let packer :: Maybe (Integer, Integer, Word8) -> HexString
packer = Call -> Integer -> Maybe (Integer, Integer, Word8) -> HexString
forall ba.
ByteArray ba =>
Call -> Integer -> Maybe (Integer, Integer, Word8) -> ba
encodeTransaction Call
params' (LocalKey -> Integer
localKeyChainId LocalKey
_account)
            signed :: HexString
signed = (Maybe (Integer, Integer, Word8) -> HexString)
-> PrivateKey -> HexString
forall ba.
ByteArray ba =>
(Maybe (Integer, Integer, Word8) -> ba) -> PrivateKey -> ba
signTransaction Maybe (Integer, Integer, Word8) -> HexString
packer (LocalKey -> PrivateKey
localKeyPrivate LocalKey
_account)
        m (Either HexString TxReceipt)
-> LocalKeyAccount m (Either HexString TxReceipt)
forall (m :: * -> *) a. Monad m => m a -> AccountT LocalKey m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either HexString TxReceipt)
 -> LocalKeyAccount m (Either HexString TxReceipt))
-> m (Either HexString TxReceipt)
-> LocalKeyAccount m (Either HexString TxReceipt)
forall a b. (a -> b) -> a -> b
$ 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
=<< HexString -> m HexString
forall (m :: * -> *). JsonRpc m => HexString -> m HexString
Eth.sendRawTransaction HexString
signed

    call :: forall (m :: * -> *) args result.
(JsonRpc m, Method args, AbiGet result) =>
args -> LocalKeyAccount m result
call (args
args :: a) = do
        CallParam{Integer
Maybe Int
Maybe Integer
Maybe Address
DefaultBlock
LocalKey
_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
_to :: Maybe Address
_value :: Integer
_gasLimit :: Maybe Integer
_gasPrice :: Maybe Integer
_block :: DefaultBlock
_account :: LocalKey
_timeout :: Maybe Int
..} <- AccountT LocalKey m (CallParam LocalKey)
forall s (m :: * -> *). MonadState s m => m s
get
        Call
c <- AccountT LocalKey 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
            address :: Address
address = PublicKey -> Address
fromPubKey (PrivateKey -> PublicKey
derivePubKey (PrivateKey -> PublicKey) -> PrivateKey -> PublicKey
forall a b. (a -> b) -> a -> b
$ LocalKey -> PrivateKey
localKeyPrivate LocalKey
_account)
            params :: Call
params = Call
c { callFrom = Just address, callData = Just $ convert dat }

        HexString
res <- m HexString -> AccountT LocalKey m HexString
forall (m :: * -> *) a. Monad m => m a -> AccountT LocalKey m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m HexString -> AccountT LocalKey m HexString)
-> m HexString -> AccountT LocalKey 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 -> LocalKeyAccount m result
forall a. a -> AccountT LocalKey m a
forall (m :: * -> *) a. Monad m => a -> m a
return result
r
            Left String
e  -> m result -> LocalKeyAccount m result
forall (m :: * -> *) a. Monad m => m a -> AccountT LocalKey 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)