{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}

module Cardano.Api.Experimental.Tx.Internal.AnyWitness
  ( -- * Any witness (key, simple script, plutus script).
    AnyWitness (..)
  , anyScriptWitnessToAnyWitness
  , getAnyWitnessScript
  , getAnyWitnessSimpleScript
  , getAnyWitnessPlutusLanguage
  , getAnyWitnessReferenceInput
  , getAnyWitnessScriptData
  , getPlutusDatum
  )
where

import Cardano.Api.Experimental.AnyScriptWitness
import Cardano.Api.Experimental.Plutus.Internal.ScriptWitness
import Cardano.Api.Experimental.Simple.Script
  ( SimpleScript (SimpleScript)
  , SimpleScriptOrReferenceInput (..)
  )
import Cardano.Api.Internal.Orphans.Misc ()
import Cardano.Api.Ledger.Internal.Reexport qualified as L
import Cardano.Api.Plutus.Internal.ScriptData
import Cardano.Api.Tx.Internal.TxIn

import Cardano.Ledger.Core qualified as L

import Data.Type.Equality

-- | Here we consider three types of witnesses in Cardano:
-- * key witnesses
-- * simple script witnesses
-- * Plutus script witnesses
--
-- Note that 'AnyKeyWitnessPlaceholder' does not contain the actual key witness. This is because
-- key witnesses are provided in the signing stage of the transaction. However we need this constuctor
-- to index the witnessable things correctly when plutus scripts are being used within the transaction.
-- AnyWitness is solely used to contruct the transaction body.
data AnyWitness era where
  AnyKeyWitnessPlaceholder :: AnyWitness era
  AnySimpleScriptWitness :: SimpleScriptOrReferenceInput era -> AnyWitness era
  AnyPlutusScriptWitness :: AnyPlutusScriptWitness lang purpose era -> AnyWitness era

deriving instance Show (AnyWitness era)

instance Eq (AnyWitness era) where
  AnyWitness era
AnyKeyWitnessPlaceholder == :: AnyWitness era -> AnyWitness era -> Bool
== AnyWitness era
AnyKeyWitnessPlaceholder = Bool
True
  (AnySimpleScriptWitness SimpleScriptOrReferenceInput era
s1) == (AnySimpleScriptWitness SimpleScriptOrReferenceInput era
s2) = SimpleScriptOrReferenceInput era
s1 SimpleScriptOrReferenceInput era
-> SimpleScriptOrReferenceInput era -> Bool
forall a. Eq a => a -> a -> Bool
== SimpleScriptOrReferenceInput era
s2
  (AnyPlutusScriptWitness (AnyPlutusSpendingScriptWitness PlutusSpendingScriptWitness era
s1)) == (AnyPlutusScriptWitness (AnyPlutusSpendingScriptWitness PlutusSpendingScriptWitness era
s2)) =
    PlutusSpendingScriptWitness era
s1 PlutusSpendingScriptWitness era
-> PlutusSpendingScriptWitness era -> Bool
forall a. Eq a => a -> a -> Bool
== PlutusSpendingScriptWitness era
s2
  (AnyPlutusScriptWitness (AnyPlutusMintingScriptWitness PlutusScriptWitness lang 'MintingScript era
s1)) == (AnyPlutusScriptWitness (AnyPlutusMintingScriptWitness PlutusScriptWitness lang 'MintingScript era
s2)) =
    case PlutusScriptWitness lang 'MintingScript era
-> PlutusScriptWitness lang 'MintingScript era
-> Maybe (lang :~: lang)
forall (langA :: Language) (langB :: Language)
       (purpose :: PlutusScriptPurpose) era.
(Typeable langA, Typeable langB) =>
PlutusScriptWitness langA purpose era
-> PlutusScriptWitness langB purpose era -> Maybe (langA :~: langB)
langTypeEquality PlutusScriptWitness lang 'MintingScript era
s1 PlutusScriptWitness lang 'MintingScript era
s2 of
      Just lang :~: lang
