{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
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)
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)