{-# LANGUAGE TemplateHaskell #-}
module Tendermint.SDK.Types.TxResult where

import           Control.Lens                           (Iso', iso)
import           Control.Lens.TH                        (makeLenses)
import           Data.ByteArray.Base64String            (Base64String)
import           Data.Default.Class                     (Default (..))
import           Data.Int                               (Int64)
import           Data.Text                              (Text)
import           Data.Word                              (Word32)
import           Network.ABCI.Types.Messages.FieldTypes (Event, WrappedVal (..))
import qualified Network.ABCI.Types.Messages.Response   as Response

-- | This type represents a common transaction result for the CheckTx
-- | and DeliverTx abci-messages.
data TxResult = TxResult
  { TxResult -> Base64String
_txResultData      :: Base64String
  , TxResult -> Text
_txResultInfo      :: Text
  , TxResult -> Int64
_txResultGasWanted :: Int64
  , TxResult -> Int64
_txResultGasUsed   :: Int64
  , TxResult -> [Event]
_txResultEvents    :: [Event]
  , TxResult -> Word32
_txResultCode      :: Word32
  , TxResult -> Text
_txResultLog       :: Text
  , TxResult -> Text
_txResultCodespace :: Text
  } deriving Int -> TxResult -> ShowS
[TxResult] -> ShowS
TxResult -> String
(Int -> TxResult -> ShowS)
-> (TxResult -> String) -> ([TxResult] -> ShowS) -> Show TxResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxResult] -> ShowS
$cshowList :: [TxResult] -> ShowS
show :: TxResult -> String
$cshow :: TxResult -> String
showsPrec :: Int -> TxResult -> ShowS
$cshowsPrec :: Int -> TxResult -> ShowS
Show

makeLenses ''TxResult

instance Default TxResult where
  def :: TxResult
def = TxResult :: Base64String
-> Text
-> Int64
-> Int64
-> [Event]
-> Word32
-> Text
-> Text
-> TxResult
TxResult
    { _txResultData :: Base64String
_txResultData = ""
    , _txResultInfo :: Text
_txResultInfo = ""
    , _txResultGasWanted :: Int64
_txResultGasWanted = 0
    , _txResultGasUsed :: Int64
_txResultGasUsed  = 0
    , _txResultEvents :: [Event]
_txResultEvents   = []
    , _txResultCode :: Word32
_txResultCode = 0
    , _txResultLog :: Text
_txResultLog = ""
    , _txResultCodespace :: Text
_txResultCodespace = ""
    }

-- | This class is used to set the 'TxResult' data into the appropriate
-- | response fields for the CheckTx abci-message.
checkTxTxResult :: Iso' Response.CheckTx TxResult
checkTxTxResult :: p TxResult (f TxResult) -> p CheckTx (f CheckTx)
checkTxTxResult = (CheckTx -> TxResult)
-> (TxResult -> CheckTx) -> Iso CheckTx CheckTx TxResult TxResult
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso CheckTx -> TxResult
g TxResult -> CheckTx
s
  where
    g :: CheckTx -> TxResult
g Response.CheckTx{..} = TxResult :: Base64String
-> Text
-> Int64
-> Int64
-> [Event]
-> Word32
-> Text
-> Text
-> TxResult
TxResult
      { _txResultData :: Base64String
_txResultData = Base64String
checkTxData
      , _txResultInfo :: Text
_txResultInfo = Text
checkTxInfo
      , _txResultGasWanted :: Int64
_txResultGasWanted = WrappedVal Int64 -> Int64
forall a. WrappedVal a -> a
unWrappedVal WrappedVal Int64
checkTxGasWanted
      , _txResultGasUsed :: Int64
_txResultGasUsed = WrappedVal Int64 -> Int64
forall a. WrappedVal a -> a
unWrappedVal WrappedVal Int64
checkTxGasUsed
      , _txResultEvents :: [Event]
_txResultEvents = [Event]
checkTxEvents
      , _txResultCode :: Word32
_txResultCode = Word32
checkTxCode
      , _txResultLog :: Text
_txResultLog = Text
checkTxLog
      , _txResultCodespace :: Text
_txResultCodespace = Text
checkTxCodespace
      }
    s :: TxResult -> CheckTx
s TxResult{..} = CheckTx :: Word32
-> Base64String
-> Text
-> Text
-> WrappedVal Int64
-> WrappedVal Int64
-> [Event]
-> Text
-> CheckTx
Response.CheckTx
      { checkTxData :: Base64String
Response.checkTxData = Base64String
_txResultData
      , checkTxInfo :: Text
Response.checkTxInfo  = Text
_txResultInfo
      , checkTxGasWanted :: WrappedVal Int64
Response.checkTxGasWanted = Int64 -> WrappedVal Int64
forall a. a -> WrappedVal a
WrappedVal Int64
_txResultGasWanted
      , checkTxGasUsed :: WrappedVal Int64
Response.checkTxGasUsed = Int64 -> WrappedVal Int64
forall a. a -> WrappedVal a
WrappedVal Int64
_txResultGasUsed
      , checkTxEvents :: [Event]
Response.checkTxEvents = [Event]
_txResultEvents
      , checkTxCode :: Word32
Response.checkTxCode = Word32
_txResultCode
      , checkTxCodespace :: Text
Response.checkTxCodespace = Text
_txResultCodespace
      , checkTxLog :: Text
Response.checkTxLog = Text
_txResultLog
      }

-- | This class is used to set the 'TxResult' data into the appropriate
-- | response fields for the DeliverTx abci-message.
deliverTxTxResult :: Iso' Response.DeliverTx TxResult
deliverTxTxResult :: p TxResult (f TxResult) -> p DeliverTx (f DeliverTx)
deliverTxTxResult = (DeliverTx -> TxResult)
-> (TxResult -> DeliverTx)
-> Iso DeliverTx DeliverTx TxResult TxResult
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso DeliverTx -> TxResult
g TxResult -> DeliverTx
s
  where
    g :: DeliverTx -> TxResult
g Response.DeliverTx{..} = TxResult :: Base64String
-> Text
-> Int64
-> Int64
-> [Event]
-> Word32
-> Text
-> Text
-> TxResult
TxResult
      { _txResultData :: Base64String
_txResultData = Base64String
deliverTxData
      , _txResultInfo :: Text
_txResultInfo = Text
deliverTxInfo
      , _txResultGasWanted :: Int64
_txResultGasWanted = WrappedVal Int64 -> Int64
forall a. WrappedVal a -> a
unWrappedVal WrappedVal Int64
deliverTxGasWanted
      , _txResultGasUsed :: Int64
_txResultGasUsed = WrappedVal Int64 -> Int64
forall a. WrappedVal a -> a
unWrappedVal WrappedVal Int64
deliverTxGasUsed
      , _txResultEvents :: [Event]
_txResultEvents = [Event]
deliverTxEvents
      , _txResultCode :: Word32
_txResultCode = Word32
deliverTxCode
      , _txResultLog :: Text
_txResultLog = Text
deliverTxLog
      , _txResultCodespace :: Text
_txResultCodespace = Text
deliverTxCodespace
      }
    s :: TxResult -> DeliverTx
s TxResult{..} = DeliverTx :: Word32
-> Base64String
-> Text
-> Text
-> WrappedVal Int64
-> WrappedVal Int64
-> [Event]
-> Text
-> DeliverTx
Response.DeliverTx
      { deliverTxData :: Base64String
Response.deliverTxData = Base64String
_txResultData
      , deliverTxInfo :: Text
Response.deliverTxInfo  = Text
_txResultInfo
      , deliverTxGasWanted :: WrappedVal Int64
Response.deliverTxGasWanted = Int64 -> WrappedVal Int64
forall a. a -> WrappedVal a
WrappedVal Int64
_txResultGasWanted
      , deliverTxGasUsed :: WrappedVal Int64
Response.deliverTxGasUsed = Int64 -> WrappedVal Int64
forall a. a -> WrappedVal a
WrappedVal Int64
_txResultGasUsed
      , deliverTxEvents :: [Event]
Response.deliverTxEvents = [Event]
_txResultEvents
      , deliverTxCode :: Word32
Response.deliverTxCode = Word32
_txResultCode
      , deliverTxCodespace :: Text
Response.deliverTxCodespace = Text
_txResultCodespace
      , deliverTxLog :: Text
Response.deliverTxLog = Text
_txResultLog
      }