{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- |
-- Module      :  Network.Ethereum.Transaction
-- Copyright   :  Aleksandr Krupenkin 2016-2021
--                Roy Blankman 2018
-- License     :  Apache-2.0
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  unportable
--
-- Transaction managing utils.
--

module Network.Ethereum.Transaction where

import           Data.ByteArray             (ByteArray, convert)
import           Data.ByteString            (ByteString, empty)
import           Data.Maybe                 (fromJust, fromMaybe)
import           Data.RLP                   (packRLP, rlpEncode)
import           Data.Word                  (Word8)

import           Data.ByteArray.HexString   (toBytes)
import           Data.Solidity.Prim.Address (toHexString)
import           Network.Ethereum.Api.Types (Call (..), Quantity (unQuantity))
import           Network.Ethereum.Unit      (Shannon, toWei)

-- | Ethereum transaction packer.
--
-- Two way RLP encoding of Ethereum transaction: for unsigned and signed.
-- Packing scheme described in https://github.com/ethereum/EIPs/blob/master/EIPS/eip-155.md
encodeTransaction :: ByteArray ba
                  => Call
                  -- ^ Transaction call
                  -> Integer
                  -- ^ Chain ID
                  -> Maybe (Integer, Integer, Word8)
                  -- ^ Should contain signature when transaction signed
                  -> ba
                  -- ^ RLP encoded transaction
encodeTransaction :: Call -> Integer -> Maybe (Integer, Integer, Word8) -> ba
encodeTransaction Call{Maybe HexString
Maybe Address
Maybe Quantity
callNonce :: Call -> Maybe Quantity
callData :: Call -> Maybe HexString
callValue :: Call -> Maybe Quantity
callGasPrice :: Call -> Maybe Quantity
callGas :: Call -> Maybe Quantity
callTo :: Call -> Maybe Address
callFrom :: Call -> Maybe Address
callNonce :: Maybe Quantity
callData :: Maybe HexString
callValue :: Maybe Quantity
callGasPrice :: Maybe Quantity
callGas :: Maybe Quantity
callTo :: Maybe Address
callFrom :: Maybe Address
..} Integer
chain_id Maybe (Integer, Integer, Word8)
rsv =
    let (ByteString
to       :: ByteString) = ByteString
-> (Address -> ByteString) -> Maybe Address -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
forall a. Monoid a => a
mempty (HexString -> ByteString
forall ba. ByteArray ba => HexString -> ba
toBytes (HexString -> ByteString)
-> (Address -> HexString) -> Address -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> HexString
toHexString) Maybe Address
callTo
        (Integer
value    :: Integer)    = Quantity -> Integer
unQuantity (Quantity -> Integer) -> Quantity -> Integer
forall a b. (a -> b) -> a -> b
$ Maybe Quantity -> Quantity
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Quantity
callValue
        (Integer
nonce    :: Integer)    = Quantity -> Integer
unQuantity (Quantity -> Integer) -> Quantity -> Integer
forall a b. (a -> b) -> a -> b
$ Maybe Quantity -> Quantity
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Quantity
callNonce
        (Integer
gasPrice :: Integer)    = Integer -> (Quantity -> Integer) -> Maybe Quantity -> Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Integer
defaultGasPrice Quantity -> Integer
unQuantity Maybe Quantity
callGasPrice
        (Integer
gasLimit :: Integer)    = Quantity -> Integer
unQuantity (Quantity -> Integer) -> Quantity -> Integer
forall a b. (a -> b) -> a -> b
$ Maybe Quantity -> Quantity
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Quantity
callGas
        (ByteString
input    :: ByteString) = HexString -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (HexString -> ByteString) -> HexString -> ByteString
forall a b. (a -> b) -> a -> b
$ HexString -> Maybe HexString -> HexString
forall a. a -> Maybe a -> a
fromMaybe HexString
forall a. Monoid a => a
mempty Maybe HexString
callData

    in ByteString -> ba
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (ByteString -> ba) -> (RLPObject -> ByteString) -> RLPObject -> ba
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RLPObject -> ByteString
packRLP (RLPObject -> ba) -> RLPObject -> ba
forall a b. (a -> b) -> a -> b
$ case Maybe (Integer, Integer, Word8)
rsv of
        -- Unsigned transaction by EIP155
        Maybe (Integer, Integer, Word8)
Nothing        -> (Integer, Integer, Integer, ByteString, Integer, ByteString,
 Integer, ByteString, ByteString)
-> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode (Integer
nonce, Integer
gasPrice, Integer
gasLimit, ByteString
to, Integer
value, ByteString
input, Integer
chain_id, ByteString
empty, ByteString
empty)
        -- Signed transaction
        Just (Integer
r, Integer
s, Word8
v) ->
            let v' :: Integer
v' = Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
8 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
chain_id  -- Improved 'v' according to EIP155
             in (Integer, Integer, Integer, ByteString, Integer, ByteString,
 Integer, Integer, Integer)
-> RLPObject
forall a. RLPEncodable a => a -> RLPObject
rlpEncode (Integer
nonce, Integer
gasPrice, Integer
gasLimit, ByteString
to, Integer
value, ByteString
input, Integer
v', Integer
r, Integer
s)
  where
    defaultGasPrice :: Integer
defaultGasPrice = Shannon -> Integer
forall a b. (Unit a, Integral b) => a -> b
toWei (Shannon
10 :: Shannon)