{-# LANGUAGE FlexibleContexts #-}

-- |
-- Module      :  Network.Ethereum.Account.Safe
-- Copyright   :  Aleksandr Krupenkin 2016-2021
-- License     :  Apache-2.0
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  unportable
--
-- Safe sending of Ethereum transaction.
--

module Network.Ethereum.Account.Safe where

import           Control.Concurrent                (threadDelay)
import           Control.Monad.IO.Class            (liftIO)
import           Control.Monad.Trans               (lift)

import           Network.Ethereum.Account.Class    (Account (send))
import           Network.Ethereum.Account.Internal (updateReceipt)
import qualified Network.Ethereum.Api.Eth          as Eth
import           Network.Ethereum.Api.Types        (TxReceipt (receiptBlockNumber))
import           Network.Ethereum.Contract.Method  (Method)
import           Network.JsonRpc.TinyClient        (JsonRpc)

-- | Safe version of 'send' function of 'Account' typeclass
-- Waiting for some blocks of transaction confirmation before return
safeSend :: (Account p t, JsonRpc m, Method args, Monad (t m))
         => Integer
         -- ^ Confirmation in blocks
         -> args
         -- ^ Contract method arguments
         -> t m TxReceipt
         -- ^ Receipt of sended transaction
safeSend :: Integer -> args -> t m TxReceipt
safeSend Integer
b args
a = m TxReceipt -> t m TxReceipt
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m TxReceipt -> t m TxReceipt)
-> (TxReceipt -> m TxReceipt) -> TxReceipt -> t m TxReceipt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxReceipt -> m TxReceipt
forall (m :: * -> *). JsonRpc m => TxReceipt -> m TxReceipt
waiting (TxReceipt -> t m TxReceipt) -> t m TxReceipt -> t m TxReceipt
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< args -> t m TxReceipt
forall a (t :: (* -> *) -> * -> *) (m :: * -> *) args.
(Account a t, JsonRpc m, Method args) =>
args -> t m TxReceipt
send args
a
  where
    waiting :: TxReceipt -> m TxReceipt
waiting TxReceipt
receipt =
        case TxReceipt -> Maybe Quantity
receiptBlockNumber TxReceipt
receipt of
            Maybe Quantity
Nothing -> do
                IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
1000000
                TxReceipt -> m TxReceipt
waiting (TxReceipt -> m TxReceipt) -> m TxReceipt -> m TxReceipt
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TxReceipt -> m TxReceipt
forall (m :: * -> *). JsonRpc m => TxReceipt -> m TxReceipt
updateReceipt TxReceipt
receipt
            Just Quantity
bn -> do
                Quantity
current <- m Quantity
forall (m :: * -> *). JsonRpc m => m Quantity
Eth.blockNumber
                if Quantity
current Quantity -> Quantity -> Quantity
forall a. Num a => a -> a -> a
- Quantity
bn Quantity -> Quantity -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer -> Quantity
forall a. Num a => Integer -> a
fromInteger Integer
b
                    then TxReceipt -> m TxReceipt
forall (m :: * -> *) a. Monad m => a -> m a
return TxReceipt
receipt
                    else do IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
1000000
                            TxReceipt -> m TxReceipt
waiting TxReceipt
receipt

-- | Count block confirmation to keep secure
-- According to Vitalik post
-- https://blog.ethereum.org/2015/09/14/on-slow-and-fast-block-times/
safeConfirmations :: Integer
safeConfirmations :: Integer
safeConfirmations = Integer
10