Refl -> PlutusScriptWitness lang 'MintingScript era
s1 PlutusScriptWitness lang 'MintingScript era
-> PlutusScriptWitness lang 'MintingScript era -> Bool
forall a. Eq a => a -> a -> Bool
== PlutusScriptWitness lang 'MintingScript era
PlutusScriptWitness lang 'MintingScript era
s2
      Maybe (lang :~: lang)
Nothing -> Bool
False
  (AnyPlutusScriptWitness (AnyPlutusWithdrawingScriptWitness PlutusScriptWitness lang 'WithdrawingScript era
s1)) == (AnyPlutusScriptWitness (AnyPlutusWithdrawingScriptWitness PlutusScriptWitness lang 'WithdrawingScript era
s2)) =
    case PlutusScriptWitness lang 'WithdrawingScript era
-> PlutusScriptWitness lang 'WithdrawingScript era
-> Maybe (lang :~: lang)
forall (langA :: Language) (langB :: Language)
       (purpose :: PlutusScriptPurpose) era.
(Typeable langA, Typeable langB) =>
PlutusScriptWitness langA purpose era
-> PlutusScriptWitness langB purpose era -> Maybe (langA :~: langB)
langTypeEquality PlutusScriptWitness lang 'WithdrawingScript era
s1 PlutusScriptWitness lang 'WithdrawingScript era
s2 of
      Just lang :~: lang
Refl -> PlutusScriptWitness lang 'WithdrawingScript era
s1 PlutusScriptWitness lang 'WithdrawingScript era
-> PlutusScriptWitness lang 'WithdrawingScript era -> Bool
forall a. Eq a => a -> a -> Bool
== PlutusScriptWitness lang 'WithdrawingScript era
PlutusScriptWitness lang 'WithdrawingScript era
s2
      Maybe (lang :~: lang)
Nothing -> Bool
False
  AnyPlutusScriptWitness (AnyPlutusCertifyingScriptWitness PlutusScriptWitness lang 'CertifyingScript era
s1) == (AnyPlutusScriptWitness (AnyPlutusCertifyingScriptWitness PlutusScriptWitness lang 'CertifyingScript era
s2)) =
    case PlutusScriptWitness lang 'CertifyingScript era
-> PlutusScriptWitness lang 'CertifyingScript era
-> Maybe (lang :~: lang)
forall (langA :: Language) (langB :: Language)
       (purpose :: PlutusScriptPurpose) era.
(Typeable langA, Typeable langB) =>
PlutusScriptWitness langA purpose era
-> PlutusScriptWitness langB purpose era -> Maybe (langA :~: langB)
langTypeEquality PlutusScriptWitness lang 'CertifyingScript era
s1 PlutusScriptWitness lang 'CertifyingScript era
s2 of
      Just lang :~: lang
Refl -> PlutusScriptWitness lang 'CertifyingScript era
s1 PlutusScriptWitness lang 'CertifyingScript era
-> PlutusScriptWitness lang 'CertifyingScript era -> Bool
forall a. Eq a => a -> a -> Bool
== PlutusScriptWitness lang 'CertifyingScript era
PlutusScriptWitness lang 'CertifyingScript era
s2
      Maybe (lang :~: lang)
Nothing -> Bool
False
  AnyPlutusScriptWitness (AnyPlutusProposingScriptWitness PlutusScriptWitness lang 'ProposingScript era
s1) == (AnyPlutusScriptWitness (AnyPlutusProposingScriptWitness PlutusScriptWitness lang 'ProposingScript era
s2)) =
    case PlutusScriptWitness lang 'ProposingScript era
-> PlutusScriptWitness lang 'ProposingScript era
-> Maybe (lang :~: lang)
forall (langA :: Language) (langB :: Language)
       (purpose :: PlutusScriptPurpose) era.
