{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Dijkstra.Tx (
  Tx (..),
  validateDijkstraNativeScript,
) where

import Cardano.Ledger.Allegra.TxBody (AllegraEraTxBody (..))
import Cardano.Ledger.Alonzo.Tx (
  AlonzoEraTx,
  AlonzoTx (..),
  alonzoTxEqRaw,
  auxDataAlonzoTxL,
  bodyAlonzoTxL,
  isValidAlonzoTxL,
  mkBasicAlonzoTx,
  sizeAlonzoTxF,
  witsAlonzoTxL,
 )
import Cardano.Ledger.Binary (Annotator, DecCBOR (..), EncCBOR, ToCBOR)
import Cardano.Ledger.Conway.Tx (AlonzoEraTx (..), Tx (..), getConwayMinFeeTx)
import Cardano.Ledger.Core
import Cardano.Ledger.Dijkstra.Era (DijkstraEra)
import Cardano.Ledger.Dijkstra.Scripts (
  DijkstraEraScript,
  DijkstraNativeScript,
  evalDijkstraNativeScript,
 )
import Cardano.Ledger.Dijkstra.TxAuxData ()
import Cardano.Ledger.Dijkstra.TxBody (DijkstraEraTxBody (..))
import Cardano.Ledger.Dijkstra.TxWits ()
import Cardano.Ledger.Keys.WitVKey (witVKeyHash)
import Cardano.Ledger.MemoBytes (EqRaw (..))
import Control.DeepSeq (NFData)
import qualified Data.Set as Set
import GHC.Generics (Generic)
import Lens.Micro (Lens', lens, (^.))
import NoThunks.Class (NoThunks)

instance EraTx DijkstraEra where
  newtype Tx DijkstraEra = MkDijkstraTx {Tx DijkstraEra -> AlonzoTx DijkstraEra
unDijkstraTx :: AlonzoTx DijkstraEra}
    deriving newtype (Tx DijkstraEra -> Tx DijkstraEra -> Bool
(Tx DijkstraEra -> Tx DijkstraEra -> Bool)
-> (Tx DijkstraEra -> Tx DijkstraEra -> Bool)
-> Eq (Tx DijkstraEra)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Tx DijkstraEra -> Tx DijkstraEra -> Bool
== :: Tx DijkstraEra -> Tx DijkstraEra -> Bool
$c/= :: Tx DijkstraEra -> Tx DijkstraEra -> Bool
/= :: Tx DijkstraEra -> Tx DijkstraEra -> Bool
Eq, Int -> Tx DijkstraEra -> ShowS
[Tx DijkstraEra] -> ShowS
Tx DijkstraEra -> String
(Int -> Tx DijkstraEra -> ShowS)
-> (Tx DijkstraEra -> String)
-> ([Tx DijkstraEra] -> ShowS)
-> Show (Tx DijkstraEra)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Tx DijkstraEra -> ShowS
showsPrec :: Int -> Tx DijkstraEra -> ShowS
$cshow :: Tx DijkstraEra -> String
show :: Tx DijkstraEra -> String
$cshowList :: [Tx DijkstraEra] -> ShowS
showList :: [Tx DijkstraEra] -> ShowS
Show, Tx DijkstraEra -> ()
(Tx DijkstraEra -> ()) -> NFData (Tx DijkstraEra)
forall a. (a -> ()) -> NFData a
$crnf :: Tx DijkstraEra -> ()
rnf :: Tx DijkstraEra -> ()
NFData, Context -> Tx DijkstraEra -> IO (Maybe ThunkInfo)
Proxy (Tx DijkstraEra) -> String
(Context -> Tx DijkstraEra -> IO (Maybe ThunkInfo))
-> (Context -> Tx DijkstraEra -> IO (Maybe ThunkInfo))
-> (Proxy (Tx DijkstraEra) -> String)
-> NoThunks (Tx DijkstraEra)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> Tx DijkstraEra -> IO (Maybe ThunkInfo)
noThunks :: Context -> Tx DijkstraEra -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Tx DijkstraEra -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Tx DijkstraEra -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (Tx DijkstraEra) -> String
showTypeOf :: Proxy (Tx DijkstraEra) -> String
NoThunks, Typeable (Tx DijkstraEra)
Typeable (Tx DijkstraEra) =>
(Tx DijkstraEra -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (Tx DijkstraEra) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [Tx DijkstraEra] -> Size)
-> ToCBOR (Tx DijkstraEra)
Tx DijkstraEra -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Tx DijkstraEra] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Tx DijkstraEra) -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: Tx DijkstraEra -> Encoding
toCBOR :: Tx DijkstraEra -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Tx DijkstraEra) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Tx DijkstraEra) -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Tx DijkstraEra] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Tx DijkstraEra] -> Size
ToCBOR, Tx DijkstraEra -> Encoding
(Tx DijkstraEra -> Encoding) -> EncCBOR (Tx DijkstraEra)
forall a. (a -> Encoding) -> EncCBOR a
$cencCBOR :: Tx DijkstraEra -> Encoding
encCBOR :: Tx DijkstraEra -> Encoding
EncCBOR)
    deriving ((forall x. Tx DijkstraEra -> Rep (Tx DijkstraEra) x)
-> (forall x. Rep (Tx DijkstraEra) x -> Tx DijkstraEra)
-> Generic (Tx DijkstraEra)
forall x. Rep (Tx DijkstraEra) x -> Tx DijkstraEra
forall x. Tx DijkstraEra -> Rep (Tx DijkstraEra) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Tx DijkstraEra -> Rep (Tx DijkstraEra) x
from :: forall x. Tx DijkstraEra -> Rep (Tx DijkstraEra) x
$cto :: forall x. Rep (Tx DijkstraEra) x -> Tx DijkstraEra
to :: forall x. Rep (Tx DijkstraEra) x -> Tx DijkstraEra
Generic)

  mkBasicTx :: TxBody DijkstraEra -> Tx DijkstraEra
