-- | This module exposes the notion of redeemers used whenever a script in
-- invoked in a 'Cooked.Skeleton.TxSkel'.
module Cooked.Skeleton.Redeemer
  ( TxSkelRedeemer (..),
    RedeemerConstrs,
    withReferenceInput,
    someTxSkelRedeemer,
    emptyTxSkelRedeemer,
    txSkelRedeemerReferenceInputL,
    txSkelRedeemerAutoFillL,
    txSkelRedeemerTypedAT,
    someTxSkelRedeemerNoAutoFill,
    emptyTxSkelRedeemerNoAutoFill,
    txSkelRedeemerBuiltinDataL,
  )
where

import Cooked.Pretty.Class
import Cooked.Pretty.Plutus ()
import Data.Typeable (Typeable, cast)
import Optics.Core
import Optics.TH
import PlutusLedgerApi.V3 qualified as Api
import PlutusTx.Prelude qualified as PlutusTx

-- * Types and constraints for redeemers used in skeletons

-- | These are the constraints that must be satisfied by the inner content of a
-- redeemer, that is the actual data that will be passed to the script as its
-- redeemer during during validation
type RedeemerConstrs redeemer =
  ( Api.ToData redeemer,
    Api.FromData redeemer,
    Show redeemer,
    PrettyCooked redeemer,
    PlutusTx.Eq redeemer,
    Typeable redeemer
  )

-- | A bundle around a redeemer which allows to provide a reference input in
-- which the script associated with the redeemer can be found
data TxSkelRedeemer where
  TxSkelRedeemer ::
    (RedeemerConstrs redeemer) =>
    { -- | The redeemer data with which the script will be executed
      ()
txSkelRedeemerContent :: redeemer,
      -- | An optional reference input containing the script to execute. During
      -- transaction generation, this reference input will only be translated
      -- into a Cardano reference input if it does not appear in regular inputs.
      TxSkelRedeemer -> Maybe TxOutRef
txSkelRedeemerReferenceInput :: Maybe Api.TxOutRef,
      -- | Whether the reference input can be automatically assigned. This will
      -- only trigger if 'txSkelRedeemerReferenceInput' is 'Nothing'
      TxSkelRedeemer -> Bool
txSkelRedeemerAutoFill :: Bool
    } ->
    TxSkelRedeemer

deriving instance (Show TxSkelRedeemer)

instance Eq TxSkelRedeemer where
  (TxSkelRedeemer redeemer
red Maybe TxOutRef
mRefIn Bool
af) == :: TxSkelRedeemer -> TxSkelRedeemer -> Bool
== TxSkelRedeemer redeemer
red' Maybe TxOutRef
mRefIn' Bool
af' =
    redeemer -> Maybe redeemer
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast redeemer
red Maybe redeemer -> Maybe redeemer -> Bool
forall a. Eq a => a -> a -> Bool
PlutusTx.== redeemer -> Maybe redeemer
forall a. a -> Maybe a
Just redeemer
red' Bool -> Bool -> Bool
PlutusTx.&& Maybe TxOutRef
mRefIn Maybe TxOutRef -> Maybe TxOutRef -> Bool
forall a. Eq a => a -> a -> Bool
PlutusTx.== Maybe TxOutRef
mRefIn' Bool -> Bool -> Bool
PlutusTx.&& Bool
af Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
PlutusTx.== Bool
af'

-- * Navigating within a 'TxSkelRedeemer'

-- | Sets or gets the reference input from a redeemer
makeLensesFor [("txSkelRedeemerReferenceInput", "txSkelRedeemerReferenceInputL")] ''TxSkelRedeemer

-- | Sets or gets the autofill property from a redeemer
makeLensesFor [("txSkelRedeemerAutoFill", "txSkelRedeemerAutoFillL")] ''TxSkelRedeemer

-- | Attaches a reference input to a given 'TxSkelRedeemer'. This should usually
-- be of no use if option 'Cooked.Skeleton.Option.txOptAutoReferenceScripts' is
-- turned on, which is the case by default.
withReferenceInput :: TxSkelRedeemer -> Api.TxOutRef -> TxSkelRedeemer
withReferenceInput :: TxSkelRedeemer -> TxOutRef -> TxSkelRedeemer
withReferenceInput TxSkelRedeemer
red TxOutRef
ref = TxSkelRedeemer
red TxSkelRedeemer
-> (TxSkelRedeemer -> TxSkelRedeemer) -> TxSkelRedeemer
forall a b. a -> (a -> b) -> b
& Lens' TxSkelRedeemer (Maybe TxOutRef)
txSkelRedeemerReferenceInputL Lens' TxSkelRedeemer (Maybe TxOutRef)
-> TxOutRef -> TxSkelRedeemer -> TxSkelRedeemer
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ TxOutRef
ref

-- | Extracts, or sets, the typed redeemer of a 'TxSkelRedeemer'. This is
-- attempted in two ways: first, we try to simply cast the content, and then, if
-- it fails, we serialise the content and then attempt to deserialise it to the
-- right type. This second case is specifically useful when the current content
-- is an 'Api.BuiltinData' itself directly, but it can also be used in the
-- cornercase when both types have compatible serialized representation.
txSkelRedeemerTypedAT :: (RedeemerConstrs a, RedeemerConstrs b) => AffineTraversal TxSkelRedeemer TxSkelRedeemer a b
txSkelRedeemerTypedAT :: forall a b.
(RedeemerConstrs a, RedeemerConstrs b) =>
AffineTraversal TxSkelRedeemer TxSkelRedeemer a b
txSkelRedeemerTypedAT =
  (TxSkelRedeemer -> Either TxSkelRedeemer a)