(Typeable langA, Typeable langB) =>
PlutusScriptWitness langA purpose era
-> PlutusScriptWitness langB purpose era -> Maybe (langA :~: langB)
langTypeEquality PlutusScriptWitness lang 'ProposingScript era
s1 PlutusScriptWitness lang 'ProposingScript era
s2 of
      Just lang :~: lang
Refl -> PlutusScriptWitness lang 'ProposingScript era
s1 PlutusScriptWitness lang 'ProposingScript era
-> PlutusScriptWitness lang 'ProposingScript era -> Bool
forall a. Eq a => a -> a -> Bool
== PlutusScriptWitness lang 'ProposingScript era
PlutusScriptWitness lang 'ProposingScript era
s2
      Maybe (lang :~: lang)
Nothing -> Bool
False
  AnyPlutusScriptWitness (AnyPlutusVotingScriptWitness PlutusScriptWitness lang 'VotingScript era
s1) == (AnyPlutusScriptWitness (AnyPlutusVotingScriptWitness PlutusScriptWitness lang 'VotingScript era
s2)) =
    case PlutusScriptWitness lang 'VotingScript era
-> PlutusScriptWitness lang 'VotingScript era
-> Maybe (lang :~: lang)
forall (langA :: Language) (langB :: Language)
       (purpose :: PlutusScriptPurpose) era.
(Typeable langA, Typeable langB) =>
PlutusScriptWitness langA purpose era
-> PlutusScriptWitness langB purpose era -> Maybe (langA :~: langB)
langTypeEquality PlutusScriptWitness lang 'VotingScript era
s1 PlutusScriptWitness lang 'VotingScript era
s2 of
      Just lang :~: lang
Refl -> PlutusScriptWitness lang 'VotingScript era
s1 PlutusScriptWitness lang 'VotingScript era
-> PlutusScriptWitness lang 'VotingScript era -> Bool
forall a. Eq a => a -> a -> Bool
== PlutusScriptWitness lang 'VotingScript era
PlutusScriptWitness lang 'VotingScript era
s2
      Maybe (lang :~: lang)
Nothing -> Bool
False
  AnyWitness era
_ == AnyWitness era
_ = Bool
False

getAnyWitnessPlutusLanguage :: AnyWitness era -> Maybe L.Language
getAnyWitnessPlutusLanguage :: forall era. AnyWitness era -> Maybe Language
getAnyWitnessPlutusLanguage AnyWitness era
AnyKeyWitnessPlaceholder = Maybe Language
forall a. Maybe a
Nothing
getAnyWitnessPlutusLanguage (AnySimpleScriptWitness SimpleScriptOrReferenceInput era
_) = Maybe Language
forall a. Maybe a
Nothing
getAnyWitnessPlutusLanguage (AnyPlutusScriptWitness AnyPlutusScriptWitness lang purpose era
swit) = Language -> Maybe Language
forall a. a -> Maybe a
Just (Language -> Maybe Language) -> Language -> Maybe Language
forall a b. (a -> b) -> a -> b
$ AnyPlutusScriptWitness lang purpose era -> Language
forall (lang :: Language) (purpose :: PlutusScriptPurpose) era.
AnyPlutusScriptWitness lang purpose era -> Language
getAnyPlutusScriptWitnessLanguage AnyPlutusScriptWitness lang purpose era
swit

getAnyWitnessSimpleScript
  :: AnyWitness era -> Maybe (L.Script era)
getAnyWitnessSimpleScript :: forall era. AnyWitness era -> Maybe (Script era)
getAnyWitnessSimpleScript AnyWitness era
AnyKeyWitnessPlaceholder = Maybe (Script era)
forall a. Maybe a
Nothing
getAnyWitnessSimpleScript (AnySimpleScriptWitness SimpleScriptOrReferenceInput era
simpleScriptOrRefInput) =
  case SimpleScriptOrReferenceInput era
