-- | This module exposes the notion of datums as they are handled within a
-- 'Cooked.Skeleton.TxSkel'
module Cooked.Skeleton.Datum
  ( DatumConstrs,
    DatumResolved (..),
    DatumKind (..),
    TxSkelOutDatum (..),
    datumKindResolvedP,
    txSkelOutDatumKindAT,
    txSkelOutDatumResolvedAT,
    txSkelOutDatumTypedAT,
    txSkelOutDatumDatumAF,
    txSkelOutDatumDatumHashAF,
    txSkelOutDatumOutputDatumG,
  )
where

import Cooked.Pretty.Class
import Cooked.Pretty.Plutus ()
import Data.Typeable (cast)
import Optics.Core
import Plutus.Script.Utils.Data qualified as Script
import PlutusLedgerApi.V3 qualified as Api
import Type.Reflection

-- * Type constraints on datums used in cooked-validators

-- | Type constraints that must be satisfied by the datum content
type DatumConstrs datum =
  ( Show datum,
    PrettyCooked datum,
    Api.ToData datum,
    Api.FromData datum,
    Eq datum,
    Typeable datum
  )

-- * Datum kind within a transaction and output

-- | Whether the datum should be resolved in the transaction
data DatumResolved
  = -- | Do not resolve the datum (absent from 'Api.txInfoData')
    NotResolved
  | -- | Resolve the datum (present from 'Api.txInfoData')
    Resolved
  deriving (Int -> DatumResolved -> ShowS
[DatumResolved] -> ShowS
DatumResolved -> String
(Int -> DatumResolved -> ShowS)
-> (DatumResolved -> String)
-> ([DatumResolved] -> ShowS)
-> Show DatumResolved
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DatumResolved -> ShowS
showsPrec :: Int -> DatumResolved -> ShowS
$cshow :: DatumResolved -> String
show :: DatumResolved -> String
$cshowList :: [DatumResolved] -> ShowS
showList :: [DatumResolved] -> ShowS
Show, DatumResolved -> DatumResolved -> Bool
(DatumResolved -> DatumResolved -> Bool)
-> (DatumResolved -> DatumResolved -> Bool) -> Eq DatumResolved
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DatumResolved -> DatumResolved -> Bool
== :: DatumResolved -> DatumResolved -> Bool
$c/= :: DatumResolved -> DatumResolved -> Bool
/= :: DatumResolved -> DatumResolved -> Bool
Eq, Eq DatumResolved
Eq DatumResolved =>
(DatumResolved -> DatumResolved -> Ordering)
-> (DatumResolved -> DatumResolved -> Bool)
-> (DatumResolved -> DatumResolved -> Bool)
-> (DatumResolved -> DatumResolved -> Bool)
-> (DatumResolved -> DatumResolved -> Bool)
-> (DatumResolved -> DatumResolved -> DatumResolved)
-> (DatumResolved -> DatumResolved -> DatumResolved)
-> Ord DatumResolved
DatumResolved -> DatumResolved -> Bool
DatumResolved -> DatumResolved -> Ordering
DatumResolved -> DatumResolved -> DatumResolved
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DatumResolved -> DatumResolved -> Ordering
compare :: DatumResolved -> DatumResolved -> Ordering
$c< :: DatumResolved -> DatumResolved -> Bool
< :: DatumResolved -> DatumResolved -> Bool
$c<= :: DatumResolved -> DatumResolved -> Bool
<= :: DatumResolved -> DatumResolved -> Bool
$c> :: DatumResolved -> DatumResolved -> Bool
> :: DatumResolved -> DatumResolved -> Bool
$c>= :: DatumResolved -> DatumResolved -> Bool
>= :: DatumResolved -> DatumResolved -> Bool
$cmax :: DatumResolved -> DatumResolved -> DatumResolved
max :: DatumResolved -> DatumResolved -> DatumResolved
$cmin :: DatumResolved -> DatumResolved -> DatumResolved
min :: DatumResolved -> DatumResolved -> DatumResolved
Ord)