mkBasicTx = AlonzoTx DijkstraEra -> Tx DijkstraEra
MkDijkstraTx (AlonzoTx DijkstraEra -> Tx DijkstraEra)
-> (TxBody DijkstraEra -> AlonzoTx DijkstraEra)
-> TxBody DijkstraEra
-> Tx DijkstraEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody DijkstraEra -> AlonzoTx DijkstraEra
forall era. Monoid (TxWits era) => TxBody era -> AlonzoTx era
mkBasicAlonzoTx

  bodyTxL :: Lens' (Tx DijkstraEra) (TxBody DijkstraEra)
bodyTxL = (AlonzoTx DijkstraEra -> f (AlonzoTx DijkstraEra))
-> Tx DijkstraEra -> f (Tx DijkstraEra)
Lens' (Tx DijkstraEra) (AlonzoTx DijkstraEra)
dijkstraTxL ((AlonzoTx DijkstraEra -> f (AlonzoTx DijkstraEra))
 -> Tx DijkstraEra -> f (Tx DijkstraEra))
-> ((TxBody DijkstraEra -> f (TxBody DijkstraEra))
    -> AlonzoTx DijkstraEra -> f (AlonzoTx DijkstraEra))
-> (TxBody DijkstraEra -> f (TxBody DijkstraEra))
-> Tx DijkstraEra
-> f (Tx DijkstraEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxBody DijkstraEra -> f (TxBody DijkstraEra))
-> AlonzoTx DijkstraEra -> f (AlonzoTx DijkstraEra)
forall era (f :: * -> *).
Functor f =>
(TxBody era -> f (TxBody era)) -> AlonzoTx era -> f (AlonzoTx era)
bodyAlonzoTxL
  {-# INLINE bodyTxL #-}

  witsTxL :: Lens' (Tx DijkstraEra) (TxWits DijkstraEra)
witsTxL = (AlonzoTx DijkstraEra -> f (AlonzoTx DijkstraEra))
-> Tx DijkstraEra -> f (Tx DijkstraEra)
Lens' (Tx DijkstraEra) (AlonzoTx DijkstraEra)
dijkstraTxL ((AlonzoTx DijkstraEra -> f (AlonzoTx DijkstraEra))
 -> Tx DijkstraEra -> f (Tx DijkstraEra))
-> ((AlonzoTxWits DijkstraEra -> f (AlonzoTxWits DijkstraEra))
    -> AlonzoTx DijkstraEra -> f (AlonzoTx DijkstraEra))
-> (AlonzoTxWits DijkstraEra -> f (AlonzoTxWits DijkstraEra))
-> Tx DijkstraEra
-> f (Tx DijkstraEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxWits DijkstraEra -> f (TxWits DijkstraEra))
-> AlonzoTx DijkstraEra -> f (AlonzoTx DijkstraEra)
(AlonzoTxWits DijkstraEra -> f (AlonzoTxWits DijkstraEra))
-> AlonzoTx DijkstraEra -> f (AlonzoTx DijkstraEra)
forall era (f :: * -> *).
Functor f =>
(TxWits era -> f (TxWits era)) -> AlonzoTx era -> f (AlonzoTx era)
witsAlonzoTxL
  {-# INLINE witsTxL #-}

  auxDataTxL :: Lens' (Tx DijkstraEra) (StrictMaybe (TxAuxData DijkstraEra))
auxDataTxL = (AlonzoTx DijkstraEra -> f (AlonzoTx DijkstraEra))
-> Tx DijkstraEra -> f (Tx DijkstraEra)
Lens' (Tx DijkstraEra) (AlonzoTx DijkstraEra)
dijkstraTxL ((AlonzoTx DijkstraEra -> f (AlonzoTx DijkstraEra))
 -> Tx DijkstraEra -> f (Tx DijkstraEra))
-> ((StrictMaybe (AlonzoTxAuxData DijkstraEra)
     -> f (StrictMaybe (AlonzoTxAuxData DijkstraEra)))
    -> AlonzoTx DijkstraEra -> f (AlonzoTx DijkstraEra))
-> (StrictMaybe (AlonzoTxAuxData DijkstraEra)
    -> f (StrictMaybe (AlonzoTxAuxData DijkstraEra)))
-> Tx DijkstraEra
-> f (Tx DijkstraEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe (TxAuxData DijkstraEra)
 -> f (StrictMaybe (TxAuxData DijkstraEra)))
-> AlonzoTx DijkstraEra -> f (AlonzoTx DijkstraEra)
(StrictMaybe (AlonzoTxAuxData DijkstraEra)
 -> f (StrictMaybe (AlonzoTxAuxData DijkstraEra)))
-> AlonzoTx DijkstraEra -> f (AlonzoTx DijkstraEra)
forall era (f :: * -> *).
Functor f =>
(StrictMaybe (TxAuxData era) -> f (StrictMaybe (TxAuxData era)))
-> AlonzoTx era -> f (AlonzoTx era)
auxDataAlonzoTxL
  {-# INLINE auxDataTxL #-}

  sizeTxF :: HasCallStack => SimpleGetter (Tx DijkstraEra) Word32
sizeTxF = (AlonzoTx DijkstraEra -> Const r (AlonzoTx DijkstraEra))
-> Tx DijkstraEra -> Const r (Tx DijkstraEra)
Lens' (Tx DijkstraEra) (AlonzoTx DijkstraEra)
dijkstraTxL ((AlonzoTx DijkstraEra -> Const r (AlonzoTx DijkstraEra))
 -> Tx DijkstraEra -> Const r (Tx DijkstraEra))
-> ((Word32 -> Const r Word32)
    -> AlonzoTx DijkstraEra -> Const r (AlonzoTx DijkstraEra))
-> (Word32 -> Const r Word32)
-> Tx DijkstraEra
-> Const r (Tx DijkstraEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Const r Word32)
-> AlonzoTx DijkstraEra -> Const r (AlonzoTx DijkstraEra)
forall era.
(HasCallStack, EraTx era) =>
SimpleGetter (AlonzoTx era) Word32
SimpleGetter (AlonzoTx DijkstraEra) Word32
sizeAlonzoTxF
  {-# INLINE sizeTxF #-}

  validateNativeScript :: Tx DijkstraEra -> NativeScript DijkstraEra -> Bool
validateNativeScript = Tx DijkstraEra -> NativeScript DijkstraEra -> Bool
forall era.
(EraTx era, DijkstraEraTxBody era, DijkstraEraScript era,
 NativeScript era ~ DijkstraNativeScript era) =>
Tx era -> NativeScript era -> Bool
validateDijkstraNativeScript
  {-# INLINE validateNativeScript #-}

  getMinFeeTx :: PParams DijkstraEra -> Tx DijkstraEra -> Int -> Coin
getMinFeeTx = PParams DijkstraEra -> Tx DijkstraEra -> Int -> Coin
forall era.
(EraTx era, AlonzoEraTxWits era, ConwayEraPParams era) =>
PParams era -> Tx era -> Int -> Coin
getConwayMinFeeTx

instance EqRaw (Tx DijkstraEra) where
  eqRaw :: Tx DijkstraEra -> Tx DijkstraEra -> Bool
eqRaw = Tx DijkstraEra -> Tx DijkstraEra -> Bool
forall era. AlonzoEraTx era => Tx era -> Tx era -> Bool
alonzoTxEqRaw

dijkstraTxL :: Lens' (Tx DijkstraEra) (AlonzoTx DijkstraEra)
dijkstraTxL :: Lens' (Tx DijkstraEra) (AlonzoTx DijkstraEra)
dijkstraTxL = (Tx DijkstraEra -> AlonzoTx DijkstraEra)
-> (Tx DijkstraEra -> AlonzoTx DijkstraEra -> Tx DijkstraEra)
-> Lens' (Tx DijkstraEra) (AlonzoTx DijkstraEra)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Tx DijkstraEra -> AlonzoTx DijkstraEra
unDijkstraTx (\Tx DijkstraEra
x AlonzoTx DijkstraEra
y -> Tx DijkstraEra
x {unDijkstraTx = y})

instance AlonzoEraTx DijkstraEra where
  isValidTxL :: Lens' (Tx DijkstraEra) IsValid
isValidTxL = (AlonzoTx DijkstraEra -> f (AlonzoTx DijkstraEra))
-> Tx DijkstraEra -> f (Tx DijkstraEra)
Lens' (Tx DijkstraEra) (AlonzoTx DijkstraEra)
dijkstraTxL ((AlonzoTx DijkstraEra -> f (AlonzoTx DijkstraEra))
 -> Tx DijkstraEra -> f (Tx DijkstraEra))
-> ((IsValid -> f IsValid)
    -> AlonzoTx DijkstraEra -> f (AlonzoTx DijkstraEra))
-> (IsValid -> f IsValid)
-> Tx DijkstraEra
-> f (Tx DijkstraEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IsValid -> f IsValid)
-> AlonzoTx DijkstraEra -> f (AlonzoTx DijkstraEra)
forall era (f :: * -> *).
Functor f =>
(IsValid -> f IsValid) -> AlonzoTx era -> f (AlonzoTx era)
isValidAlonzoTxL
  {-# INLINE isValidTxL #-}

instance DecCBOR (Annotator (Tx DijkstraEra)) where
  decCBOR :: forall s. Decoder s (Annotator (Tx DijkstraEra))
decCBOR = (AlonzoTx DijkstraEra -> Tx DijkstraEra)
-> Annotator (AlonzoTx DijkstraEra) -> Annotator (Tx DijkstraEra)
forall a b. (a -> b) -> Annotator a -> Annotator b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AlonzoTx DijkstraEra -> Tx DijkstraEra
MkDijkstraTx (Annotator (AlonzoTx DijkstraEra) -> Annotator (Tx DijkstraEra))
-> Decoder s (Annotator (AlonzoTx DijkstraEra))
-> Decoder s (Annotator (Tx DijkstraEra))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Annotator (AlonzoTx DijkstraEra))
forall s. Decoder s (Annotator (AlonzoTx DijkstraEra))
forall a s. DecCBOR a => Decoder s a
decCBOR

validateDijkstraNativeScript ::
  ( EraTx era
  , DijkstraEraTxBody era
  , DijkstraEraScript era
  , NativeScript era ~ DijkstraNativeScript era
  ) =>
  Tx era -> NativeScript era -> Bool
validateDijkstraNativeScript :: forall era.
(EraTx era, DijkstraEraTxBody era, DijkstraEraScript era,
 NativeScript era ~ DijkstraNativeScript era) =>
Tx era -> NativeScript era -> Bool
validateDijkstraNativeScript Tx era
tx =
  Set (KeyHash 'Witness)
-> ValidityInterval
-> OSet (Credential 'Guard)
-> NativeScript era
-> Bool
forall era.
(DijkstraEraScript era,
 NativeScript era ~ DijkstraNativeScript era) =>
Set (KeyHash 'Witness)
-> ValidityInterval
-> OSet (Credential 'Guard)
-> NativeScript era
-> Bool
evalDijkstraNativeScript Set (KeyHash 'Witness)
vhks (Tx era
tx Tx era
-> Getting ValidityInterval (Tx era) ValidityInterval
-> ValidityInterval
forall s a. s -> Getting a s a -> a
^. (TxBody era -> Const ValidityInterval (TxBody era))
-> Tx era -> Const ValidityInterval (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Const ValidityInterval (TxBody era))
 -> Tx era -> Const ValidityInterval (Tx era))
-> ((ValidityInterval -> Const ValidityInterval ValidityInterval)
    -> TxBody era -> Const ValidityInterval (TxBody era))
-> Getting ValidityInterval (Tx era) ValidityInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValidityInterval -> Const ValidityInterval ValidityInterval)
-> TxBody era -> Const ValidityInterval (TxBody era)
forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
Lens' (TxBody era) ValidityInterval
vldtTxBodyL) (Tx era
tx Tx era
-> Getting
     (OSet (Credential 'Guard)) (Tx era) (OSet (Credential 'Guard))
-> OSet (Credential 'Guard)
forall s a. s -> Getting a s a -> a
^. (TxBody era -> Const (OSet (Credential 'Guard)) (TxBody era))
-> Tx era -> Const (OSet (Credential 'Guard)) (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Const (OSet (Credential 'Guard)) (TxBody era))
 -> Tx era -> Const (OSet (Credential 'Guard)) (Tx era))
-> ((OSet (Credential 'Guard)
     -> Const (OSet (Credential 'Guard)) (OSet (Credential 'Guard)))
    -> TxBody era -> Const (OSet (Credential 'Guard)) (TxBody era))
-> Getting
     (OSet (Credential 'Guard)) (Tx era) (OSet (Credential 'Guard))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OSet (Credential 'Guard)
 -> Const (OSet (Credential 'Guard)) (OSet (Credential 'Guard)))
-> TxBody era -> Const (OSet (Credential 'Guard)) (TxBody era)
forall era.
DijkstraEraTxBody era =>
Lens' (TxBody era) (OSet (Credential 'Guard))
Lens' (TxBody era) (OSet (Credential 'Guard))
guardsTxBodyL)
  where
    vhks :: Set (KeyHash 'Witness)
vhks = (WitVKey 'Witness -> KeyHash 'Witness)
-> Set (WitVKey 'Witness) -> Set (KeyHash 'Witness)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map WitVKey 'Witness -> KeyHash 'Witness
forall (kr :: KeyRole). WitVKey kr -> KeyHash 'Witness
witVKeyHash (Tx era
tx Tx era
-> Getting
     (Set (WitVKey 'Witness)) (Tx era) (Set (WitVKey 'Witness))
-> Set (WitVKey 'Witness)
forall s a. s -> Getting a s a -> a
^. (TxWits era -> Const (Set (WitVKey 'Witness)) (TxWits era))
-> Tx era -> Const (Set (WitVKey 'Witness)) (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Const (Set (WitVKey 'Witness)) (TxWits era))
 -> Tx era -> Const (Set (WitVKey 'Witness)) (Tx era))
-> ((Set (WitVKey 'Witness)
     -> Const (Set (WitVKey 'Witness)) (Set (WitVKey 'Witness)))
    -> TxWits era -> Const (Set (WitVKey 'Witness)) (TxWits era))
-> Getting
     (Set (WitVKey 'Witness)) (Tx era) (Set (WitVKey 'Witness))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (WitVKey 'Witness)
 -> Const (Set (WitVKey 'Witness)) (Set (WitVKey 'Witness)))
-> TxWits era -> Const (Set (WitVKey 'Witness)) (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness))
Lens' (TxWits era) (Set (WitVKey 'Witness))
addrTxWitsL)
{-# INLINEABLE validateDijkstraNativeScript #-}