{-# LANGUAGE GADTs                #-}
{-# LANGUAGE TypeApplications     #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -Wno-missing-import-lists #-}

module Plutus.Script.Utils.V2.Typed.Scripts
  ( module Plutus.Script.Utils.V2.Typed.Scripts.MonetaryPolicies
  , module Plutus.Script.Utils.V2.Typed.Scripts.StakeValidators
  , module Plutus.Script.Utils.V2.Typed.Scripts.Validators
  , Validator
  , MintingPolicy
  , StakeValidator
  , TypedScriptTxOut (..)
  , TypedScriptTxOutRef (..)
  , typeScriptTxOut
  , typeScriptTxOutRef
  , ConnectionError (..)
  )
where

import Control.Monad.Except (MonadError (throwError))
import Plutus.Script.Utils.Scripts (datumHash)
import Plutus.Script.Utils.V1.Typed.Scripts.Validators (ConnectionError (..))
import Plutus.Script.Utils.V1.Typed.Scripts.Validators qualified as V1
import Plutus.Script.Utils.V2.Typed.Scripts.MonetaryPolicies hiding (forwardToValidator)
import Plutus.Script.Utils.V2.Typed.Scripts.StakeValidators hiding (forwardToValidator)
import Plutus.Script.Utils.V2.Typed.Scripts.Validators
import Plutus.V2.Ledger.Api (Credential (PubKeyCredential, ScriptCredential), Datum, FromData, MintingPolicy,
                             OutputDatum (OutputDatum, OutputDatumHash), StakeValidator, ToData (..),
                             TxOut (txOutAddress, txOutDatum), TxOutRef, Validator, addressCredential)

--
-- | A 'TxOut' tagged by a phantom type: and the connection type of the output.
data TypedScriptTxOut a = (FromData (DatumType a), ToData (DatumType a)) =>
  TypedScriptTxOut
  { TypedScriptTxOut a -> TxOut
tyTxOutTxOut :: TxOut,
    TypedScriptTxOut a -> DatumType a
tyTxOutData  :: DatumType a
  }

instance Eq (DatumType a) => Eq (TypedScriptTxOut a) where
  TypedScriptTxOut a
l == :: TypedScriptTxOut a -> TypedScriptTxOut a -> Bool
== TypedScriptTxOut a
r =
    TypedScriptTxOut a -> TxOut
forall a. TypedScriptTxOut a -> TxOut
tyTxOutTxOut TypedScriptTxOut a
l TxOut -> TxOut -> Bool
forall a. Eq a => a -> a -> Bool
== TypedScriptTxOut a -> TxOut
forall a. TypedScriptTxOut a -> TxOut
tyTxOutTxOut TypedScriptTxOut a
r
      Bool -> Bool -> Bool
&& TypedScriptTxOut a -> DatumType a
forall a. TypedScriptTxOut a -> DatumType a
tyTxOutData TypedScriptTxOut a
l DatumType a -> DatumType a -> Bool
forall a. Eq a => a -> a -> Bool
== TypedScriptTxOut a -> DatumType a
forall a. TypedScriptTxOut a -> DatumType a
tyTxOutData TypedScriptTxOut a
r


-- | A 'TxOutRef' tagged by a phantom type: and the connection type of the output.
data TypedScriptTxOutRef a = TypedScriptTxOutRef
  { TypedScriptTxOutRef a -> TxOutRef
tyTxOutRefRef :: TxOutRef,
    TypedScriptTxOutRef a -> TypedScriptTxOut a
tyTxOutRefOut :: TypedScriptTxOut a
  }

instance Eq (DatumType a) => Eq (TypedScriptTxOutRef a) where
  TypedScriptTxOutRef a
l == :: TypedScriptTxOutRef a -> TypedScriptTxOutRef a -> Bool
== TypedScriptTxOutRef a
r =
    TypedScriptTxOutRef a -> TxOutRef
forall a. TypedScriptTxOutRef a -> TxOutRef
tyTxOutRefRef TypedScriptTxOutRef a
l TxOutRef -> TxOutRef -> Bool
forall a. Eq a => a -> a -> Bool
== TypedScriptTxOutRef a -> TxOutRef
forall a. TypedScriptTxOutRef a -> TxOutRef
tyTxOutRefRef TypedScriptTxOutRef a
r
      Bool -> Bool -> Bool
&& TypedScriptTxOutRef a -> TypedScriptTxOut a
forall a. TypedScriptTxOutRef a -> TypedScriptTxOut a
tyTxOutRefOut TypedScriptTxOutRef a
l TypedScriptTxOut a -> TypedScriptTxOut a -> Bool
forall a. Eq a => a -> a -> Bool
== TypedScriptTxOutRef a -> TypedScriptTxOut a
forall a. TypedScriptTxOutRef a -> TypedScriptTxOut a
tyTxOutRefOut TypedScriptTxOutRef a
r


-- | Create a 'TypedScriptTxOut' from an existing 'TxOut' by checking the types of its parts.
typeScriptTxOut ::
  forall out m.
  ( FromData (DatumType out),
    ToData (DatumType out),
    MonadError ConnectionError m
  ) =>
  TypedValidator out ->
  TxOutRef ->
  TxOut ->
  Datum ->
  m (TypedScriptTxOut out)
typeScriptTxOut :: TypedValidator out
-> TxOutRef -> TxOut -> Datum -> m (TypedScriptTxOut out)
typeScriptTxOut TypedValidator out
tv TxOutRef
txOutRef TxOut
txOut Datum
datum = do
  case Address -> Credential
addressCredential (TxOut -> Address
txOutAddress TxOut
txOut) of
    PubKeyCredential PubKeyHash
_ ->
      ConnectionError -> m (TypedScriptTxOut out)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ConnectionError -> m (TypedScriptTxOut out))
-> ConnectionError -> m (TypedScriptTxOut out)
forall a b. (a -> b) -> a -> b
$ WrongOutTypeError -> ConnectionError
V1.WrongOutType WrongOutTypeError
V1.ExpectedScriptGotPubkey
    ScriptCredential ValidatorHash
_vh ->
      case TxOut -> OutputDatum
txOutDatum TxOut
txOut of
        OutputDatum Datum
d | Datum -> DatumHash
datumHash Datum
datum DatumHash -> DatumHash -> Bool
forall a. Eq a => a -> a -> Bool
== Datum -> DatumHash
datumHash Datum
d -> do
          TypedValidator out -> Address -> m ()
forall a (m :: * -> *).
MonadError ConnectionError m =>
TypedValidator a -> Address -> m ()
V1.checkValidatorAddress TypedValidator out
tv (TxOut -> Address
txOutAddress TxOut
txOut)
          DatumType out
dsVal <- TypedValidator out -> Datum -> m (DatumType out)
forall a (m :: * -> *).
(FromData (DatumType a), MonadError ConnectionError m) =>
TypedValidator a -> Datum -> m (DatumType a)
V1.checkDatum TypedValidator out
tv Datum
datum
          TypedScriptTxOut out -> m (TypedScriptTxOut out)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypedScriptTxOut out -> m (TypedScriptTxOut out))