-- | Options on how to include the datum in the transaction
data DatumKind
  = -- | Include the full datum in the UTxO
    Inline
  | -- | Only include the datum hash in the UTxO. Resolve, or do not resolve,
    -- the full datum in the transaction body.
    Hashed DatumResolved
  deriving (Int -> DatumKind -> ShowS
[DatumKind] -> ShowS
DatumKind -> String
(Int -> DatumKind -> ShowS)
-> (DatumKind -> String)
-> ([DatumKind] -> ShowS)
-> Show DatumKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DatumKind -> ShowS
showsPrec :: Int -> DatumKind -> ShowS
$cshow :: DatumKind -> String
show :: DatumKind -> String
$cshowList :: [DatumKind] -> ShowS
showList :: [DatumKind] -> ShowS
Show, DatumKind -> DatumKind -> Bool
(DatumKind -> DatumKind -> Bool)
-> (DatumKind -> DatumKind -> Bool) -> Eq DatumKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DatumKind -> DatumKind -> Bool
== :: DatumKind -> DatumKind -> Bool
$c/= :: DatumKind -> DatumKind -> Bool
/= :: DatumKind -> DatumKind -> Bool
Eq, Eq DatumKind
Eq DatumKind =>
(DatumKind -> DatumKind -> Ordering)
-> (DatumKind -> DatumKind -> Bool)
-> (DatumKind -> DatumKind -> Bool)
-> (DatumKind -> DatumKind -> Bool)
-> (DatumKind -> DatumKind -> Bool)
-> (DatumKind -> DatumKind -> DatumKind)
-> (DatumKind -> DatumKind -> DatumKind)
-> Ord DatumKind
DatumKind -> DatumKind -> Bool
DatumKind -> DatumKind -> Ordering
DatumKind -> DatumKind -> DatumKind
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DatumKind -> DatumKind -> Ordering
compare :: DatumKind -> DatumKind -> Ordering
$c< :: DatumKind -> DatumKind -> Bool
< :: DatumKind -> DatumKind -> Bool
$c<= :: DatumKind -> DatumKind -> Bool
<= :: DatumKind -> DatumKind -> Bool
$c> :: DatumKind -> DatumKind -> Bool
> :: DatumKind -> DatumKind -> Bool
$c>= :: DatumKind -> DatumKind -> Bool
>= :: DatumKind -> DatumKind -> Bool
$cmax :: DatumKind -> DatumKind -> DatumKind
max :: DatumKind -> DatumKind -> DatumKind
$cmin :: DatumKind -> DatumKind -> DatumKind
min :: DatumKind -> DatumKind -> DatumKind
Ord)

-- | Builds a 'DatumKind' from a 'DatumResolved' or optionally retrieves it
datumKindResolvedP :: Prism' DatumKind DatumResolved
datumKindResolvedP :: Prism' DatumKind DatumResolved
datumKindResolvedP =
  (DatumResolved -> DatumKind)
-> (DatumKind -> Either DatumKind DatumResolved)
-> Prism' DatumKind DatumResolved
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
    DatumResolved -> DatumKind
Hashed
    ( \case
        DatumKind
Inline -> DatumKind -> Either DatumKind DatumResolved
forall a b. a -> Either a b
Left DatumKind
Inline
        Hashed DatumResolved
resolved -> DatumResolved -> Either DatumKind DatumResolved
forall a b. b -> Either a b
Right DatumResolved
resolved
    )

-- * 'Cooked.Skeleton.TxSkel' datums

-- | Datums to be placed in 'Cooked.Skeleton.TxSkel' outputs, which are either
-- empty, or composed of a datum content and its placement
data TxSkelOutDatum where
  -- | use no datum
  NoTxSkelOutDatum :: TxSkelOutDatum
  -- | use some datum content and associated placement
  SomeTxSkelOutDatum :: (DatumConstrs dat) => dat -> DatumKind -> TxSkelOutDatum

deriving instance Show TxSkelOutDatum

instance Ord TxSkelOutDatum where
  compare :: TxSkelOutDatum -> TxSkelOutDatum -> Ordering
compare TxSkelOutDatum
NoTxSkelOutDatum TxSkelOutDatum
NoTxSkelOutDatum = Ordering
EQ
  compare TxSkelOutDatum
NoTxSkelOutDatum TxSkelOutDatum
_ = Ordering
LT
  compare TxSkelOutDatum
