{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Plutarch.Api.V1.Scripts (
  -- * Plutus API Types
  PDatum (PDatum),
  PDatumHash (PDatumHash),
  PRedeemer (PRedeemer),
  PRedeemerHash (PRedeemerHash),
  PScriptHash (PScriptHash),
) where

import PlutusLedgerApi.V1 qualified as Plutus

import Plutarch.Lift (
  DerivePConstantViaBuiltin (DerivePConstantViaBuiltin),
  PConstantDecl,
  PLifted,
  PUnsafeLiftDecl,
 )
import Plutarch.Prelude
import Plutarch.TryFrom (PTryFrom (PTryFromExcess, ptryFrom'))
import Plutarch.Unsafe (punsafeCoerce)

newtype PDatum (s :: S) = PDatum (Term s PData)
  deriving stock (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (s :: S) x. Rep (PDatum s) x -> PDatum s
forall (s :: S) x. PDatum s -> Rep (PDatum s) x
$cto :: forall (s :: S) x. Rep (PDatum s) x -> PDatum s
$cfrom :: forall (s :: S) x. PDatum s -> Rep (PDatum s) x
Generic)
  deriving anyclass (forall (s :: S). PDatum s -> Term s (PInner PDatum)
forall (s :: S) (b :: PType).
Term s (PInner PDatum) -> (PDatum s -> Term s b) -> Term s b
forall (a :: PType).
(forall (s :: S). a s -> Term s (PInner a))
-> (forall (s :: S) (b :: PType).
    Term s (PInner a) -> (a s -> Term s b) -> Term s b)
-> PlutusType a
pmatch' :: forall (s :: S) (b :: PType).
Term s (PInner PDatum) -> (PDatum s -> Term s b) -> Term s b
$cpmatch' :: forall (s :: S) (b :: PType).
Term s (PInner PDatum) -> (PDatum s -> Term s b) -> Term s b
pcon' :: forall (s :: S). PDatum s -> Term s (PInner PDatum)
$cpcon' :: forall (s :: S). PDatum s -> Term s (PInner PDatum)
PlutusType, forall (s :: S). Term s (PAsData PDatum) -> Term s PDatum
forall (s :: S). Term s PDatum -> Term s PData
forall (a :: PType).
(forall (s :: S). Term s (PAsData a) -> Term s a)
-> (forall (s :: S). Term s a -> Term s PData) -> PIsData a
pdataImpl :: forall (s :: S). Term s PDatum -> Term s PData
$cpdataImpl :: forall (s :: S). Term s PDatum -> Term s PData
pfromDataImpl :: forall (s :: S). Term s (PAsData PDatum) -> Term s PDatum
$cpfromDataImpl :: forall (s :: S). Term s (PAsData PDatum) -> Term s PDatum
PIsData, forall (s :: S). Term s PDatum -> Term s PDatum -> Term s PBool
forall (t :: PType).
(forall (s :: S). Term s t -> Term s t -> Term s PBool) -> PEq t
#== :: forall (s :: S). Term s PDatum -> Term s PDatum -> Term s PBool
$c#== :: forall (s :: S). Term s PDatum -> Term s PDatum -> Term s PBool
PEq, forall (s :: S). Bool -> Term s PDatum -> Term s PString
forall (t :: PType).
(forall (s :: S). Bool -> Term s t -> Term s PString) -> PShow t
pshow' :: forall (s :: S). Bool -> Term s PDatum -> Term s PString
$cpshow' :: forall (s :: S). Bool -> Term s PDatum -> Term s PString
PShow)
instance DerivePlutusType PDatum where type DPTStrat _ = PlutusTypeNewtype

instance PUnsafeLiftDecl PDatum where type PLifted PDatum = Plutus.Datum
deriving via (DerivePConstantViaBuiltin Plutus.Datum PDatum PData) instance PConstantDecl Plutus.Datum

newtype PRedeemer (s :: S) = PRedeemer (Term s PData)
  deriving stock (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (s :: S) x. Rep (PRedeemer s) x -> PRedeemer s
forall (s :: S) x. PRedeemer s -> Rep (PRedeemer s) x
$cto :: forall (s :: S) x. Rep (PRedeemer s) x -> PRedeemer s
$cfrom :: forall (s :: S) x. PRedeemer s -> Rep (PRedeemer s) x
Generic)
  deriving anyclass (forall (s :: S). PRedeemer s -> Term s (PInner PRedeemer)
forall (s :: S) (b :: PType).
Term s (PInner PRedeemer) -> (PRedeemer s -> Term s b) -> Term s b
forall (a :: PType).
(forall (s :: S). a s -> Term s (PInner a))
-> (forall (s :: S) (b :: PType).
    Term s (PInner a) -> (a s -> Term s b) -> Term s b)
-> PlutusType a
pmatch' :: forall (s :: S) (b :: PType).
Term s (PInner PRedeemer) -> (PRedeemer s -> Term s b) -> Term s b
$cpmatch' :: forall (s :: S) (b :: PType).
Term s (PInner PRedeemer) -> (PRedeemer s -> Term s b) -> Term s b
pcon' :: forall (s :: S). PRedeemer s -> Term s (PInner PRedeemer)
$cpcon' :: forall (s :: S). PRedeemer s -> Term s (PInner PRedeemer)
PlutusType, forall (s :: S). Term s (PAsData PRedeemer) -> Term s PRedeemer
forall (s :: S). Term s PRedeemer -> Term s PData
forall (a :: PType).
(forall (s :: S). Term s (PAsData a) -> Term s a)
-> (forall (s :: S). Term s a -> Term s PData) -> PIsData a
pdataImpl :: forall (s :: S). Term s PRedeemer -> Term s PData
$cpdataImpl :: forall (s :: S). Term s PRedeemer -> Term s PData
pfromDataImpl :: forall (s :: S). Term s (PAsData PRedeemer) -> Term s PRedeemer
$cpfromDataImpl :: forall (s :: S). Term s (PAsData PRedeemer) -> Term s PRedeemer
PIsData, forall (s :: S).
Term s PRedeemer -> Term s PRedeemer -> Term s PBool
forall (t :: PType).
(forall (s :: S). Term s t -> Term s t -> Term s PBool) -> PEq t
#== :: forall (s :: S).
Term s PRedeemer -> Term s PRedeemer -> Term s PBool
$c#== :: forall (s :: S).
Term s PRedeemer -> Term s PRedeemer -> Term s PBool
PEq, forall (s :: S). Bool -> Term s PRedeemer -> Term s PString
forall (t :: PType).
(forall (s :: S). Bool -> Term s t -> Term s PString) -> PShow t
pshow' :: forall (s :: S). Bool -> Term s PRedeemer -> Term s PString
$cpshow' :: forall (s :: S). Bool -> Term s PRedeemer -> Term s PString
PShow)
instance DerivePlutusType PRedeemer where type DPTStrat _ = PlutusTypeNewtype

instance PUnsafeLiftDecl PRedeemer where type PLifted PRedeemer = Plutus.Redeemer
deriving via (DerivePConstantViaBuiltin Plutus.Redeemer PRedeemer PData) instance PConstantDecl Plutus.Redeemer

newtype PDatumHash (s :: S) = PDatumHash (Term s PByteString)
  deriving stock (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (s :: S) x. Rep (PDatumHash s) x -> PDatumHash s
forall (s :: S) x. PDatumHash s -> Rep (PDatumHash s) x
$cto :: forall (s :: S) x. Rep (PDatumHash s) x -> PDatumHash s
$cfrom :: forall (s :: S) x. PDatumHash s -> Rep (PDatumHash s) x
Generic)
  deriving anyclass (forall (s :: S). PDatumHash s -> Term s (PInner PDatumHash)
forall (s :: S) (b :: PType).
Term s (PInner PDatumHash)
-> (PDatumHash s -> Term s b) -> Term s b
forall (a :: PType).
(forall (s :: S). a s -> Term s (PInner a))
-> (forall (s :: S) (b :: PType).
    Term s (PInner a) -> (a s -> Term s b) -> Term s b)
-> PlutusType a
pmatch' :: forall (s :: S) (b :: PType).
Term s (PInner PDatumHash)
-> (PDatumHash s -> Term s b) -> Term s b
$cpmatch' :: forall (s :: S) (b :: PType).
Term s (PInner PDatumHash)
-> (PDatumHash s -> Term s b) -> Term s b
pcon' :: forall (s :: S). PDatumHash s -> Term s (PInner PDatumHash)
$cpcon' :: forall (s :: S). PDatumHash s -> Term s (PInner PDatumHash)
PlutusType, forall (s :: S). Term s (PAsData PDatumHash) -> Term s PDatumHash
forall (s :: S). Term s PDatumHash -> Term s PData
forall (a :: PType).
(forall (s :: S). Term s (PAsData a) -> Term s a)
-> (forall (s :: S). Term s a -> Term s PData) -> PIsData a
pdataImpl :: forall (s :: S). Term s PDatumHash -> Term s PData
$cpdataImpl :: forall (s :: S). Term s PDatumHash -> Term s PData
pfromDataImpl :: forall (s :: S). Term s (PAsData PDatumHash) -> Term s PDatumHash
$cpfromDataImpl :: forall (s :: S). Term s (PAsData PDatumHash) -> Term s PDatumHash
PIsData, forall (s :: S).
Term s PDatumHash -> Term s PDatumHash -> Term s PBool
forall (t :: PType).
(forall (s :: S). Term s t -> Term s t -> Term s PBool) -> PEq t
#== :: forall (s :: S).
Term s PDatumHash -> Term s PDatumHash -> Term s PBool
$c#== :: forall (s :: S).
Term s PDatumHash -> Term s PDatumHash -> Term s PBool
PEq, PEq PDatumHash
forall (s :: S).
Term s PDatumHash -> Term s PDatumHash -> Term s PBool
forall (t :: PType).
PEq t
-> (forall (s :: S). Term s t -> Term s t -> Term s PBool)
-> (forall (s :: S). Term s t -> Term s t -> Term s PBool)
-> PPartialOrd t
#< :: forall (s :: S).
Term s PDatumHash -> Term s PDatumHash -> Term s PBool
$c#< :: forall (s :: S).
Term s PDatumHash -> Term s PDatumHash -> Term s PBool
#<= :: forall (s :: S).
Term s PDatumHash -> Term s PDatumHash -> Term s PBool
$c#<= :: forall (s :: S).
Term s PDatumHash -> Term s PDatumHash -> Term s PBool
PPartialOrd, PPartialOrd PDatumHash
forall (t :: PType). PPartialOrd t -> POrd t
POrd, forall (s :: S). Bool -> Term s PDatumHash -> Term s PString
forall (t :: PType).
(forall (s :: S). Bool -> Term s t -> Term s PString) -> PShow t
pshow' :: forall (s :: S). Bool -> Term s PDatumHash -> Term s PString
$cpshow' :: forall (s :: S). Bool -> Term s PDatumHash -> Term s PString
PShow)
instance DerivePlutusType PDatumHash where type DPTStrat _ = PlutusTypeNewtype

instance PUnsafeLiftDecl PDatumHash where type PLifted PDatumHash = Plutus.DatumHash
deriving via (DerivePConstantViaBuiltin Plutus.DatumHash PDatumHash PByteString) instance PConstantDecl Plutus.DatumHash

newtype PRedeemerHash (s :: S) = PRedeemerHash (Term s PByteString)
  deriving stock (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (s :: S) x. Rep (PRedeemerHash s) x -> PRedeemerHash s
forall (s :: S) x. PRedeemerHash s -> Rep (PRedeemerHash s) x
$cto :: forall (s :: S) x. Rep (PRedeemerHash s) x -> PRedeemerHash s
$cfrom :: forall (s :: S) x. PRedeemerHash s -> Rep (PRedeemerHash s) x
Generic)
  deriving anyclass (forall (s :: S). PRedeemerHash s -> Term s (PInner PRedeemerHash)
forall (s :: S) (b :: PType).
Term s (PInner PRedeemerHash)
-> (PRedeemerHash s -> Term s b) -> Term s b
forall (a :: PType).
(forall (s :: S). a s -> Term s (PInner a))
-> (forall (s :: S) (b :: PType).
    Term s (PInner a) -> (a s -> Term s b) -> Term s b)
-> PlutusType a
pmatch' :: forall (s :: S) (b :: PType).
Term s (PInner PRedeemerHash)
-> (PRedeemerHash s -> Term s b) -> Term s b
$cpmatch' :: forall (s :: S) (b :: PType).
Term s (PInner PRedeemerHash)
-> (PRedeemerHash s -> Term s b) -> Term s b
pcon' :: forall (s :: S). PRedeemerHash s -> Term s (PInner PRedeemerHash)
$cpcon' :: forall (s :: S). PRedeemerHash s -> Term s (PInner PRedeemerHash)
PlutusType, forall (s :: S).
Term s (PAsData PRedeemerHash) -> Term s PRedeemerHash
forall (s :: S). Term s PRedeemerHash -> Term s PData
forall (a :: PType).
(forall (s :: S). Term s (PAsData a) -> Term s a)
-> (forall (s :: S). Term s a -> Term s PData) -> PIsData a
pdataImpl :: forall (s :: S). Term s PRedeemerHash -> Term s PData
$cpdataImpl :: forall (s :: S). Term s PRedeemerHash -> Term s PData
pfromDataImpl :: forall (s :: S).
Term s (PAsData PRedeemerHash) -> Term s PRedeemerHash
$cpfromDataImpl :: forall (s :: S).
Term s (PAsData PRedeemerHash) -> Term s PRedeemerHash
PIsData, forall (s :: S).
Term s PRedeemerHash -> Term s PRedeemerHash -> Term s PBool
forall (t :: PType).
(forall (s :: S). Term s t -> Term s t -> Term s PBool) -> PEq t
#== :: forall (s :: S).
Term s PRedeemerHash -> Term s PRedeemerHash -> Term s PBool
$c#== :: forall (s :: S).
Term s PRedeemerHash -> Term s PRedeemerHash -> Term s PBool
PEq, PEq PRedeemerHash
forall (s :: S).
Term s PRedeemerHash -> Term s PRedeemerHash -> Term s PBool
forall (t :: PType).
PEq t
-> (forall (s :: S). Term s t -> Term s t -> Term s PBool)
-> (forall (s :: S). Term s t -> Term s t -> Term s PBool)
-> PPartialOrd t
#< :: forall (s :: S).
Term s PRedeemerHash -> Term s PRedeemerHash -> Term s PBool
$c#< :: forall (s :: S).
Term s PRedeemerHash -> Term s PRedeemerHash -> Term s PBool
#<= :: forall (s :: S).
Term s PRedeemerHash -> Term s PRedeemerHash -> Term s PBool
$c#<= :: forall (s :: S).
Term s PRedeemerHash -> Term s PRedeemerHash -> Term s PBool
PPartialOrd, PPartialOrd PRedeemerHash
forall (t :: PType). PPartialOrd t -> POrd t
POrd, forall (s :: S). Bool -> Term s PRedeemerHash -> Term s PString
forall (t :: PType).
(forall (s :: S). Bool -> Term s t -> Term s PString) -> PShow t
pshow' :: forall (s :: S). Bool -> Term s PRedeemerHash -> Term s PString
$cpshow' :: forall (s :: S). Bool -> Term s PRedeemerHash -> Term s PString
PShow)
instance DerivePlutusType PRedeemerHash where type DPTStrat _ = PlutusTypeNewtype

instance PUnsafeLiftDecl PRedeemerHash where type PLifted PRedeemerHash = Plutus.RedeemerHash
deriving via
  (DerivePConstantViaBuiltin Plutus.RedeemerHash PRedeemerHash PByteString)
  instance
    PConstantDecl Plutus.RedeemerHash

newtype PScriptHash (s :: S) = PScriptHash (Term s PByteString)
  deriving stock (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (s :: S) x. Rep (PScriptHash s) x -> PScriptHash s
forall (s :: S) x. PScriptHash s -> Rep (PScriptHash s) x
$cto :: forall (s :: S) x. Rep (PScriptHash s) x -> PScriptHash s
$cfrom :: forall (s :: S) x. PScriptHash s -> Rep (PScriptHash s) x
Generic)
  deriving anyclass (forall (s :: S). PScriptHash s -> Term s (PInner PScriptHash)
forall (s :: S) (b :: PType).
Term s (PInner PScriptHash)
-> (PScriptHash s -> Term s b) -> Term s b
forall (a :: PType).
(forall (s :: S). a s -> Term s (PInner a))
-> (forall (s :: S) (b :: PType).
    Term s (PInner a) -> (a s -> Term s b) -> Term s b)
-> PlutusType a
pmatch' :: forall (s :: S) (b :: PType).
Term s (PInner PScriptHash)
-> (PScriptHash s -> Term s b) -> Term s b
$cpmatch' :: forall (s :: S) (b :: PType).
Term s (PInner PScriptHash)
-> (PScriptHash s -> Term s b) -> Term s b
pcon' :: forall (s :: S). PScriptHash s -> Term s (PInner PScriptHash)
$cpcon' :: forall (s :: S). PScriptHash s -> Term s (PInner PScriptHash)
PlutusType, forall (s :: S). Term s (PAsData PScriptHash) -> Term s PScriptHash
forall (s :: S). Term s PScriptHash -> Term s PData
forall (a :: PType).
(forall (s :: S). Term s (PAsData a) -> Term s a)
-> (forall (s :: S). Term s a -> Term s PData) -> PIsData a
pdataImpl :: forall (s :: S). Term s PScriptHash -> Term s PData
$cpdataImpl :: forall (s :: S). Term s PScriptHash -> Term s PData
pfromDataImpl :: forall (s :: S). Term s (PAsData PScriptHash) -> Term s PScriptHash
$cpfromDataImpl :: forall (s :: S). Term s (PAsData PScriptHash) -> Term s PScriptHash
PIsData, forall (s :: S).
Term s PScriptHash -> Term s PScriptHash -> Term s PBool
forall (t :: PType).
(forall (s :: S). Term s t -> Term s t -> Term s PBool) -> PEq t
#== :: forall (s :: S).
Term s PScriptHash -> Term s PScriptHash -> Term s PBool
$c#== :: forall (s :: S).
Term s PScriptHash -> Term s PScriptHash -> Term s PBool
PEq, PEq PScriptHash
forall (s :: S).
Term s PScriptHash -> Term s PScriptHash -> Term s PBool
forall (t :: PType).
PEq t
-> (forall (s :: S). Term s t -> Term s t -> Term s PBool)
-> (forall (s :: S). Term s t -> Term s t -> Term s PBool)
-> PPartialOrd t
#< :: forall (s :: S).
Term s PScriptHash -> Term s PScriptHash -> Term s PBool
$c#< :: forall (s :: S).
Term s PScriptHash -> Term s PScriptHash -> Term s PBool
#<= :: forall (s :: S).
Term s PScriptHash -> Term s PScriptHash -> Term s PBool
$c#<= :: forall (s :: S).
Term s PScriptHash -> Term s PScriptHash -> Term s PBool
PPartialOrd, PPartialOrd PScriptHash
forall (t :: PType). PPartialOrd t -> POrd t
POrd, forall (s :: S). Bool -> Term s PScriptHash -> Term s PString
forall (t :: PType).
(forall (s :: S). Bool -> Term s t -> Term s PString) -> PShow t
pshow' :: forall (s :: S). Bool -> Term s PScriptHash -> Term s PString
$cpshow' :: forall (s :: S). Bool -> Term s PScriptHash -> Term s PString
PShow)
instance DerivePlutusType PScriptHash where type DPTStrat _ = PlutusTypeNewtype

instance PUnsafeLiftDecl PScriptHash where type PLifted PScriptHash = Plutus.ScriptHash
deriving via
  (DerivePConstantViaBuiltin Plutus.ScriptHash PScriptHash PByteString)
  instance
    PConstantDecl Plutus.ScriptHash

instance PTryFrom PData (PAsData PScriptHash) where
  type PTryFromExcess PData (PAsData PScriptHash) = Flip Term PScriptHash
  ptryFrom' :: forall (s :: S) (r :: PType).
Term s PData
-> ((Term s (PAsData PScriptHash),
     Reduce (PTryFromExcess PData (PAsData PScriptHash) s))
    -> Term s r)
-> Term s r
ptryFrom' Term s PData
opq = forall (r :: PType) (s :: S) a.
TermCont @r s a -> (a -> Term s r) -> Term s r
runTermCont forall a b. (a -> b) -> a -> b
$ do
    Term s PByteString
unwrapped <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet forall a b. (a -> b) -> a -> b
$ forall (b :: PType) (a :: PType) (s :: S) (r :: PType).
PTryFrom a b =>
Term s a
-> ((Term s b, Reduce (PTryFromExcess a b s)) -> Term s r)
-> Term s r
ptryFrom @(PAsData PByteString) Term s PData
opq forall a b. (a, b) -> b
snd
    forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall a b. (a -> b) -> a -> b
$ \() -> Term s r
f ->
      forall (s :: S) (a :: PType).
Term s PBool -> Term s a -> Term s a -> Term s a
pif (forall (s :: S). Term s (PByteString :--> PInteger)
plengthBS forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PByteString
unwrapped forall (t :: PType) (s :: S).
PEq t =>
Term s t -> Term s t -> Term s PBool
#== Term s PInteger
28) (() -> Term s r
f ()) (forall (s :: S) (a :: PType). Term s PString -> Term s a
ptraceError Term s PString
"ptryFrom(PScriptHash): must be 28 bytes long")
    forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (forall (s :: S) (a :: PType) (b :: PType). Term s a -> Term s b
punsafeCoerce Term s PData
opq, forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: S). Term s PByteString -> PScriptHash s
PScriptHash forall a b. (a -> b) -> a -> b
$ Term s PByteString
unwrapped)

newtype Flip f a b = Flip (f b a) deriving stock (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k k (f :: k -> k -> Type) (a :: k) (b :: k) x.
Rep (Flip @k @k f a b) x -> Flip @k @k f a b
forall k k (f :: k -> k -> Type) (a :: k) (b :: k) x.
Flip @k @k f a b -> Rep (Flip @k @k f a b) x
$cto :: forall k k (f :: k -> k -> Type) (a :: k) (b :: k) x.
Rep (Flip @k @k f a b) x -> Flip @k @k f a b
$cfrom :: forall k k (f :: k -> k -> Type) (a :: k) (b :: k) x.
Flip @k @k f a b -> Rep (Flip @k @k f a b) x
Generic)