simpleScriptOrRefInput of
    SScript (SimpleScript NativeScript era
simpleScript) -> Script era -> Maybe (Script era)
forall a. a -> Maybe a
Just (Script era -> Maybe (Script era))
-> Script era -> Maybe (Script era)
forall a b. (a -> b) -> a -> b
$ NativeScript era -> Script era
forall era. EraScript era => NativeScript era -> Script era
L.fromNativeScript NativeScript era
simpleScript
    SReferenceScript{} -> Maybe (Script era)
forall a. Maybe a
Nothing
getAnyWitnessSimpleScript (AnyPlutusScriptWitness AnyPlutusScriptWitness lang purpose era
_) = Maybe (Script era)
forall a. Maybe a
Nothing

getAnyWitnessPlutusScript
  :: L.AlonzoEraScript era
  => AnyWitness era
  -> Maybe (L.Script era)
getAnyWitnessPlutusScript :: forall era.
AlonzoEraScript era =>
AnyWitness era -> Maybe (Script era)
getAnyWitnessPlutusScript AnyWitness era
AnyKeyWitnessPlaceholder = Maybe (Script era)
forall a. Maybe a
Nothing
getAnyWitnessPlutusScript (AnySimpleScriptWitness SimpleScriptOrReferenceInput era
_) = Maybe (Script era)
forall a. Maybe a
Nothing
getAnyWitnessPlutusScript
  ( AnyPlutusScriptWitness
      AnyPlutusScriptWitness lang purpose era
s
    ) = AnyPlutusScriptWitness lang purpose era -> Maybe (Script era)
forall era (lang :: Language) (purpose :: PlutusScriptPurpose).
AlonzoEraScript era =>
AnyPlutusScriptWitness lang purpose era -> Maybe (Script era)
getAnyPlutusWitnessPlutusScript AnyPlutusScriptWitness lang purpose era
s

getAnyWitnessReferenceInput :: AnyWitness era -> Maybe TxIn
getAnyWitnessReferenceInput :: forall era. AnyWitness era -> Maybe TxIn
getAnyWitnessReferenceInput AnyWitness era
AnyKeyWitnessPlaceholder = Maybe TxIn
forall a. Maybe a
Nothing
getAnyWitnessReferenceInput (AnySimpleScriptWitness (SReferenceScript TxIn
txIn)) = TxIn -> Maybe TxIn
forall a. a -> Maybe a
Just TxIn
txIn
getAnyWitnessReferenceInput (AnySimpleScriptWitness (SScript SimpleScript era
_)) = Maybe TxIn
forall a. Maybe a
Nothing
getAnyWitnessReferenceInput (AnyPlutusScriptWitness AnyPlutusScriptWitness lang purpose era
s) =
  AnyPlutusScriptWitness lang purpose era -> Maybe TxIn
forall (lang :: Language) (purpose :: PlutusScriptPurpose) era.
AnyPlutusScriptWitness lang purpose era -> Maybe TxIn
getAnyPlutusScriptWitnessReferenceInput AnyPlutusScriptWitness lang purpose era
s

-- | NB this does not include datums from inline datums existing at tx outputs!
getAnyWitnessScriptData
  :: L.Era era => AnyWitness era -> L.TxDats era
getAnyWitnessScriptData :: forall era. Era era => AnyWitness era -> TxDats era
getAnyWitnessScriptData AnyWitness era
AnyKeyWitnessPlaceholder = TxDats era
forall a. Monoid a => a
mempty
getAnyWitnessScriptData AnySimpleScriptWitness{} = TxDats era
forall a. Monoid a => a
mempty
getAnyWitnessScriptData (AnyPlutusScriptWitness AnyPlutusScriptWitness lang purpose era
s) = AnyPlutusScriptWitness lang purpose era -> TxDats era
forall era (lang :: Language) (purpose :: PlutusScriptPurpose).
Era era =>
AnyPlutusScriptWitness lang purpose era -> TxDats era
getAnyPlutusScriptData AnyPlutusScriptWitness lang purpose era
s

