{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE DerivingVia         #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE PolyKinds           #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections       #-}
{-| The chain index' version of a transaction
-}
module Plutus.ChainIndex.Tx(
    ChainIndexTx(..)
    , ChainIndexTxOutputs(..)
    , ChainIndexTxOut(..)
    , ReferenceScript(..)
    , Address(..)
    , OutputDatum(..)
    , Value(..)
    , fromOnChainTx
    , txOuts
    , txOutRefs
    , txOutsWithRef
    , txOutRefMap
    , txOutRefMapForAddr
    , txRedeemersWithHash
    , validityFromChainIndex
    -- ** Lenses
    , citxTxId
    , citxInputs
    , citxOutputs
    , citxValidRange
    , citxData
    , citxRedeemers
    , citxScripts
    , citxCardanoTx
    , _InvalidTx
    , _ValidTx
    ) where

import Data.Map (Map)
import Data.Map qualified as Map
import Data.Tuple (swap)
import Ledger (CardanoTx (CardanoTx), OnChainTx (..), TxOutRef (..))
import Ledger.Address (CardanoAddress)
import Ledger.Scripts (Redeemer, RedeemerHash)
import Plutus.ChainIndex.Types
import Plutus.Contract.CardanoAPI (fromCardanoTx, setValidity)
import Plutus.Script.Utils.Scripts (redeemerHash)
import Plutus.V2.Ledger.Api (Address (..), OutputDatum (..), Value (..))

-- | Get tx outputs from tx.
txOuts :: ChainIndexTx -> [ChainIndexTxOut]
txOuts :: ChainIndexTx -> [ChainIndexTxOut]
txOuts ChainIndexTx { _citxOutputs :: ChainIndexTx -> ChainIndexTxOutputs
_citxOutputs = ValidTx [ChainIndexTxOut]
outputs }         = [ChainIndexTxOut]
outputs
txOuts ChainIndexTx { _citxOutputs :: ChainIndexTx -> ChainIndexTxOutputs
_citxOutputs = InvalidTx (Just ChainIndexTxOut
output) } = [ ChainIndexTxOut
output ]
txOuts ChainIndexTx { _citxOutputs :: ChainIndexTx -> ChainIndexTxOutputs
_citxOutputs = InvalidTx Maybe ChainIndexTxOut
Nothing }       = []

-- | Get tx output references from tx.
txOutRefs :: ChainIndexTx -> [TxOutRef]
txOutRefs :: ChainIndexTx -> [TxOutRef]
txOutRefs ChainIndexTx
tx = [ TxId -> Integer -> TxOutRef
TxOutRef (ChainIndexTx -> TxId
_citxTxId ChainIndexTx
tx) (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx) | Int
idx <- [Int
0 .. [ChainIndexTxOut] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ChainIndexTx -> [ChainIndexTxOut]
txOuts ChainIndexTx
tx) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ]

-- | Get tx output references and tx outputs from tx.
txOutsWithRef :: ChainIndexTx -> [(ChainIndexTxOut, TxOutRef)]
txOutsWithRef :: ChainIndexTx -> [(ChainIndexTxOut, TxOutRef)]
txOutsWithRef ChainIndexTx
tx = [ChainIndexTxOut] -> [TxOutRef] -> [(ChainIndexTxOut, TxOutRef)]
forall a b. [a] -> [b] -> [(a, b)]
zip (ChainIndexTx -> [ChainIndexTxOut]
txOuts ChainIndexTx
tx) (ChainIndexTx -> [TxOutRef]
txOutRefs ChainIndexTx
tx)

-- | Get 'Map' of tx outputs references to tx.
txOutRefMap :: ChainIndexTx -> Map TxOutRef (ChainIndexTxOut, ChainIndexTx)
txOutRefMap :: ChainIndexTx -> Map TxOutRef (ChainIndexTxOut, ChainIndexTx)
txOutRefMap ChainIndexTx
tx =
    (ChainIndexTxOut -> (ChainIndexTxOut, ChainIndexTx))
-> Map TxOutRef ChainIndexTxOut
-> Map TxOutRef (ChainIndexTxOut, ChainIndexTx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, ChainIndexTx
tx) (Map TxOutRef ChainIndexTxOut
 -> Map TxOutRef (ChainIndexTxOut, ChainIndexTx))
-> Map TxOutRef ChainIndexTxOut
-> Map TxOutRef (ChainIndexTxOut, ChainIndexTx)
forall a b. (a -> b) -> a -> b
$ [(TxOutRef, ChainIndexTxOut)] -> Map TxOutRef ChainIndexTxOut
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(TxOutRef, ChainIndexTxOut)] -> Map TxOutRef ChainIndexTxOut)
-> [(TxOutRef, ChainIndexTxOut)] -> Map TxOutRef ChainIndexTxOut
forall a b. (a -> b) -> a -> b
$ ((ChainIndexTxOut, TxOutRef) -> (TxOutRef, ChainIndexTxOut))
-> [(ChainIndexTxOut, TxOutRef)] -> [(TxOutRef, ChainIndexTxOut)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ChainIndexTxOut, TxOutRef) -> (TxOutRef, ChainIndexTxOut)
forall a b. (a, b) -> (b, a)
swap ([(ChainIndexTxOut, TxOutRef)] -> [(TxOutRef, ChainIndexTxOut)])
-> [(ChainIndexTxOut, TxOutRef)] -> [(TxOutRef, ChainIndexTxOut)]
forall a b. (a -> b) -> a -> b
$ ChainIndexTx -> [(ChainIndexTxOut, TxOutRef)]
txOutsWithRef ChainIndexTx
tx

