-- | This module exposes the notion of datums as they are handled within a
-- 'Cooked.Skeleton.TxSkel'
module Cooked.Skeleton.Datum
  ( DatumConstrs,
    DatumContent (..),
    datumContentToDatum,
    datumContentToDatumHash,
    DatumResolved (..),
    DatumKind (..),
    TxSkelOutDatum (..),
    txSkelOutDatumHash,
    txSkelOutUntypedDatum,
    datumContentTypedDatumAT,
    txSkelOutDatumContentAT,
    txSkelOutTypedDatumAT,
  )
where

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

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

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

-- * Wrapping datums of arbitrary types satisfying 'DatumConstrs'

-- | Data type of wrapped datums satisfying 'DatumConstrs'
data DatumContent where
  -- | Wraps an element satisfying 'DatumConstrs'
  DatumContent :: (DatumConstrs a) => a -> DatumContent

deriving instance Show DatumContent

instance Api.ToData DatumContent where
  toBuiltinData :: DatumContent -> BuiltinData
toBuiltinData (DatumContent a
dat) = a -> BuiltinData
forall a. ToData a => a -> BuiltinData
Api.toBuiltinData a
dat

-- | Extracts the datum from a 'DatumContent'
datumContentToDatum :: DatumContent -> Api.Datum
datumContentToDatum :: DatumContent -> Datum
datumContentToDatum = BuiltinData -> Datum
Api.Datum (BuiltinData -> Datum)
-> (DatumContent -> BuiltinData) -> DatumContent -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatumContent -> BuiltinData
forall a. ToData a => a -> BuiltinData
Api.toBuiltinData

-- | Extracts the datum hash from a 'DatumContent'
datumContentToDatumHash :: DatumContent -> Api.DatumHash
datumContentToDatumHash :: DatumContent -> DatumHash
datumContentToDatumHash = Datum -> DatumHash
Script.datumHash (Datum -> DatumHash)
-> (DatumContent -> Datum) -> DatumContent -> DatumHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatumContent -> Datum
datumContentToDatum

-- | Extracts a typed datum for a 'DatumContent' when of the right type
datumContentTypedDatumAT :: (DatumConstrs a) => AffineTraversal' DatumContent a
datumContentTypedDatumAT :: forall a. DatumConstrs a => AffineTraversal' DatumContent a
datumContentTypedDatumAT =
  (DatumContent -> Either DatumContent a)
-> (DatumContent -> a -> DatumContent)
-> AffineTraversal DatumContent DatumContent a a
forall s t a b.
(s -> Either t a) -> (s -> b -> t) -> AffineTraversal s t a b
atraversal
    (\c :: DatumContent
c@(DatumContent a
content) -> Either DatumContent a
-> (a -> Either DatumContent a) -> Maybe a -> Either DatumContent a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (DatumContent -> Either DatumContent a
forall a b. a -> Either a b
Left DatumContent
c) a -> Either DatumContent a
forall a b. b -> Either a b
Right (a -> Maybe a
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
content))
    ((a -> DatumContent) -> DatumContent -> a -> DatumContent
forall a b. a -> b -> a
const a -> DatumContent
forall a. DatumConstrs a => a -> DatumContent
DatumContent)

instance Ord DatumContent where
  compare :: DatumContent -> DatumContent -> Ordering
compare (DatumContent a
d1) (DatumContent a
d2) =
    case SomeTypeRep -> SomeTypeRep -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (TypeRep a -> SomeTypeRep
forall k (a :: k). TypeRep a -> SomeTypeRep
SomeTypeRep (a -> TypeRep a
forall a. Typeable a => a -> TypeRep a
typeOf a
d1)) (TypeRep a -> SomeTypeRep
forall k (a :: k). TypeRep a -> SomeTypeRep
SomeTypeRep (a -> TypeRep a
forall a. Typeable a => a -> TypeRep a
typeOf a
d2)) of
      Ordering
EQ -> BuiltinData -> BuiltinData -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (a -> BuiltinData
forall a. ToData a => a -> BuiltinData
Api.toBuiltinData a
d1) (a -> BuiltinData
forall a. ToData a => a -> BuiltinData
Api.toBuiltinData a
d2)
      Ordering
a -> Ordering
a

instance Eq DatumContent where
  DatumContent
d1 == :: DatumContent -> DatumContent -> Bool
== DatumContent
d2 = DatumContent -> DatumContent -> Ordering
forall a. Ord a => a -> a -> Ordering
compare DatumContent
d1 DatumContent
d2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ

-- * Datum placement within a transaction

-- | 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)

-- * '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
  TxSkelOutNoDatum :: TxSkelOutDatum
  -- | use some datum content and associated placement
  TxSkelOutSomeDatum :: DatumContent -> DatumKind -> TxSkelOutDatum
  deriving (TxSkelOutDatum -> TxSkelOutDatum -> Bool
(TxSkelOutDatum -> TxSkelOutDatum -> Bool)
-> (TxSkelOutDatum -> TxSkelOutDatum -> Bool) -> Eq TxSkelOutDatum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxSkelOutDatum -> TxSkelOutDatum -> Bool
== :: TxSkelOutDatum -> TxSkelOutDatum -> Bool
$c/= :: TxSkelOutDatum -> TxSkelOutDatum -> Bool
/= :: TxSkelOutDatum -> TxSkelOutDatum -> Bool
Eq, Int -> TxSkelOutDatum -> ShowS
[TxSkelOutDatum] -> ShowS
TxSkelOutDatum -> String
(Int -> TxSkelOutDatum -> ShowS)
-> (TxSkelOutDatum -> String)
-> ([TxSkelOutDatum] -> ShowS)
-> Show TxSkelOutDatum
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxSkelOutDatum -> ShowS
showsPrec :: Int -> TxSkelOutDatum -> ShowS
$cshow :: TxSkelOutDatum -> String
show :: TxSkelOutDatum -> String
$cshowList :: [TxSkelOutDatum] -> ShowS
showList :: [TxSkelOutDatum] -> ShowS
Show, Eq TxSkelOutDatum
Eq TxSkelOutDatum =>
(TxSkelOutDatum -> TxSkelOutDatum -> Ordering)
-> (TxSkelOutDatum -> TxSkelOutDatum -> Bool)
-> (TxSkelOutDatum -> TxSkelOutDatum -> Bool)
-> (TxSkelOutDatum -> TxSkelOutDatum -> Bool)
-> (TxSkelOutDatum -> TxSkelOutDatum -> Bool)
-> (TxSkelOutDatum -> TxSkelOutDatum -> TxSkelOutDatum)
-> (TxSkelOutDatum -> TxSkelOutDatum -> TxSkelOutDatum)
-> Ord TxSkelOutDatum
TxSkelOutDatum -> TxSkelOutDatum -> Bool
TxSkelOutDatum -> TxSkelOutDatum -> Ordering
TxSkelOutDatum -> TxSkelOutDatum -> TxSkelOutDatum
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 :: TxSkelOutDatum -> TxSkelOutDatum -> Ordering
compare :: TxSkelOutDatum -> TxSkelOutDatum -> Ordering
$c< :: TxSkelOutDatum -> TxSkelOutDatum -> Bool
< :: TxSkelOutDatum -> TxSkelOutDatum -> Bool
$c<= :: TxSkelOutDatum -> TxSkelOutDatum -> Bool
<= :: TxSkelOutDatum -> TxSkelOutDatum -> Bool
$c> :: TxSkelOutDatum -> TxSkelOutDatum -> Bool
> :: TxSkelOutDatum -> TxSkelOutDatum -> Bool
$c>= :: TxSkelOutDatum -> TxSkelOutDatum -> Bool
>= :: TxSkelOutDatum -> TxSkelOutDatum -> Bool
$cmax :: TxSkelOutDatum -> TxSkelOutDatum -> TxSkelOutDatum
max :: TxSkelOutDatum -> TxSkelOutDatum -> TxSkelOutDatum
$cmin :: TxSkelOutDatum -> TxSkelOutDatum -> TxSkelOutDatum
min :: TxSkelOutDatum -> TxSkelOutDatum -> TxSkelOutDatum
Ord)

instance Script.ToOutputDatum TxSkelOutDatum where
  toOutputDatum :: TxSkelOutDatum -> OutputDatum
