-- | This module exposes the notion of datums as they are handled within a
-- 'Cooked.Skeleton.TxSkel'
module Cooked.Skeleton.Datum
  ( TxSkelOutDatumConstrs,
    TxSkelOutDatum (..),
    txSkelOutTypedDatum,
    txSkelOutUntypedDatum,
  )
where

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

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

-- | On transaction outputs, we have the options to use
--
-- 1. no datum
-- 2. only a datum hash
-- 3. a "normal" datum
-- 4. an inline datum
--
-- These four options are also what the type 'TxSkelOutDatum' records. The
-- following table explains their differences.
--
-- +------------------------+------------------+---------------------+-----------------------+
-- |                        | datum stored in  | datum resolved      | 'Api.OutputDatum'     |
-- |                        | in the simulated | on the              | constructor           |
-- |                        | chain state      | 'Api.txInfoData'    | seen by the validator |
-- +========================+==================+=====================+=======================+
-- | 'TxSkelOutNoDatum'     | no               | no                  | 'Api.NoOutputDatum'   |
-- +------------------------+------------------+---------------------+-----------------------+
-- | 'TxSkelOutDatumHash'   | yes              | no                  | 'Api.OutputDatumHash' |
-- +------------------------+------------------+---------------------+-----------------------+
-- | 'TxSkelOutDatum'       | yes              | yes                 | 'Api.OutputDatumHash' |
-- +------------------------+------------------+---------------------+-----------------------+
-- | 'TxSkelOutInlineDatum' | yes              | no                  | 'Api.OutputDatum'     |
-- +------------------------+------------------+---------------------+-----------------------+
--
-- That is:
--
-- - Whenever there is a datum, we'll store it in the state of our simulated
--   chain. This will make it possible to retrieve it later, using functions
--   such as 'Api.datumFromHash'.
--
-- - Both of the 'TxSkelOutDatumHash' and 'TxSkelOutDatum' constructors will
--   create an output that scripts see on the 'Api.txInfo' as having a datum
--   hash. The difference is whether that hash will be resolvable using
--   validator functions like 'Api.findDatum'.
data TxSkelOutDatum where
  -- | use no datum
  TxSkelOutNoDatum :: TxSkelOutDatum
  -- | only include the hash on the transaction
  TxSkelOutDatumHash :: (TxSkelOutDatumConstrs a) => a -> TxSkelOutDatum
  -- | use a 'Api.OutputDatumHash' on the transaction output, but generate the
  -- transaction in such a way that the complete datum is included in the
  -- 'Api.txInfoData' seen by validators
  TxSkelOutDatum :: (TxSkelOutDatumConstrs a) => a -> TxSkelOutDatum
  -- | use an inline datum
  TxSkelOutInlineDatum :: (TxSkelOutDatumConstrs a) => a -> TxSkelOutDatum

deriving instance Show TxSkelOutDatum

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

instance Ord TxSkelOutDatum where
  compare :: TxSkelOutDatum -> TxSkelOutDatum -> Ordering
compare = ((TxSkelOutDatum, TxSkelOutDatum) -> Ordering)
-> TxSkelOutDatum -> TxSkelOutDatum -> Ordering
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((TxSkelOutDatum, TxSkelOutDatum) -> Ordering)
 -> TxSkelOutDatum -> TxSkelOutDatum -> Ordering)
-> ((TxSkelOutDatum, TxSkelOutDatum) -> Ordering)
-> TxSkelOutDatum
-> TxSkelOutDatum
-> Ordering
forall a b. (a -> b) -> a -> b
$ \case
    (TxSkelOutDatum
TxSkelOutNoDatum, TxSkelOutDatum
TxSkelOutNoDatum) -> Ordering
EQ
    (TxSkelOutDatumHash a
d1, TxSkelOutDatumHash a
d2) -> a -> a -> Ordering
forall {a} {a}.
(Typeable a, Typeable a, ToData a, ToData a) =>
a -> a -> Ordering
compareDats a
d1 a
d2
    (TxSkelOutDatum a
d1, TxSkelOutDatum a
d2) -> a -> a -> Ordering
forall {a} {a}.
(Typeable a, Typeable a, ToData a, ToData a) =>
a -> a -> Ordering
compareDats a
d1 a
d2
    (TxSkelOutInlineDatum a
d1, TxSkelOutInlineDatum a
d2) -> a -> a -> Ordering
forall {a} {a}.
(Typeable a, Typeable a, ToData a, ToData a) =>
a -> a -> Ordering
compareDats a
d1 a
d2
    (TxSkelOutDatumHash {}, TxSkelOutDatum
TxSkelOutNoDatum) -> Ordering
GT
    (TxSkelOutDatum {}, TxSkelOutDatum
TxSkelOutNoDatum) -> Ordering
GT
    (TxSkelOutDatum {}, TxSkelOutDatumHash {}) -> Ordering