-> TypedScriptTxOut out -> m (TypedScriptTxOut out)
forall a b. (a -> b) -> a -> b
$ TxOut -> DatumType out -> TypedScriptTxOut out
forall a.
(FromData (DatumType a), ToData (DatumType a)) =>
TxOut -> DatumType a -> TypedScriptTxOut a
TypedScriptTxOut @out TxOut
txOut DatumType out
dsVal
        OutputDatumHash DatumHash
dh | Datum -> DatumHash
datumHash Datum
datum DatumHash -> DatumHash -> Bool
forall a. Eq a => a -> a -> Bool
== DatumHash
dh -> do
          TypedValidator out -> Address -> m ()
forall a (m :: * -> *).
MonadError ConnectionError m =>
TypedValidator a -> Address -> m ()
V1.checkValidatorAddress TypedValidator out
tv (TxOut -> Address
txOutAddress TxOut
txOut)
          DatumType out
dsVal <- TypedValidator out -> Datum -> m (DatumType out)
forall a (m :: * -> *).
(FromData (DatumType a), MonadError ConnectionError m) =>
TypedValidator a -> Datum -> m (DatumType a)
V1.checkDatum TypedValidator out
tv Datum
datum
          TypedScriptTxOut out -> m (TypedScriptTxOut out)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypedScriptTxOut out -> m (TypedScriptTxOut out))
-> TypedScriptTxOut out -> m (TypedScriptTxOut out)
forall a b. (a -> b) -> a -> b
$ TxOut -> DatumType out -> TypedScriptTxOut out
forall a.
(FromData (DatumType a), ToData (DatumType a)) =>
TxOut -> DatumType a -> TypedScriptTxOut a
TypedScriptTxOut @out TxOut
txOut DatumType out
dsVal
        OutputDatum
_ -> ConnectionError -> m (TypedScriptTxOut out)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ConnectionError -> m (TypedScriptTxOut out))
-> ConnectionError -> m (TypedScriptTxOut out)
forall a b. (a -> b) -> a -> b
$ TxOutRef -> DatumHash -> ConnectionError
V1.NoDatum TxOutRef
txOutRef (Datum -> DatumHash
datumHash Datum
datum)


-- | Create a 'TypedScriptTxOut' from an existing 'TxOut' by checking the types of its parts.
typeScriptTxOutRef ::
  forall out m.
  ( FromData (DatumType out),
    ToData (DatumType out),
    MonadError ConnectionError m
  ) =>
  TypedValidator out ->
  TxOutRef ->
  TxOut ->
  Datum ->
  m (TypedScriptTxOutRef out)
typeScriptTxOutRef :: TypedValidator out
-> TxOutRef -> TxOut -> Datum -> m (TypedScriptTxOutRef out)
typeScriptTxOutRef TypedValidator out
tv TxOutRef
txOutRef TxOut
txOut Datum
datum = do
  TypedScriptTxOut out
tyOut <- TypedValidator out
-> TxOutRef -> TxOut -> Datum -> m (TypedScriptTxOut out)
forall out (m :: * -> *).
(FromData (DatumType out), ToData (DatumType out),
 MonadError ConnectionError m) =>
TypedValidator out
-> TxOutRef -> TxOut -> Datum -> m (TypedScriptTxOut out)
typeScriptTxOut TypedValidator out
tv TxOutRef
txOutRef TxOut
txOut Datum
datum
  TypedScriptTxOutRef out -> m (TypedScriptTxOutRef out)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypedScriptTxOutRef out -> m (TypedScriptTxOutRef out))
-> TypedScriptTxOutRef out -> m (TypedScriptTxOutRef out)
forall a b. (a -> b) -> a -> b
$ TxOutRef -> TypedScriptTxOut out -> TypedScriptTxOutRef out
forall a. TxOutRef -> TypedScriptTxOut a -> TypedScriptTxOutRef a
TypedScriptTxOutRef TxOutRef
txOutRef TypedScriptTxOut out
tyOut