module Cardano.YTxP.Control.Yielding.Scripts (
  -- * RawScriptExport exporter
  scripts,

  -- * Plutarch validators
  yieldingV,
  yieldingMP,
  yieldingSV,
) where

import Cardano.YTxP.Control.Yielding.Helper (yieldingHelper)
import Data.Map (fromList)
import Data.Text (Text, unpack)
import Plutarch (Config)
import Plutarch.LedgerApi.V2 (PCurrencySymbol, PScriptContext)
import Ply (TypedScriptEnvelope)
import Ply.Plutarch.TypedWriter (TypedWriter, mkEnvelope)
import ScriptExport.ScriptInfo (RawScriptExport (RawScriptExport))

--------------------------------------------------------------------------------
-- Raw Script Export

{- | Exports the yielding validator, yielding minting policy and yielding staking validator
from a given Plutarch @Config@
-}
scripts :: Config -> RawScriptExport
scripts :: Config -> RawScriptExport
scripts Config
conf =
  Map Text TypedScriptEnvelope -> RawScriptExport
RawScriptExport (Map Text TypedScriptEnvelope -> RawScriptExport)
-> Map Text TypedScriptEnvelope -> RawScriptExport
forall a b. (a -> b) -> a -> b
$
    [(Text, TypedScriptEnvelope)] -> Map Text TypedScriptEnvelope
forall k a. Ord k => [(k, a)] -> Map k a
fromList
      [ Text
-> ClosedTerm
     (PCurrencySymbol
      :--> (PData :--> (PData :--> (PScriptContext :--> POpaque))))
-> (Text, TypedScriptEnvelope)
forall (pt :: S -> Type).
TypedWriter pt =>
Text -> ClosedTerm pt -> (Text, TypedScriptEnvelope)
envelope Text
"ytxp:yieldingValidator" Term
  s
  (PCurrencySymbol
   :--> (PData :--> (PData :--> (PScriptContext :--> POpaque))))
ClosedTerm
  (PCurrencySymbol
   :--> (PData :--> (PData :--> (PScriptContext :--> POpaque))))
yieldingV
      , Text
-> ClosedTerm
     (PCurrencySymbol
      :--> (PInteger :--> (PData :--> (PScriptContext :--> POpaque))))
-> (Text, TypedScriptEnvelope)
forall (pt :: S -> Type).
TypedWriter pt =>
Text -> ClosedTerm pt -> (Text, TypedScriptEnvelope)
envelope Text
"ytxp:yieldingMintingPolicy" Term
  s
  (PCurrencySymbol
   :--> (PInteger :--> (PData :--> (PScriptContext :--> POpaque))))
ClosedTerm
  (PCurrencySymbol
   :--> (PInteger :--> (PData :--> (PScriptContext :--> POpaque))))
yieldingMP
      , Text
-> ClosedTerm
     (PCurrencySymbol
      :--> (PInteger :--> (PData :--> (PScriptContext :--> POpaque))))
-> (Text, TypedScriptEnvelope)
forall (pt :: S -> Type).
TypedWriter pt =>
Text -> ClosedTerm pt -> (Text, TypedScriptEnvelope)
envelope Text
"ytxp:yieldingStakeValidator" Term
  s
  (PCurrencySymbol
   :--> (PInteger :--> (PData :--> (PScriptContext :--> POpaque))))
ClosedTerm
  (PCurrencySymbol
   :--> (PInteger :--> (PData :--> (PScriptContext :--> POpaque))))
yieldingSV
      ]
  where
    envelope ::
      forall (pt :: S -> Type).
      (TypedWriter pt) =>
      Text ->
      ClosedTerm pt ->
      (Text, TypedScriptEnvelope)
    envelope :: forall (pt :: S -> Type).
TypedWriter pt =>
Text -> ClosedTerm pt -> (Text, TypedScriptEnvelope)
envelope Text
d ClosedTerm pt
t = (Text
d, (Text -> TypedScriptEnvelope)
-> (TypedScriptEnvelope -> TypedScriptEnvelope)
-> Either Text TypedScriptEnvelope
-> TypedScriptEnvelope
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> TypedScriptEnvelope
forall a. HasCallStack => [Char] -> a
error ([Char] -> TypedScriptEnvelope)
-> (Text -> [Char]) -> Text -> TypedScriptEnvelope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
unpack) TypedScriptEnvelope -> TypedScriptEnvelope
forall a. a -> a
id (Either Text TypedScriptEnvelope -> TypedScriptEnvelope)
-> Either Text TypedScriptEnvelope -> TypedScriptEnvelope
forall a b. (a -> b) -> a -> b
$ Config -> Text -> ClosedTerm pt -> Either Text TypedScriptEnvelope
forall (ptype :: S -> Type).
TypedWriter ptype =>
Config
-> Text -> ClosedTerm ptype -> Either Text TypedScriptEnvelope
mkEnvelope Config
conf Text
d Term s pt
ClosedTerm pt
t)

--------------------------------------------------------------------------------
-- Plutarch level terms

-- | Yielding Validator
yieldingV ::
  forall (s :: S).
  Term
    s
    ( PCurrencySymbol :--> PData :--> PData :--> PScriptContext :--> POpaque
    )
yieldingV :: ClosedTerm
  (PCurrencySymbol
   :--> (PData :--> (PData :--> (PScriptContext :--> POpaque))))
yieldingV = (Term s PCurrencySymbol
 -> Term s PData
 -> Term s PData
 -> Term s PScriptContext
 -> Term s POpaque)
-> Term
     s
     (PCurrencySymbol
      :--> (PData :--> (PData :--> (PScriptContext :--> POpaque))))