-> (TxSkelRedeemer -> b -> TxSkelRedeemer)
-> AffineTraversal TxSkelRedeemer TxSkelRedeemer a b
forall s t a b.
(s -> Either t a) -> (s -> b -> t) -> AffineTraversal s t a b
atraversal
    ( \case
        (TxSkelRedeemer redeemer
content Maybe TxOutRef
_ Bool
_) | Just a
content' <- redeemer -> Maybe a
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast redeemer
content -> a -> Either TxSkelRedeemer a
forall a b. b -> Either a b
Right a
content'
        (TxSkelRedeemer redeemer
content Maybe TxOutRef
_ Bool
_) | Just a
content' <- BuiltinData -> Maybe a
forall a. FromData a => BuiltinData -> Maybe a
Api.fromBuiltinData (BuiltinData -> Maybe a) -> BuiltinData -> Maybe a
forall a b. (a -> b) -> a -> b
$ redeemer -> BuiltinData
forall a. ToData a => a -> BuiltinData
Api.toBuiltinData redeemer
content -> a -> Either TxSkelRedeemer a
forall a b. b -> Either a b
Right a
content'
        TxSkelRedeemer
txSkelRed -> TxSkelRedeemer -> Either TxSkelRedeemer a
forall a b. a -> Either a b
Left TxSkelRedeemer
txSkelRed
    )
    (\TxSkelRedeemer
red b
content -> TxSkelRedeemer
red {txSkelRedeemerContent = content})

-- | Extracts, or sets, the redeemer content as an `Api.BuiltinData`
txSkelRedeemerBuiltinDataL :: Lens' TxSkelRedeemer Api.BuiltinData
txSkelRedeemerBuiltinDataL :: Lens' TxSkelRedeemer BuiltinData
txSkelRedeemerBuiltinDataL =
  (TxSkelRedeemer -> BuiltinData)
-> (TxSkelRedeemer -> BuiltinData -> TxSkelRedeemer)
-> Lens' TxSkelRedeemer BuiltinData
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    (\(TxSkelRedeemer redeemer
content Maybe TxOutRef
_ Bool
_) -> redeemer -> BuiltinData
forall a. ToData a => a -> BuiltinData
Api.toBuiltinData redeemer
content)
    (\TxSkelRedeemer
txSkelRed BuiltinData
bData -> TxSkelRedeemer
txSkelRed {txSkelRedeemerContent = bData})

-- * Building 'TxSkelRedeemer's

-- | Creates a 'TxSkelRedeemer' from an inner content with no reference input
someTxSkelRedeemer :: (RedeemerConstrs redeemer) => redeemer -> TxSkelRedeemer
someTxSkelRedeemer :: forall redeemer.
RedeemerConstrs redeemer =>
redeemer -> TxSkelRedeemer
someTxSkelRedeemer redeemer
red = redeemer -> Maybe TxOutRef -> Bool -> TxSkelRedeemer
forall redeemer.
RedeemerConstrs redeemer =>
redeemer -> Maybe TxOutRef -> Bool -> TxSkelRedeemer
TxSkelRedeemer redeemer
red Maybe TxOutRef
forall a. Maybe a
Nothing Bool
True

-- | Creates a 'TxSkelRedeemer' from an inner content with no reference input,
-- while not allowing it to be automatically assigned
someTxSkelRedeemerNoAutoFill :: (RedeemerConstrs redeemer) => redeemer -> TxSkelRedeemer
someTxSkelRedeemerNoAutoFill :: forall redeemer.
RedeemerConstrs redeemer =>
redeemer -> TxSkelRedeemer
someTxSkelRedeemerNoAutoFill redeemer
red = redeemer -> Maybe TxOutRef -> Bool -> TxSkelRedeemer
forall redeemer.
RedeemerConstrs redeemer =>
redeemer -> Maybe TxOutRef -> Bool -> TxSkelRedeemer
TxSkelRedeemer redeemer
red Maybe TxOutRef
forall a. Maybe a
Nothing Bool
False

-- | Creates a 'TxSkelRedeemer' without an inner content nor a reference input
emptyTxSkelRedeemer :: TxSkelRedeemer
emptyTxSkelRedeemer :: TxSkelRedeemer
emptyTxSkelRedeemer = () -> TxSkelRedeemer
forall redeemer.
RedeemerConstrs redeemer =>
redeemer -> TxSkelRedeemer
someTxSkelRedeemer ()

-- | Creates a 'TxSkelRedeemer' with no inner content and no reference input,
-- while dissallowing it to be automatically assinged
emptyTxSkelRedeemerNoAutoFill :: TxSkelRedeemer
emptyTxSkelRedeemerNoAutoFill :: TxSkelRedeemer
emptyTxSkelRedeemerNoAutoFill = () -> TxSkelRedeemer
forall redeemer.
RedeemerConstrs redeemer =>
redeemer -> TxSkelRedeemer
someTxSkelRedeemerNoAutoFill ()