getAnyWitnessScript
  :: L.AlonzoEraScript era => AnyWitness era -> Maybe (L.Script era)
getAnyWitnessScript :: forall era.
AlonzoEraScript era =>
AnyWitness era -> Maybe (Script era)
getAnyWitnessScript AnyWitness era
AnyKeyWitnessPlaceholder = Maybe (Script era)
forall a. Maybe a
Nothing
getAnyWitnessScript ss :: AnyWitness era
ss@(AnySimpleScriptWitness{}) = AnyWitness era -> Maybe (Script era)
forall era. AnyWitness era -> Maybe (Script era)
getAnyWitnessSimpleScript AnyWitness era
ss
getAnyWitnessScript ps :: AnyWitness era
ps@(AnyPlutusScriptWitness{}) = AnyWitness era -> Maybe (Script era)
forall era.
AlonzoEraScript era =>
AnyWitness era -> Maybe (Script era)
getAnyWitnessPlutusScript AnyWitness era
ps

getPlutusDatum
  :: L.SLanguage lang -> PlutusScriptDatum lang purpose -> Maybe HashableScriptData
getPlutusDatum :: forall (lang :: Language) (purpose :: PlutusScriptPurpose).
SLanguage lang
-> PlutusScriptDatum lang purpose -> Maybe HashableScriptData
getPlutusDatum SLanguage lang
L.SPlutusV1 (SpendingScriptDatum PlutusScriptDatumF lang 'SpendingScript
d) = HashableScriptData -> Maybe HashableScriptData
forall a. a -> Maybe a
Just HashableScriptData
PlutusScriptDatumF lang 'SpendingScript
d
getPlutusDatum SLanguage lang
L.SPlutusV2 (SpendingScriptDatum PlutusScriptDatumF lang 'SpendingScript
d) = HashableScriptData -> Maybe HashableScriptData
forall a. a -> Maybe a
Just HashableScriptData
PlutusScriptDatumF lang 'SpendingScript
d
getPlutusDatum SLanguage lang
L.SPlutusV3 (SpendingScriptDatum PlutusScriptDatumF lang 'SpendingScript
d) = Maybe HashableScriptData
PlutusScriptDatumF lang 'SpendingScript
d
getPlutusDatum SLanguage lang
L.SPlutusV4 (SpendingScriptDatum PlutusScriptDatumF lang 'SpendingScript
_d) = String -> Maybe HashableScriptData
forall a. HasCallStack => String -> a
error String
"dijkstra"
getPlutusDatum SLanguage lang
_ PlutusScriptDatum lang purpose
InlineDatum = Maybe HashableScriptData
forall a. Maybe a
Nothing
getPlutusDatum SLanguage lang
_ PlutusScriptDatum lang purpose
NoScriptDatum = Maybe HashableScriptData
forall a. Maybe a
Nothing

anyScriptWitnessToAnyWitness
  :: AnyScriptWitness era
  -> AnyWitness era
anyScriptWitnessToAnyWitness :: forall era. AnyScriptWitness era -> AnyWitness era
anyScriptWitnessToAnyWitness (AnyScriptWitnessSimple SimpleScriptOrReferenceInput era
s) = SimpleScriptOrReferenceInput era -> AnyWitness era
forall era. SimpleScriptOrReferenceInput era -> AnyWitness era
AnySimpleScriptWitness SimpleScriptOrReferenceInput era
s
anyScriptWitnessToAnyWitness (AnyScriptWitnessPlutus AnyPlutusScriptWitness lang purpose era
sw) = AnyPlutusScriptWitness lang purpose era -> AnyWitness era
forall (lang :: Language) (purpose :: PlutusScriptPurpose) era.
AnyPlutusScriptWitness lang purpose era -> AnyWitness era
AnyPlutusScriptWitness AnyPlutusScriptWitness lang purpose era
sw