forall a (b :: S -> Type) (s :: S) (c :: S -> Type).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
forall (c :: S -> Type).
HasCallStack =>
(Term s c
 -> Term s PData
 -> Term s PData
 -> Term s PScriptContext
 -> Term s POpaque)
-> Term
     s (c :--> (PData :--> (PData :--> (PScriptContext :--> POpaque))))
plam ((Term s PCurrencySymbol
  -> Term s PData
  -> Term s PData
  -> Term s PScriptContext
  -> Term s POpaque)
 -> Term
      s
      (PCurrencySymbol
       :--> (PData :--> (PData :--> (PScriptContext :--> POpaque)))))
-> (Term s PCurrencySymbol
    -> Term s PData
    -> Term s PData
    -> Term s PScriptContext
    -> Term s POpaque)
-> Term
     s
     (PCurrencySymbol
      :--> (PData :--> (PData :--> (PScriptContext :--> POpaque))))
forall a b. (a -> b) -> a -> b
$ \Term s PCurrencySymbol
psymbol Term s PData
_datum Term s PData
redeemer Term s PScriptContext
ctx ->
  Term
  s (PCurrencySymbol :--> (PData :--> (PScriptContext :--> POpaque)))
forall (s :: S).
Term
  s (PCurrencySymbol :--> (PData :--> (PScriptContext :--> POpaque)))
yieldingHelper Term
  s (PCurrencySymbol :--> (PData :--> (PScriptContext :--> POpaque)))
-> Term s PCurrencySymbol
-> Term s (PData :--> (PScriptContext :--> POpaque))
forall (s :: S) (a :: S -> Type) (b :: S -> Type).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PCurrencySymbol
psymbol Term s (PData :--> (PScriptContext :--> POpaque))
-> Term s PData -> Term s (PScriptContext :--> POpaque)
forall (s :: S) (a :: S -> Type) (b :: S -> Type).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PData
redeemer Term s (PScriptContext :--> POpaque)
-> Term s PScriptContext -> Term s POpaque
forall (s :: S) (a :: S -> Type) (b :: S -> Type).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PScriptContext
ctx

-- | Yielding Minting Policy
yieldingMP ::
  forall (s :: S).
  Term
    s
    ( PCurrencySymbol :--> PInteger :--> PData :--> PScriptContext :--> POpaque
    )
yieldingMP :: ClosedTerm
  (PCurrencySymbol
   :--> (PInteger :--> (PData :--> (PScriptContext :--> POpaque))))
yieldingMP = (Term s PCurrencySymbol
 -> Term s PInteger
 -> Term s PData
 -> Term s PScriptContext
 -> Term s POpaque)
-> Term
     s
     (PCurrencySymbol
      :--> (PInteger :--> (PData :--> (PScriptContext :--> POpaque))))
forall a (b :: S -> Type) (s :: S) (c :: S -> Type).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
forall (c :: S -> Type).
HasCallStack =>
(Term s c
 -> Term s PInteger
 -> Term s PData
 -> Term s PScriptContext
 -> Term s POpaque)
-> Term
     s
     (c :--> (PInteger :--> (PData :--> (PScriptContext :--> POpaque))))
plam ((Term s PCurrencySymbol
  -> Term s PInteger
  -> Term s PData
  -> Term s PScriptContext
  -> Term s POpaque)
 -> Term
      s
      (PCurrencySymbol
       :--> (PInteger :--> (PData :--> (PScriptContext :--> POpaque)))))
-> (Term s PCurrencySymbol
    -> Term s PInteger
    -> Term s PData
    -> Term s PScriptContext
    -> Term s POpaque)
-> Term
     s
     (PCurrencySymbol
      :--> (PInteger :--> (PData :--> (PScriptContext :--> POpaque))))
forall a b. (a -> b) -> a -> b
$ \Term s PCurrencySymbol
psymbol Term s PInteger
_nonce Term s PData
redeemer Term s PScriptContext
ctx ->
  Term
  s (PCurrencySymbol :--> (PData :--> (PScriptContext :--> POpaque)))
forall (s :: S).
Term
  s (PCurrencySymbol :--> (PData :--> (PScriptContext :--> POpaque)))
yieldingHelper Term
  s (PCurrencySymbol :--> (PData :--> (PScriptContext :--> POpaque)))
-> Term s PCurrencySymbol
-> Term s (PData :--> (PScriptContext :--> POpaque))
forall (s :: S) (a :: S -> Type) (b :: S -> Type).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PCurrencySymbol
psymbol Term s (PData :--> (PScriptContext :--> POpaque))
-> Term s PData -> Term s (PScriptContext :--> POpaque)
forall (s :: S) (a :: S -> Type) (b :: S -> Type).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PData
redeemer Term s (PScriptContext :--> POpaque)
-> Term s PScriptContext -> Term s POpaque
forall (s :: S) (a :: S -> Type) (b :: S -> Type).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PScriptContext
ctx

-- | Yielding Staking Validator
yieldingSV ::
  forall (s :: S).
  Term
    s
    ( PCurrencySymbol :--> PInteger :--> PData :--> PScriptContext :--> POpaque
    )
yieldingSV :: ClosedTerm
  (PCurrencySymbol
   :--> (PInteger :--> (PData :--> (PScriptContext :--> POpaque))))
yieldingSV = Term
  s
  (PCurrencySymbol
   :--> (PInteger :--> (PData :--> (PScriptContext :--> POpaque))))
ClosedTerm
  (PCurrencySymbol
   :--> (PInteger :--> (PData :--> (PScriptContext :--> POpaque))))
yieldingMP