-- | Get 'Map' of tx outputs from tx for a specific address.
txOutRefMapForAddr :: CardanoAddress -> ChainIndexTx -> Map TxOutRef (ChainIndexTxOut, ChainIndexTx)
txOutRefMapForAddr :: CardanoAddress
-> ChainIndexTx -> Map TxOutRef (ChainIndexTxOut, ChainIndexTx)
txOutRefMapForAddr CardanoAddress
addr ChainIndexTx
tx =
    ((ChainIndexTxOut, ChainIndexTx) -> Bool)
-> Map TxOutRef (ChainIndexTxOut, ChainIndexTx)
-> Map TxOutRef (ChainIndexTxOut, ChainIndexTx)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (CardanoAddress -> CardanoAddress -> Bool
forall a. Eq a => a -> a -> Bool
(==) CardanoAddress
addr (CardanoAddress -> Bool)
-> ((ChainIndexTxOut, ChainIndexTx) -> CardanoAddress)
-> (ChainIndexTxOut, ChainIndexTx)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainIndexTxOut -> CardanoAddress
citoAddress (ChainIndexTxOut -> CardanoAddress)
-> ((ChainIndexTxOut, ChainIndexTx) -> ChainIndexTxOut)
-> (ChainIndexTxOut, ChainIndexTx)
-> CardanoAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChainIndexTxOut, ChainIndexTx) -> ChainIndexTxOut
forall a b. (a, b) -> a
fst) (Map TxOutRef (ChainIndexTxOut, ChainIndexTx)
 -> Map TxOutRef (ChainIndexTxOut, ChainIndexTx))
-> Map TxOutRef (ChainIndexTxOut, ChainIndexTx)
-> Map TxOutRef (ChainIndexTxOut, ChainIndexTx)
forall a b. (a -> b) -> a -> b
$ ChainIndexTx -> Map TxOutRef (ChainIndexTxOut, ChainIndexTx)
txOutRefMap ChainIndexTx
tx

validityFromChainIndex :: ChainIndexTx -> TxValidity
validityFromChainIndex :: ChainIndexTx -> TxValidity
validityFromChainIndex ChainIndexTx
tx =
  case ChainIndexTx -> ChainIndexTxOutputs
_citxOutputs ChainIndexTx
tx of
    InvalidTx Maybe ChainIndexTxOut
_ -> TxValidity
TxInvalid
    ValidTx [ChainIndexTxOut]
_   -> TxValidity
TxValid

-- | Convert a 'OnChainTx' to a 'ChainIndexTx'. An invalid 'OnChainTx' will not
-- produce any 'ChainIndexTx' outputs and the collateral inputs of the
-- 'OnChainTx' will be the inputs of the 'ChainIndexTx'.
--
-- Cardano api transactions store validity internally. Our emulated blockchain stores validity outside of the transactions,
-- so we need to make sure these match up.
fromOnChainTx :: OnChainTx -> ChainIndexTx
fromOnChainTx :: OnChainTx -> ChainIndexTx
fromOnChainTx = \case
    Valid (CardanoTx Tx era
tx EraInMode era CardanoMode
era)   -> EraInMode era CardanoMode -> Tx era -> ChainIndexTx
forall era.
IsCardanoEra era =>
EraInMode era CardanoMode -> Tx era -> ChainIndexTx
fromCardanoTx EraInMode era CardanoMode
era (Tx era -> ChainIndexTx) -> Tx era -> ChainIndexTx
forall a b. (a -> b) -> a -> b
$ Bool -> Tx era -> Tx era
forall era. Bool -> Tx era -> Tx era
setValidity Bool
True Tx era
tx
    Invalid (CardanoTx Tx era
tx EraInMode era CardanoMode
era) -> EraInMode era CardanoMode -> Tx era -> ChainIndexTx
forall era.
IsCardanoEra era =>
EraInMode era CardanoMode -> Tx era -> ChainIndexTx
fromCardanoTx EraInMode era CardanoMode
era (Tx era -> ChainIndexTx) -> Tx era -> ChainIndexTx
forall a b. (a -> b) -> a -> b
$ Bool -> Tx era -> Tx era
forall era. Bool -> Tx era -> Tx era
setValidity Bool
False Tx era
tx

txRedeemersWithHash :: ChainIndexTx -> Map RedeemerHash Redeemer
txRedeemersWithHash :: ChainIndexTx -> Map RedeemerHash Redeemer
txRedeemersWithHash ChainIndexTx{Redeemers
_citxRedeemers :: ChainIndexTx -> Redeemers
_citxRedeemers :: Redeemers
_citxRedeemers} = [(RedeemerHash, Redeemer)] -> Map RedeemerHash Redeemer
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    ([(RedeemerHash, Redeemer)] -> Map RedeemerHash Redeemer)
-> [(RedeemerHash, Redeemer)] -> Map RedeemerHash Redeemer
forall a b. (a -> b) -> a -> b
$ (Redeemer -> (RedeemerHash, Redeemer))
-> [Redeemer] -> [(RedeemerHash, Redeemer)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Redeemer
r -> (Redeemer -> RedeemerHash
redeemerHash Redeemer
r, Redeemer
r))
    ([Redeemer] -> [(RedeemerHash, Redeemer)])
-> [Redeemer] -> [(RedeemerHash, Redeemer)]
forall a b. (a -> b) -> a -> b
$ Redeemers -> [Redeemer]
forall k a. Map k a -> [a]
Map.elems Redeemers
_citxRedeemers