toOutputDatum TxSkelOutDatum
TxSkelOutNoDatum = OutputDatum
Api.NoOutputDatum
  toOutputDatum (TxSkelOutSomeDatum DatumContent
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
$ DatumContent -> BuiltinData
forall a. ToData a => a -> BuiltinData
Api.toBuiltinData DatumContent
datum
  toOutputDatum (TxSkelOutSomeDatum DatumContent
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
$ DatumContent -> BuiltinData
forall a. ToData a => a -> BuiltinData
Api.toBuiltinData DatumContent
datum

-- | Extracts or changes the 'DatumContent' of a 'TxSkelOutDatum'
txSkelOutDatumContentAT :: AffineTraversal' TxSkelOutDatum DatumContent
txSkelOutDatumContentAT :: AffineTraversal' TxSkelOutDatum DatumContent
txSkelOutDatumContentAT =
  (TxSkelOutDatum -> Either TxSkelOutDatum DatumContent)
-> (TxSkelOutDatum -> DatumContent -> TxSkelOutDatum)
-> AffineTraversal' TxSkelOutDatum DatumContent
forall s t a b.
(s -> Either t a) -> (s -> b -> t) -> AffineTraversal s t a b
atraversal
    ( \case
        TxSkelOutDatum
TxSkelOutNoDatum -> TxSkelOutDatum -> Either TxSkelOutDatum DatumContent
forall a b. a -> Either a b
Left TxSkelOutDatum
TxSkelOutNoDatum
        TxSkelOutSomeDatum DatumContent
content DatumKind
_ -> DatumContent -> Either TxSkelOutDatum DatumContent
forall a b. b -> Either a b
Right DatumContent
content
    )
    ( (DatumContent -> TxSkelOutDatum -> TxSkelOutDatum)
-> TxSkelOutDatum -> DatumContent -> TxSkelOutDatum
forall a b c. (a -> b -> c) -> b -> a -> c
flip
        ( \DatumContent
content -> \case
            TxSkelOutDatum
TxSkelOutNoDatum -> TxSkelOutDatum
TxSkelOutNoDatum
            TxSkelOutSomeDatum DatumContent
_ DatumKind
kind -> DatumContent -> DatumKind -> TxSkelOutDatum
TxSkelOutSomeDatum DatumContent
content DatumKind
kind
        )
    )

-- | Converts a 'TxSkelOutDatum' into a possible Plutus datum
txSkelOutUntypedDatum :: TxSkelOutDatum -> Maybe Api.Datum
txSkelOutUntypedDatum :: TxSkelOutDatum -> Maybe Datum
txSkelOutUntypedDatum = (DatumContent -> Datum) -> Maybe DatumContent -> Maybe Datum
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DatumContent -> Datum
datumContentToDatum (Maybe DatumContent -> Maybe Datum)
-> (TxSkelOutDatum -> Maybe DatumContent)
-> TxSkelOutDatum
-> Maybe Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AffineTraversal' TxSkelOutDatum DatumContent
-> TxSkelOutDatum -> Maybe DatumContent
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview AffineTraversal' TxSkelOutDatum DatumContent
txSkelOutDatumContentAT

-- | Converts a 'TxSkelOutDatum' into a possible Plutus datum hash
txSkelOutDatumHash :: TxSkelOutDatum -> Maybe Api.DatumHash
txSkelOutDatumHash :: TxSkelOutDatum -> Maybe DatumHash
txSkelOutDatumHash = (DatumContent -> DatumHash)
-> Maybe DatumContent -> Maybe DatumHash
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DatumContent -> DatumHash
datumContentToDatumHash (Maybe DatumContent -> Maybe DatumHash)
-> (TxSkelOutDatum -> Maybe DatumContent)
-> TxSkelOutDatum
-> Maybe DatumHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AffineTraversal' TxSkelOutDatum DatumContent
-> TxSkelOutDatum -> Maybe DatumContent
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview AffineTraversal' TxSkelOutDatum DatumContent
txSkelOutDatumContentAT

-- | Extracts or changes the inner typed datum of a 'TxSkelOutDatum'
txSkelOutTypedDatumAT :: (DatumConstrs a) => AffineTraversal' TxSkelOutDatum a
txSkelOutTypedDatumAT :: forall a. DatumConstrs a => AffineTraversal' TxSkelOutDatum a
txSkelOutTypedDatumAT = AffineTraversal' TxSkelOutDatum DatumContent
txSkelOutDatumContentAT AffineTraversal' TxSkelOutDatum DatumContent
-> Optic An_AffineTraversal NoIx DatumContent DatumContent a a
-> Optic An_AffineTraversal NoIx TxSkelOutDatum TxSkelOutDatum a a
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
% Optic An_AffineTraversal NoIx DatumContent DatumContent a a
forall a. DatumConstrs a => AffineTraversal' DatumContent a
datumContentTypedDatumAT