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

-- |
-- Module      :  Network.Ethereum.Account.LocalKey
-- Copyright   :  Aleksandr Krupenkin 2016-2021
--                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
/= :: LocalKey -> LocalKey -> Bool
$c/= :: LocalKey -> LocalKey -> Bool
== :: LocalKey -> LocalKey -> Bool
$c== :: 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
showList :: [LocalKey] -> ShowS
$cshowList :: [LocalKey] -> ShowS
show :: LocalKey -> String
$cshow :: LocalKey -> String
showsPrec :: Int -> LocalKey -> ShowS
$cshowsPrec :: Int -> 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 :: LocalKey -> LocalKeyAccount m b -> m b
withAccount LocalKey
a =
        ((b, CallParam LocalKey) -> b) -> m (b, CallParam LocalKey) -> 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 :: args -> LocalKeyAccount m TxReceipt
send (args
args :: a) = do
        CallParam{Integer
Maybe Integer
Maybe Address
DefaultBlock
LocalKey
_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 :: LocalKey
_block :: DefaultBlock
_gasPrice :: Maybe Integer
_gasLimit :: Maybe Integer
_value :: Integer
_to :: Maybe Address
..} <- 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 (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 :: Maybe Address
callFrom  = Address -> Maybe Address
forall a. a -> Maybe a
Just Address
address
                       , callNonce :: Maybe Quantity
callNonce = Quantity -> Maybe Quantity
forall a. a -> Maybe a
Just Quantity
nonce
                       , 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
convert Bytes
dat }

        Call
params' <- case Call -> Maybe Quantity
callGas Call
params of
            Just Quantity
_  -> Call -> AccountT LocalKey m Call
forall (m :: * -> *) a. Monad m => a -> m a
return Call
params
            Maybe Quantity
Nothing -> do
                Quantity
gasLimit <- m Quantity -> AccountT LocalKey m Quantity
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 (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 :: Maybe Quantity
callGas = Quantity -> Maybe Quantity
forall a. a -> Maybe a
Just Quantity
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 TxReceipt -> LocalKeyAccount m TxReceipt
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m TxReceipt -> LocalKeyAccount m TxReceipt)
-> m TxReceipt -> LocalKeyAccount m TxReceipt
forall a b. (a -> b) -> a -> b
$ 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
=<< HexString -> m HexString
forall (m :: * -> *). JsonRpc m => HexString -> m HexString
Eth.sendRawTransaction HexString
signed

    call :: args -> LocalKeyAccount m result
call (args
args :: a) = do
        CallParam{Integer
Maybe Integer
Maybe Address
DefaultBlock
LocalKey
_account :: LocalKey
_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
..} <- 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 :: 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
convert Bytes
dat }

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