GT
    (TxSkelOutInlineDatum {}, TxSkelOutDatum
_) -> Ordering
GT
    (TxSkelOutDatum
_, TxSkelOutDatum
_) -> Ordering
LT
    where
      compareDats :: a -> a -> Ordering
compareDats a
d1 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 Script.ToOutputDatum TxSkelOutDatum where
  toOutputDatum :: TxSkelOutDatum -> OutputDatum
toOutputDatum TxSkelOutDatum
TxSkelOutNoDatum = OutputDatum
Api.NoOutputDatum
  toOutputDatum (TxSkelOutDatumHash a
datum) = DatumHash -> OutputDatum
Api.OutputDatumHash (DatumHash -> OutputDatum) -> (a -> DatumHash) -> a -> OutputDatum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Datum -> DatumHash
Script.datumHash (Datum -> DatumHash) -> (a -> Datum) -> a -> DatumHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinData -> Datum
Api.Datum (BuiltinData -> Datum) -> (a -> BuiltinData) -> a -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> BuiltinData
forall a. ToData a => a -> BuiltinData
Api.toBuiltinData (a -> OutputDatum) -> a -> OutputDatum
forall a b. (a -> b) -> a -> b
$ a
datum
  toOutputDatum (TxSkelOutDatum a
datum) = DatumHash -> OutputDatum
Api.OutputDatumHash (DatumHash -> OutputDatum) -> (a -> DatumHash) -> a -> OutputDatum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Datum -> DatumHash
Script.datumHash (Datum -> DatumHash) -> (a -> Datum) -> a -> DatumHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinData -> Datum
Api.Datum (BuiltinData -> Datum) -> (a -> BuiltinData) -> a -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> BuiltinData
forall a. ToData a => a -> BuiltinData
Api.toBuiltinData (a -> OutputDatum) -> a -> OutputDatum
forall a b. (a -> b) -> a -> b
$ a
datum
  toOutputDatum (TxSkelOutInlineDatum a
datum) = Datum -> OutputDatum
Api.OutputDatum (Datum -> OutputDatum) -> (a -> Datum) -> a -> OutputDatum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinData -> Datum
Api.Datum (BuiltinData -> Datum) -> (a -> BuiltinData) -> a -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> BuiltinData
forall a. ToData a => a -> BuiltinData
Api.toBuiltinData (a -> OutputDatum) -> a -> OutputDatum
forall a b. (a -> b) -> a -> b
$ a
datum

-- | Converts a 'TxSkelOutDatum' into a possible Plutus datum
txSkelOutUntypedDatum :: TxSkelOutDatum -> Maybe Api.Datum
txSkelOutUntypedDatum :: TxSkelOutDatum -> Maybe Datum
txSkelOutUntypedDatum = \case
  TxSkelOutDatum
TxSkelOutNoDatum -> Maybe Datum
forall a. Maybe a
Nothing
  TxSkelOutDatumHash a
x -> Datum -> Maybe Datum
forall a. a -> Maybe a
Just (BuiltinData -> Datum
Api.Datum (BuiltinData -> Datum) -> BuiltinData -> Datum
forall a b. (a -> b) -> a -> b
$ a -> BuiltinData
forall a. ToData a => a -> BuiltinData
Api.toBuiltinData a
x)
  TxSkelOutDatum a
x -> Datum -> Maybe Datum
forall a. a -> Maybe a
Just (BuiltinData -> Datum
Api.Datum (BuiltinData -> Datum) -> BuiltinData -> Datum
forall a b. (a -> b) -> a -> b
$ a -> BuiltinData
forall a. ToData a => a -> BuiltinData
Api.toBuiltinData a
x)
  TxSkelOutInlineDatum a
x -> Datum -> Maybe Datum
forall a. a -> Maybe a
Just (BuiltinData -> Datum
Api.Datum (BuiltinData -> Datum) -> BuiltinData -> Datum
forall a b. (a -> b) -> a -> b
$ a -> BuiltinData
forall a. ToData a => a -> BuiltinData
Api.toBuiltinData a
x)

-- | Attempts to cast the content of this 'TxSkelOutDatum' to a given type
txSkelOutTypedDatum :: (Typeable a) => TxSkelOutDatum -> Maybe a
txSkelOutTypedDatum :: forall a. Typeable a => TxSkelOutDatum -> Maybe a
txSkelOutTypedDatum = \case
  TxSkelOutDatum
TxSkelOutNoDatum -> Maybe a
forall a. Maybe a
Nothing
  TxSkelOutDatumHash a
x -> a -> Maybe a
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
x
  TxSkelOutDatum a
x -> a -> Maybe a
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
x
  TxSkelOutInlineDatum a
x -> a -> Maybe a
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
x