_ TxSkelOutDatum
NoTxSkelOutDatum = Ordering
GT
  compare
    (SomeTxSkelOutDatum (dat -> BuiltinData
forall a. ToData a => a -> BuiltinData
Api.toBuiltinData -> BuiltinData
dat) DatumKind
b)
    (SomeTxSkelOutDatum (dat -> BuiltinData
forall a. ToData a => a -> BuiltinData
Api.toBuiltinData -> BuiltinData
dat') DatumKind
b') =
      (BuiltinData, DatumKind) -> (BuiltinData, DatumKind) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (BuiltinData
dat, DatumKind
b) (BuiltinData
dat', DatumKind
b')

instance Eq TxSkelOutDatum where
  TxSkelOutDatum
dat == :: TxSkelOutDatum -> TxSkelOutDatum -> Bool
== TxSkelOutDatum
dat' = TxSkelOutDatum -> TxSkelOutDatum -> Ordering
forall a. Ord a => a -> a -> Ordering
compare TxSkelOutDatum
dat TxSkelOutDatum
dat' Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ

-- * Optics working on 'TxSkelOutDatum'

-- | Extracts or changes the 'DatumKind' of a 'TxSkelOutDatum'
txSkelOutDatumKindAT :: AffineTraversal' TxSkelOutDatum DatumKind
txSkelOutDatumKindAT :: AffineTraversal' TxSkelOutDatum DatumKind
txSkelOutDatumKindAT =
  (TxSkelOutDatum -> Either TxSkelOutDatum DatumKind)
-> (TxSkelOutDatum -> DatumKind -> TxSkelOutDatum)
-> AffineTraversal' TxSkelOutDatum DatumKind
forall s t a b.
(s -> Either t a) -> (s -> b -> t) -> AffineTraversal s t a b
atraversal
    ( \case
        TxSkelOutDatum
NoTxSkelOutDatum -> TxSkelOutDatum -> Either TxSkelOutDatum DatumKind
forall a b. a -> Either a b
Left TxSkelOutDatum
NoTxSkelOutDatum
        SomeTxSkelOutDatum dat
_ DatumKind
kind -> DatumKind -> Either TxSkelOutDatum DatumKind
forall a b. b -> Either a b
Right DatumKind
kind
    )
    ( (DatumKind -> TxSkelOutDatum -> TxSkelOutDatum)
-> TxSkelOutDatum -> DatumKind -> TxSkelOutDatum
forall a b c. (a -> b -> c) -> b -> a -> c
flip
        ( \DatumKind
kind -> \case
            TxSkelOutDatum
NoTxSkelOutDatum -> TxSkelOutDatum
NoTxSkelOutDatum
            SomeTxSkelOutDatum dat
content DatumKind
_ -> dat -> DatumKind -> TxSkelOutDatum
forall dat. DatumConstrs dat => dat -> DatumKind -> TxSkelOutDatum
SomeTxSkelOutDatum dat
content DatumKind
kind
        )
    )

-- | Extracts or changes the 'DatumResolved' of a 'TxSkelOutDatum'
txSkelOutDatumResolvedAT :: AffineTraversal' TxSkelOutDatum DatumResolved
txSkelOutDatumResolvedAT :: AffineTraversal' TxSkelOutDatum DatumResolved
txSkelOutDatumResolvedAT = AffineTraversal' TxSkelOutDatum DatumKind
txSkelOutDatumKindAT AffineTraversal' TxSkelOutDatum DatumKind
-> Prism' DatumKind DatumResolved
-> AffineTraversal' TxSkelOutDatum DatumResolved
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Prism' DatumKind DatumResolved
datumKindResolvedP

-- | Extracts, or sets, the typed datum of a 'TxSkelOutDatum'. 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.
txSkelOutDatumTypedAT :: (DatumConstrs a, DatumConstrs b) => AffineTraversal TxSkelOutDatum TxSkelOutDatum a b
txSkelOutDatumTypedAT :: forall a b.
(DatumConstrs a, DatumConstrs b) =>
AffineTraversal TxSkelOutDatum TxSkelOutDatum a b
txSkelOutDatumTypedAT =
  (TxSkelOutDatum -> Either TxSkelOutDatum a)
-> (TxSkelOutDatum -> b -> TxSkelOutDatum)
-> AffineTraversal TxSkelOutDatum TxSkelOutDatum a b
forall s t a b.
(s -> Either t a) -> (s -> b -> t) -> AffineTraversal s t a b
atraversal
    ( \case
        (SomeTxSkelOutDatum dat
content DatumKind
_) | Just a
content' <- dat -> Maybe a
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast dat
content -> a -> Either TxSkelOutDatum a
forall a b. b -> Either a b
Right a
content'
        (SomeTxSkelOutDatum dat
content DatumKind
_) | 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
$ dat -> BuiltinData
forall a. ToData a => a -> BuiltinData
Api.toBuiltinData dat
content -> a -> Either TxSkelOutDatum a
forall a b. b -> Either a b
Right a
content'
        TxSkelOutDatum
dc -> TxSkelOutDatum -> Either TxSkelOutDatum a
forall a b. a -> Either a b
Left TxSkelOutDatum
dc
    )
    ( (b -> TxSkelOutDatum -> TxSkelOutDatum)
-> TxSkelOutDatum -> b -> TxSkelOutDatum
forall a b c. (a -> b -> c) -> b -> a -> c
flip
        ( \b
content -> \case
            TxSkelOutDatum
NoTxSkelOutDatum -> TxSkelOutDatum
NoTxSkelOutDatum
            SomeTxSkelOutDatum dat
_ DatumKind
kind -> b -> DatumKind -> TxSkelOutDatum
forall dat. DatumConstrs dat => dat -> DatumKind -> TxSkelOutDatum
SomeTxSkelOutDatum b
content DatumKind
kind
        )
    )

-- | Converts a 'TxSkelOutDatum' into a possible 'Api.Datum'
txSkelOutDatumDatumAF :: AffineFold TxSkelOutDatum Api.Datum
txSkelOutDatumDatumAF :: AffineFold TxSkelOutDatum Datum
txSkelOutDatumDatumAF = AffineTraversal
  TxSkelOutDatum TxSkelOutDatum BuiltinData BuiltinData
forall a b.
(DatumConstrs a, DatumConstrs b) =>
AffineTraversal TxSkelOutDatum TxSkelOutDatum a b
txSkelOutDatumTypedAT AffineTraversal
  TxSkelOutDatum TxSkelOutDatum BuiltinData BuiltinData
-> Optic A_Getter NoIx BuiltinData BuiltinData Datum Datum
-> AffineFold TxSkelOutDatum Datum
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% (BuiltinData -> Datum)
-> Optic A_Getter NoIx BuiltinData BuiltinData Datum Datum
forall s a. (s -> a) -> Getter s a
to BuiltinData -> Datum
Api.Datum

-- | Converts a 'TxSkelOutDatum' into a possible 'Api.DatumHash'
txSkelOutDatumDatumHashAF :: AffineFold TxSkelOutDatum Api.DatumHash
txSkelOutDatumDatumHashAF :: AffineFold TxSkelOutDatum DatumHash
txSkelOutDatumDatumHashAF = AffineFold TxSkelOutDatum Datum
txSkelOutDatumDatumAF AffineFold TxSkelOutDatum Datum
-> Optic A_Getter NoIx Datum Datum DatumHash DatumHash
-> AffineFold TxSkelOutDatum DatumHash
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% (Datum -> DatumHash)
-> Optic A_Getter NoIx Datum Datum DatumHash DatumHash
forall s a. (s -> a) -> Getter s a
to Datum -> DatumHash
Script.datumHash

-- | Converts a 'TxSkelOutDatum' into an 'Api.OutputDatum'
txSkelOutDatumOutputDatumG :: Getter TxSkelOutDatum Api.OutputDatum
txSkelOutDatumOutputDatumG :: Getter TxSkelOutDatum OutputDatum
txSkelOutDatumOutputDatumG = (TxSkelOutDatum -> OutputDatum)
-> Getter TxSkelOutDatum OutputDatum
forall s a. (s -> a) -> Getter s a
to TxSkelOutDatum -> OutputDatum
forall a. ToOutputDatum a => a -> OutputDatum
Script.toOutputDatum

instance Script.ToOutputDatum TxSkelOutDatum where
  toOutputDatum :: TxSkelOutDatum -> OutputDatum
toOutputDatum TxSkelOutDatum
NoTxSkelOutDatum = OutputDatum
Api.NoOutputDatum
  toOutputDatum (SomeTxSkelOutDatum dat
datum DatumKind
Inline) = Datum -> OutputDatum
Api.OutputDatum (Datum -> OutputDatum) -> Datum -> OutputDatum
forall a b. (a -> b) -> a -> b
$ BuiltinData -> Datum
Api.Datum (BuiltinData -> Datum) -> BuiltinData -> Datum
forall a b. (a -> b) -> a -> b
$ dat -> BuiltinData
forall a. ToData a => a -> BuiltinData
Api.toBuiltinData dat
datum
  toOutputDatum (SomeTxSkelOutDatum dat
datum DatumKind
_) = DatumHash -> OutputDatum
Api.OutputDatumHash (DatumHash -> OutputDatum) -> DatumHash -> OutputDatum
forall a b. (a -> b) -> a -> b
$ Datum -> DatumHash
Script.datumHash (Datum -> DatumHash) -> Datum -> DatumHash
forall a b. (a -> b) -> a -> b
$ BuiltinData -> Datum
Api.Datum (BuiltinData -> Datum) -> BuiltinData -> Datum
forall a b. (a -> b) -> a -> b
$ dat -> BuiltinData
forall a. ToData a => a -> BuiltinData
Api.toBuiltinData dat
datum