{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

module Cardano.CLI.Shelley.Run.Validate
  ( TxAuxScriptsValidationError(..)
  , TxCertificatesValidationError(..)
  , TxFeeValidationError(..)
  , TxProtocolParametersValidationError
  , TxScriptValidityValidationError(..)
  , TxUpdateProposalValidationError(..)
  , TxValidityLowerBoundValidationError(..)
  , TxValidityUpperBoundValidationError(..)
  , TxRequiredSignersValidationError
  , TxReturnCollateralValidationError(..)
  , TxTotalCollateralValidationError(..)
  , TxWithdrawalsValidationError(..)
  , validateProtocolParameters
  , validateScriptSupportedInEra
  , validateTxAuxScripts
  , validateTxCertificates
  , validateTxFee
  , validateRequiredSigners
  , validateTxReturnCollateral
  , validateTxScriptValidity
  , validateTxTotalCollateral
  , validateTxUpdateProposal
  , validateTxValidityUpperBound
  , validateTxValidityLowerBound
  , validateTxWithdrawals
  ) where

import           Prelude

import           Cardano.Api
import           Cardano.Api.Shelley

import           Data.Bifunctor (first)
import qualified Data.Map.Strict as Map
import           Data.Maybe
import qualified Data.Text as Text

data ScriptLanguageValidationError
  = ScriptLanguageValidationError AnyScriptLanguage AnyCardanoEra
  deriving Int -> ScriptLanguageValidationError -> ShowS
[ScriptLanguageValidationError] -> ShowS
ScriptLanguageValidationError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScriptLanguageValidationError] -> ShowS
$cshowList :: [ScriptLanguageValidationError] -> ShowS
show :: ScriptLanguageValidationError -> String
$cshow :: ScriptLanguageValidationError -> String
showsPrec :: Int -> ScriptLanguageValidationError -> ShowS
$cshowsPrec :: Int -> ScriptLanguageValidationError -> ShowS
Show

instance Error ScriptLanguageValidationError where
  displayError :: ScriptLanguageValidationError -> String
displayError (ScriptLanguageValidationError AnyScriptLanguage
lang AnyCardanoEra
era) =
    String
"The script language " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show AnyScriptLanguage
lang forall a. Semigroup a => a -> a -> a
<> String
" is not supported in the " forall a. Semigroup a => a -> a -> a
<>
    Text -> String
Text.unpack (AnyCardanoEra -> Text
renderEra AnyCardanoEra
era) forall a. Semigroup a => a -> a -> a
<> String
" era."

validateScriptSupportedInEra
  :: CardanoEra era
  -> ScriptInAnyLang
  -> Either ScriptLanguageValidationError (ScriptInEra era)
validateScriptSupportedInEra :: forall era.
CardanoEra era
-> ScriptInAnyLang
-> Either ScriptLanguageValidationError (ScriptInEra era)
validateScriptSupportedInEra CardanoEra era
era script :: ScriptInAnyLang
script@(ScriptInAnyLang ScriptLanguage lang
lang Script lang
_) =
  case forall era.
CardanoEra era -> ScriptInAnyLang -> Maybe (ScriptInEra era)
toScriptInEra CardanoEra era
era ScriptInAnyLang
script of
    Maybe (ScriptInEra era)
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ AnyScriptLanguage -> AnyCardanoEra -> ScriptLanguageValidationError
ScriptLanguageValidationError
                        (forall lang. ScriptLanguage lang -> AnyScriptLanguage
AnyScriptLanguage ScriptLanguage lang
lang) (forall era. CardanoEra era -> AnyCardanoEra
anyCardanoEra CardanoEra era
era)
    Just ScriptInEra era
script' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptInEra era
script'


data TxFeeValidationError
  = TxFeatureImplicitFeesE AnyCardanoEra -- ^ Expected an explicit fee
  | TxFeatureExplicitFeesE AnyCardanoEra -- ^ Expected an implicit fee
  deriving Int -> TxFeeValidationError -> ShowS
[TxFeeValidationError] -> ShowS
TxFeeValidationError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxFeeValidationError] -> ShowS
$cshowList :: [TxFeeValidationError] -> ShowS
show :: TxFeeValidationError -> String
$cshow :: TxFeeValidationError -> String
showsPrec :: Int -> TxFeeValidationError -> ShowS
$cshowsPrec :: Int -> TxFeeValidationError -> ShowS
Show

instance Error TxFeeValidationError where
  displayError :: TxFeeValidationError -> String
displayError (TxFeatureImplicitFeesE AnyCardanoEra
era) =
    String
"Implicit transaction fee not supported in " forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack (AnyCardanoEra -> Text
renderEra AnyCardanoEra
era)
  displayError (TxFeatureExplicitFeesE AnyCardanoEra
era) =
    String
"Explicit transaction fee not supported in " forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack (AnyCardanoEra -> Text
renderEra AnyCardanoEra
era)

validateTxFee :: CardanoEra era
              -> Maybe Lovelace
              -> Either TxFeeValidationError (TxFee era)
validateTxFee :: forall era.
CardanoEra era
-> Maybe Lovelace -> Either TxFeeValidationError (TxFee era)
validateTxFee CardanoEra era
era Maybe Lovelace
mfee =
    case (forall era.
CardanoEra era
-> Either (TxFeesImplicitInEra era) (TxFeesExplicitInEra era)
txFeesExplicitInEra CardanoEra era
era, Maybe Lovelace
mfee) of
      (Left  TxFeesImplicitInEra era
implicit, Maybe Lovelace
Nothing)  -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall era. TxFeesImplicitInEra era -> TxFee era
TxFeeImplicit TxFeesImplicitInEra era
implicit)
      (Right TxFeesExplicitInEra era
explicit, Just Lovelace
fee) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall era. TxFeesExplicitInEra era -> Lovelace -> TxFee era
TxFeeExplicit TxFeesExplicitInEra era
explicit Lovelace
fee)

      (Right TxFeesExplicitInEra era
_, Maybe Lovelace
Nothing) -> forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyCardanoEra -> TxFeeValidationError
TxFeatureImplicitFeesE
                                 forall a b. (a -> b) -> a -> b
$ forall era a. CardanoEra era -> (IsCardanoEra era => a) -> a
getIsCardanoEraConstraint CardanoEra era
era
                                 forall a b. (a -> b) -> a -> b
$ forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra era
era
      (Left  TxFeesImplicitInEra era
_, Just Lovelace
_)  -> forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyCardanoEra -> TxFeeValidationError
TxFeatureExplicitFeesE
                                 forall a b. (a -> b) -> a -> b
$ forall era a. CardanoEra era -> (IsCardanoEra era => a) -> a
getIsCardanoEraConstraint CardanoEra era
era
                                 forall a b. (a -> b) -> a -> b
$ forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra era
era

newtype TxTotalCollateralValidationError
  = TxTotalCollateralNotSupported AnyCardanoEra
  deriving Int -> TxTotalCollateralValidationError -> ShowS
[TxTotalCollateralValidationError] -> ShowS
TxTotalCollateralValidationError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxTotalCollateralValidationError] -> ShowS
$cshowList :: [TxTotalCollateralValidationError] -> ShowS
show :: TxTotalCollateralValidationError -> String
$cshow :: TxTotalCollateralValidationError -> String
showsPrec :: Int -> TxTotalCollateralValidationError -> ShowS
$cshowsPrec :: Int -> TxTotalCollateralValidationError -> ShowS
Show

instance Error TxTotalCollateralValidationError where
  displayError :: TxTotalCollateralValidationError -> String
displayError (TxTotalCollateralNotSupported AnyCardanoEra
era) =
    String
"Transaction collateral not supported in " forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack (AnyCardanoEra -> Text
renderEra AnyCardanoEra
era)

validateTxTotalCollateral :: CardanoEra era
                          -> Maybe Lovelace
                          -> Either TxTotalCollateralValidationError (TxTotalCollateral era)
validateTxTotalCollateral :: forall era.
CardanoEra era
-> Maybe Lovelace
-> Either TxTotalCollateralValidationError (TxTotalCollateral era)
validateTxTotalCollateral CardanoEra era
_ Maybe Lovelace
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return forall era. TxTotalCollateral era
TxTotalCollateralNone
validateTxTotalCollateral CardanoEra era
era (Just Lovelace
coll) =
  case forall era.
CardanoEra era
-> Maybe (TxTotalAndReturnCollateralSupportedInEra era)
totalAndReturnCollateralSupportedInEra CardanoEra era
era of
    Just TxTotalAndReturnCollateralSupportedInEra era
supp -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall era.
TxTotalAndReturnCollateralSupportedInEra era
-> Lovelace -> TxTotalCollateral era
TxTotalCollateral TxTotalAndReturnCollateralSupportedInEra era
supp Lovelace
coll
    Maybe (TxTotalAndReturnCollateralSupportedInEra era)
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ AnyCardanoEra -> TxTotalCollateralValidationError
TxTotalCollateralNotSupported
                    forall a b. (a -> b) -> a -> b
$ forall era a. CardanoEra era -> (IsCardanoEra era => a) -> a
getIsCardanoEraConstraint CardanoEra era
era
                    forall a b. (a -> b) -> a -> b
$ forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra era
era

newtype TxReturnCollateralValidationError
  = TxReturnCollateralNotSupported AnyCardanoEra
  deriving Int -> TxReturnCollateralValidationError -> ShowS
[TxReturnCollateralValidationError] -> ShowS
TxReturnCollateralValidationError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxReturnCollateralValidationError] -> ShowS
$cshowList :: [TxReturnCollateralValidationError] -> ShowS
show :: TxReturnCollateralValidationError -> String
$cshow :: TxReturnCollateralValidationError -> String
showsPrec :: Int -> TxReturnCollateralValidationError -> ShowS
$cshowsPrec :: Int -> TxReturnCollateralValidationError -> ShowS
Show

instance Error TxReturnCollateralValidationError where
  displayError :: TxReturnCollateralValidationError -> String
displayError (TxReturnCollateralNotSupported AnyCardanoEra
era) =
    String
"Transaction return collateral not supported in " forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack (AnyCardanoEra -> Text
renderEra AnyCardanoEra
era)

validateTxReturnCollateral :: CardanoEra era
                           -> Maybe (TxOut CtxTx era)
                           -> Either TxReturnCollateralValidationError (TxReturnCollateral CtxTx era)
validateTxReturnCollateral :: forall era.
CardanoEra era
-> Maybe (TxOut CtxTx era)
-> Either
     TxReturnCollateralValidationError (TxReturnCollateral CtxTx era)
validateTxReturnCollateral CardanoEra era
_ Maybe (TxOut CtxTx era)
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return forall ctx era. TxReturnCollateral ctx era
TxReturnCollateralNone
validateTxReturnCollateral CardanoEra era
era (Just TxOut CtxTx era
retColTxOut) = do
  case forall era.
CardanoEra era
-> Maybe (TxTotalAndReturnCollateralSupportedInEra era)
totalAndReturnCollateralSupportedInEra CardanoEra era
era of
    Just TxTotalAndReturnCollateralSupportedInEra era
supp -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall era ctx.
TxTotalAndReturnCollateralSupportedInEra era
-> TxOut ctx era -> TxReturnCollateral ctx era
TxReturnCollateral TxTotalAndReturnCollateralSupportedInEra era
supp TxOut CtxTx era
retColTxOut
    Maybe (TxTotalAndReturnCollateralSupportedInEra era)
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ AnyCardanoEra -> TxReturnCollateralValidationError
TxReturnCollateralNotSupported
                    forall a b. (a -> b) -> a -> b
$ forall era a. CardanoEra era -> (IsCardanoEra era => a) -> a
getIsCardanoEraConstraint CardanoEra era
era
                    forall a b. (a -> b) -> a -> b
$ forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra era
era

newtype TxValidityLowerBoundValidationError
  = TxValidityLowerBoundNotSupported AnyCardanoEra
  deriving Int -> TxValidityLowerBoundValidationError -> ShowS
[TxValidityLowerBoundValidationError] -> ShowS
TxValidityLowerBoundValidationError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxValidityLowerBoundValidationError] -> ShowS
$cshowList :: [TxValidityLowerBoundValidationError] -> ShowS
show :: TxValidityLowerBoundValidationError -> String
$cshow :: TxValidityLowerBoundValidationError -> String
showsPrec :: Int -> TxValidityLowerBoundValidationError -> ShowS
$cshowsPrec :: Int -> TxValidityLowerBoundValidationError -> ShowS
Show

instance Error TxValidityLowerBoundValidationError where
  displayError :: TxValidityLowerBoundValidationError -> String
displayError (TxValidityLowerBoundNotSupported AnyCardanoEra
era) =
    String
"Transaction validity lower bound not supported in " forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack (AnyCardanoEra -> Text
renderEra AnyCardanoEra
era)


validateTxValidityLowerBound :: CardanoEra era
                             -> Maybe SlotNo
                             -> Either TxValidityLowerBoundValidationError (TxValidityLowerBound era)
validateTxValidityLowerBound :: forall era.
CardanoEra era
-> Maybe SlotNo
-> Either
     TxValidityLowerBoundValidationError (TxValidityLowerBound era)
validateTxValidityLowerBound CardanoEra era
_ Maybe SlotNo
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return forall era. TxValidityLowerBound era
TxValidityNoLowerBound
validateTxValidityLowerBound CardanoEra era
era (Just SlotNo
slot) =
    case forall era.
CardanoEra era -> Maybe (ValidityLowerBoundSupportedInEra era)
validityLowerBoundSupportedInEra CardanoEra era
era of
      Maybe (ValidityLowerBoundSupportedInEra era)
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ AnyCardanoEra -> TxValidityLowerBoundValidationError
TxValidityLowerBoundNotSupported
                      forall a b. (a -> b) -> a -> b
$ forall era a. CardanoEra era -> (IsCardanoEra era => a) -> a
getIsCardanoEraConstraint CardanoEra era
era
                      forall a b. (a -> b) -> a -> b
$ forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra era
era
      Just ValidityLowerBoundSupportedInEra era
supported -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall era.
ValidityLowerBoundSupportedInEra era
-> SlotNo -> TxValidityLowerBound era
TxValidityLowerBound ValidityLowerBoundSupportedInEra era
supported SlotNo
slot)

newtype TxValidityUpperBoundValidationError
  = TxValidityUpperBoundNotSupported AnyCardanoEra
  deriving Int -> TxValidityUpperBoundValidationError -> ShowS
[TxValidityUpperBoundValidationError] -> ShowS
TxValidityUpperBoundValidationError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxValidityUpperBoundValidationError] -> ShowS
$cshowList :: [TxValidityUpperBoundValidationError] -> ShowS
show :: TxValidityUpperBoundValidationError -> String
$cshow :: TxValidityUpperBoundValidationError -> String
showsPrec :: Int -> TxValidityUpperBoundValidationError -> ShowS
$cshowsPrec :: Int -> TxValidityUpperBoundValidationError -> ShowS
Show

instance Error TxValidityUpperBoundValidationError where
  displayError :: TxValidityUpperBoundValidationError -> String
displayError (TxValidityUpperBoundNotSupported AnyCardanoEra
era) =
    String
"Transaction validity upper bound must be specified in " forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack (AnyCardanoEra -> Text
renderEra AnyCardanoEra
era)

validateTxValidityUpperBound
  :: CardanoEra era
  -> Maybe SlotNo
  -> Either TxValidityUpperBoundValidationError (TxValidityUpperBound era)
validateTxValidityUpperBound :: forall era.
CardanoEra era
-> Maybe SlotNo
-> Either
     TxValidityUpperBoundValidationError (TxValidityUpperBound era)
validateTxValidityUpperBound CardanoEra era
era Maybe SlotNo
Nothing =
  case forall era.
CardanoEra era -> Maybe (ValidityNoUpperBoundSupportedInEra era)
validityNoUpperBoundSupportedInEra CardanoEra era
era of
    Maybe (ValidityNoUpperBoundSupportedInEra era)
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ AnyCardanoEra -> TxValidityUpperBoundValidationError
TxValidityUpperBoundNotSupported
                    forall a b. (a -> b) -> a -> b
$ forall era a. CardanoEra era -> (IsCardanoEra era => a) -> a
getIsCardanoEraConstraint CardanoEra era
era
                    forall a b. (a -> b) -> a -> b
$ forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra era
era
    Just ValidityNoUpperBoundSupportedInEra era
supported -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall era.
ValidityNoUpperBoundSupportedInEra era -> TxValidityUpperBound era
TxValidityNoUpperBound ValidityNoUpperBoundSupportedInEra era
supported)
validateTxValidityUpperBound CardanoEra era
era (Just SlotNo
slot) =
  case forall era.
CardanoEra era -> Maybe (ValidityUpperBoundSupportedInEra era)
validityUpperBoundSupportedInEra CardanoEra era
era of
    Maybe (ValidityUpperBoundSupportedInEra era)
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ AnyCardanoEra -> TxValidityUpperBoundValidationError
TxValidityUpperBoundNotSupported
                    forall a b. (a -> b) -> a -> b
$ forall era a. CardanoEra era -> (IsCardanoEra era => a) -> a
getIsCardanoEraConstraint CardanoEra era
era
                    forall a b. (a -> b) -> a -> b
$ forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra era
era
    Just ValidityUpperBoundSupportedInEra era
supported -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall era.
ValidityUpperBoundSupportedInEra era
-> SlotNo -> TxValidityUpperBound era
TxValidityUpperBound ValidityUpperBoundSupportedInEra era
supported SlotNo
slot)

data TxAuxScriptsValidationError
  = TxAuxScriptsNotSupportedInEra AnyCardanoEra
  | TxAuxScriptsLanguageError ScriptLanguageValidationError
  deriving Int -> TxAuxScriptsValidationError -> ShowS
[TxAuxScriptsValidationError] -> ShowS
TxAuxScriptsValidationError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxAuxScriptsValidationError] -> ShowS
$cshowList :: [TxAuxScriptsValidationError] -> ShowS
show :: TxAuxScriptsValidationError -> String
$cshow :: TxAuxScriptsValidationError -> String
showsPrec :: Int -> TxAuxScriptsValidationError -> ShowS
$cshowsPrec :: Int -> TxAuxScriptsValidationError -> ShowS
Show

instance Error TxAuxScriptsValidationError where
  displayError :: TxAuxScriptsValidationError -> String
displayError (TxAuxScriptsNotSupportedInEra AnyCardanoEra
era) =
    String
"Transaction auxiliary scripts are not supported in " forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack (AnyCardanoEra -> Text
renderEra AnyCardanoEra
era)
  displayError (TxAuxScriptsLanguageError ScriptLanguageValidationError
e) =
    String
"Transaction auxiliary scripts error: " forall a. Semigroup a => a -> a -> a
<> forall e. Error e => e -> String
displayError ScriptLanguageValidationError
e

validateTxAuxScripts
  :: CardanoEra era
  -> [ScriptInAnyLang]
  -> Either TxAuxScriptsValidationError (TxAuxScripts era)
validateTxAuxScripts :: forall era.
CardanoEra era
-> [ScriptInAnyLang]
-> Either TxAuxScriptsValidationError (TxAuxScripts era)
validateTxAuxScripts CardanoEra era
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall era. TxAuxScripts era
TxAuxScriptsNone
validateTxAuxScripts CardanoEra era
era [ScriptInAnyLang]
scripts =
  case forall era. CardanoEra era -> Maybe (AuxScriptsSupportedInEra era)
auxScriptsSupportedInEra CardanoEra era
era of
    Maybe (AuxScriptsSupportedInEra era)
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ AnyCardanoEra -> TxAuxScriptsValidationError
TxAuxScriptsNotSupportedInEra
                    forall a b. (a -> b) -> a -> b
$ forall era a. CardanoEra era -> (IsCardanoEra era => a) -> a
getIsCardanoEraConstraint CardanoEra era
era
                    forall a b. (a -> b) -> a -> b
$ forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra era
era
    Just AuxScriptsSupportedInEra era
supported -> do
      [ScriptInEra era]
scriptsInEra <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ScriptLanguageValidationError -> TxAuxScriptsValidationError
TxAuxScriptsLanguageError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
CardanoEra era
-> ScriptInAnyLang
-> Either ScriptLanguageValidationError (ScriptInEra era)
validateScriptSupportedInEra CardanoEra era
era) [ScriptInAnyLang]
scripts
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall era.
AuxScriptsSupportedInEra era
-> [ScriptInEra era] -> TxAuxScripts era
TxAuxScripts AuxScriptsSupportedInEra era
supported [ScriptInEra era]
scriptsInEra

newtype TxRequiredSignersValidationError
  = TxRequiredSignersValidationError AnyCardanoEra
  deriving Int -> TxRequiredSignersValidationError -> ShowS
[TxRequiredSignersValidationError] -> ShowS
TxRequiredSignersValidationError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxRequiredSignersValidationError] -> ShowS
$cshowList :: [TxRequiredSignersValidationError] -> ShowS
show :: TxRequiredSignersValidationError -> String
$cshow :: TxRequiredSignersValidationError -> String
showsPrec :: Int -> TxRequiredSignersValidationError -> ShowS
$cshowsPrec :: Int -> TxRequiredSignersValidationError -> ShowS
Show

instance Error TxRequiredSignersValidationError where
  displayError :: TxRequiredSignersValidationError -> String
displayError (TxRequiredSignersValidationError AnyCardanoEra
e) =
    String
"Transaction required signers are not supported in " forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack (AnyCardanoEra -> Text
renderEra AnyCardanoEra
e)

validateRequiredSigners
  :: CardanoEra era
  -> [Hash PaymentKey]
  -> Either TxRequiredSignersValidationError (TxExtraKeyWitnesses era)
validateRequiredSigners :: forall era.
CardanoEra era
-> [Hash PaymentKey]
-> Either
     TxRequiredSignersValidationError (TxExtraKeyWitnesses era)
validateRequiredSigners CardanoEra era
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall era. TxExtraKeyWitnesses era
TxExtraKeyWitnessesNone
validateRequiredSigners CardanoEra era
era [Hash PaymentKey]
reqSigs =
  case forall era.
CardanoEra era -> Maybe (TxExtraKeyWitnessesSupportedInEra era)
extraKeyWitnessesSupportedInEra CardanoEra era
era of
    Maybe (TxExtraKeyWitnessesSupportedInEra era)
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ AnyCardanoEra -> TxRequiredSignersValidationError
TxRequiredSignersValidationError
                    forall a b. (a -> b) -> a -> b
$ forall era a. CardanoEra era -> (IsCardanoEra era => a) -> a
getIsCardanoEraConstraint CardanoEra era
era
                    forall a b. (a -> b) -> a -> b
$ forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra era
era
    Just TxExtraKeyWitnessesSupportedInEra era
supported -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall era.
TxExtraKeyWitnessesSupportedInEra era
-> [Hash PaymentKey] -> TxExtraKeyWitnesses era
TxExtraKeyWitnesses TxExtraKeyWitnessesSupportedInEra era
supported [Hash PaymentKey]
reqSigs

newtype TxWithdrawalsValidationError
  = TxWithdrawalsNotSupported AnyCardanoEra
  deriving Int -> TxWithdrawalsValidationError -> ShowS
[TxWithdrawalsValidationError] -> ShowS
TxWithdrawalsValidationError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxWithdrawalsValidationError] -> ShowS
$cshowList :: [TxWithdrawalsValidationError] -> ShowS
show :: TxWithdrawalsValidationError -> String
$cshow :: TxWithdrawalsValidationError -> String
showsPrec :: Int -> TxWithdrawalsValidationError -> ShowS
$cshowsPrec :: Int -> TxWithdrawalsValidationError -> ShowS
Show

instance Error TxWithdrawalsValidationError where
  displayError :: TxWithdrawalsValidationError -> String
displayError (TxWithdrawalsNotSupported AnyCardanoEra
e) =
    String
"Transaction withdrawals are not supported in " forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack (AnyCardanoEra -> Text
renderEra AnyCardanoEra
e)

validateTxWithdrawals
  :: forall era.
     CardanoEra era
  -> [(StakeAddress, Lovelace, Maybe (ScriptWitness WitCtxStake era))]
  -> Either TxWithdrawalsValidationError (TxWithdrawals BuildTx era)
validateTxWithdrawals :: forall era.
CardanoEra era
-> [(StakeAddress, Lovelace,
     Maybe (ScriptWitness WitCtxStake era))]
-> Either TxWithdrawalsValidationError (TxWithdrawals BuildTx era)
validateTxWithdrawals CardanoEra era
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall build era. TxWithdrawals build era
TxWithdrawalsNone
validateTxWithdrawals CardanoEra era
era [(StakeAddress, Lovelace, Maybe (ScriptWitness WitCtxStake era))]
withdrawals =
  case forall era. CardanoEra era -> Maybe (WithdrawalsSupportedInEra era)
withdrawalsSupportedInEra CardanoEra era
era of
    Maybe (WithdrawalsSupportedInEra era)
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ AnyCardanoEra -> TxWithdrawalsValidationError
TxWithdrawalsNotSupported
                    forall a b. (a -> b) -> a -> b
$ forall era a. CardanoEra era -> (IsCardanoEra era => a) -> a
getIsCardanoEraConstraint CardanoEra era
era
                    forall a b. (a -> b) -> a -> b
$ forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra era
era
    Just WithdrawalsSupportedInEra era
supported -> do
      let convWithdrawals :: [(StakeAddress, Lovelace,
  BuildTxWith BuildTx (Witness WitCtxStake era))]
convWithdrawals = forall a b. (a -> b) -> [a] -> [b]
map (StakeAddress, Lovelace, Maybe (ScriptWitness WitCtxStake era))
-> (StakeAddress, Lovelace,
    BuildTxWith BuildTx (Witness WitCtxStake era))
convert [(StakeAddress, Lovelace, Maybe (ScriptWitness WitCtxStake era))]
withdrawals
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall era build.
WithdrawalsSupportedInEra era
-> [(StakeAddress, Lovelace,
     BuildTxWith build (Witness WitCtxStake era))]
-> TxWithdrawals build era
TxWithdrawals WithdrawalsSupportedInEra era
supported [(StakeAddress, Lovelace,
  BuildTxWith BuildTx (Witness WitCtxStake era))]
convWithdrawals)
 where
  convert
    :: (StakeAddress, Lovelace, Maybe (ScriptWitness WitCtxStake era))
    -> (StakeAddress, Lovelace, BuildTxWith BuildTx (Witness WitCtxStake era))
  convert :: (StakeAddress, Lovelace, Maybe (ScriptWitness WitCtxStake era))
-> (StakeAddress, Lovelace,
    BuildTxWith BuildTx (Witness WitCtxStake era))
convert (StakeAddress
sAddr, Lovelace
ll, Maybe (ScriptWitness WitCtxStake era)
mScriptWitnessFiles) =
    case Maybe (ScriptWitness WitCtxStake era)
mScriptWitnessFiles of
      Just ScriptWitness WitCtxStake era
sWit -> do
        (StakeAddress
sAddr, Lovelace
ll, forall a. a -> BuildTxWith BuildTx a
BuildTxWith forall a b. (a -> b) -> a -> b
$ forall witctx era.
ScriptWitnessInCtx witctx
-> ScriptWitness witctx era -> Witness witctx era
ScriptWitness ScriptWitnessInCtx WitCtxStake
ScriptWitnessForStakeAddr ScriptWitness WitCtxStake era
sWit)
      Maybe (ScriptWitness WitCtxStake era)
Nothing -> (StakeAddress
sAddr,Lovelace
ll, forall a. a -> BuildTxWith BuildTx a
BuildTxWith forall a b. (a -> b) -> a -> b
$ forall witctx era. KeyWitnessInCtx witctx -> Witness witctx era
KeyWitness KeyWitnessInCtx WitCtxStake
KeyWitnessForStakeAddr)

newtype TxCertificatesValidationError
  = TxCertificatesValidationNotSupported AnyCardanoEra
  deriving Int -> TxCertificatesValidationError -> ShowS
[TxCertificatesValidationError] -> ShowS
TxCertificatesValidationError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxCertificatesValidationError] -> ShowS
$cshowList :: [TxCertificatesValidationError] -> ShowS
show :: TxCertificatesValidationError -> String
$cshow :: TxCertificatesValidationError -> String
showsPrec :: Int -> TxCertificatesValidationError -> ShowS
$cshowsPrec :: Int -> TxCertificatesValidationError -> ShowS
Show

instance Error TxCertificatesValidationError where
  displayError :: TxCertificatesValidationError -> String
displayError (TxCertificatesValidationNotSupported AnyCardanoEra
e) =
    String
"Transaction certificates are not supported in " forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack (AnyCardanoEra -> Text
renderEra AnyCardanoEra
e)

validateTxCertificates
  :: forall era.
     CardanoEra era
  -> [(Certificate, Maybe (ScriptWitness WitCtxStake era))]
  -> Either TxCertificatesValidationError (TxCertificates BuildTx era)
validateTxCertificates :: forall era.
CardanoEra era
-> [(Certificate, Maybe (ScriptWitness WitCtxStake era))]
-> Either
     TxCertificatesValidationError (TxCertificates BuildTx era)
validateTxCertificates CardanoEra era
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall build era. TxCertificates build era
TxCertificatesNone
validateTxCertificates CardanoEra era
era [(Certificate, Maybe (ScriptWitness WitCtxStake era))]
certsAndScriptWitnesses =
  case forall era.
CardanoEra era -> Maybe (CertificatesSupportedInEra era)
certificatesSupportedInEra CardanoEra era
era of
    Maybe (CertificatesSupportedInEra era)
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ AnyCardanoEra -> TxCertificatesValidationError
TxCertificatesValidationNotSupported
                    forall a b. (a -> b) -> a -> b
$ forall era a. CardanoEra era -> (IsCardanoEra era => a) -> a
getIsCardanoEraConstraint CardanoEra era
era
                    forall a b. (a -> b) -> a -> b
$ forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra era
era
    Just CertificatesSupportedInEra era
supported -> do
      let certs :: [Certificate]
certs = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Certificate, Maybe (ScriptWitness WitCtxStake era))]
certsAndScriptWitnesses
          reqWits :: Map StakeCredential (Witness WitCtxStake era)
reqWits = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Certificate, Maybe (ScriptWitness WitCtxStake era))
-> Maybe (StakeCredential, Witness WitCtxStake era)
convert [(Certificate, Maybe (ScriptWitness WitCtxStake era))]
certsAndScriptWitnesses
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall era build.
CertificatesSupportedInEra era
-> [Certificate]
-> BuildTxWith
     build (Map StakeCredential (Witness WitCtxStake era))
-> TxCertificates build era
TxCertificates CertificatesSupportedInEra era
supported [Certificate]
certs forall a b. (a -> b) -> a -> b
$ forall a. a -> BuildTxWith BuildTx a
BuildTxWith Map StakeCredential (Witness WitCtxStake era)
reqWits
  where
   -- We get the stake credential witness for a certificate that requires it.
   -- NB: Only stake address deregistration and delegation requires
   -- witnessing (witness can be script or key)
   deriveStakeCredentialWitness
     :: Certificate
     -> Maybe StakeCredential
   deriveStakeCredentialWitness :: Certificate -> Maybe StakeCredential
deriveStakeCredentialWitness Certificate
cert = do
     case Certificate
cert of
       StakeAddressDeregistrationCertificate StakeCredential
sCred -> forall a. a -> Maybe a
Just StakeCredential
sCred
       StakeAddressDelegationCertificate StakeCredential
sCred PoolId
_ -> forall a. a -> Maybe a
Just StakeCredential
sCred
       Certificate
_ -> forall a. Maybe a
Nothing

   convert
     :: (Certificate, Maybe (ScriptWitness WitCtxStake era))
     -> Maybe (StakeCredential, Witness WitCtxStake era)
   convert :: (Certificate, Maybe (ScriptWitness WitCtxStake era))
-> Maybe (StakeCredential, Witness WitCtxStake era)
convert (Certificate
cert, Maybe (ScriptWitness WitCtxStake era)
mScriptWitnessFiles) = do
     StakeCredential
sCred <- Certificate -> Maybe StakeCredential
deriveStakeCredentialWitness Certificate
cert
     case Maybe (ScriptWitness WitCtxStake era)
mScriptWitnessFiles of
       Just ScriptWitness WitCtxStake era
sWit -> do
         forall a. a -> Maybe a
Just ( StakeCredential
sCred
              , forall witctx era.
ScriptWitnessInCtx witctx
-> ScriptWitness witctx era -> Witness witctx era
ScriptWitness ScriptWitnessInCtx WitCtxStake
ScriptWitnessForStakeAddr ScriptWitness WitCtxStake era
sWit
              )
       Maybe (ScriptWitness WitCtxStake era)
Nothing -> forall a. a -> Maybe a
Just (StakeCredential
sCred, forall witctx era. KeyWitnessInCtx witctx -> Witness witctx era
KeyWitness KeyWitnessInCtx WitCtxStake
KeyWitnessForStakeAddr)

newtype TxProtocolParametersValidationError
  = ProtocolParametersNotSupported AnyCardanoEra
  deriving Int -> TxProtocolParametersValidationError -> ShowS
[TxProtocolParametersValidationError] -> ShowS
TxProtocolParametersValidationError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxProtocolParametersValidationError] -> ShowS
$cshowList :: [TxProtocolParametersValidationError] -> ShowS
show :: TxProtocolParametersValidationError -> String
$cshow :: TxProtocolParametersValidationError -> String
showsPrec :: Int -> TxProtocolParametersValidationError -> ShowS
$cshowsPrec :: Int -> TxProtocolParametersValidationError -> ShowS
Show

instance Error TxProtocolParametersValidationError where
  displayError :: TxProtocolParametersValidationError -> String
displayError (ProtocolParametersNotSupported AnyCardanoEra
e) =
    String
"Transaction protocol parameters are not supported in " forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack (AnyCardanoEra -> Text
renderEra AnyCardanoEra
e)

validateProtocolParameters
  :: CardanoEra era
  -> Maybe ProtocolParameters
  -> Either TxProtocolParametersValidationError (BuildTxWith BuildTx (Maybe ProtocolParameters))
validateProtocolParameters :: forall era.
CardanoEra era
-> Maybe ProtocolParameters
-> Either
     TxProtocolParametersValidationError
     (BuildTxWith BuildTx (Maybe ProtocolParameters))
validateProtocolParameters CardanoEra era
_ Maybe ProtocolParameters
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> BuildTxWith BuildTx a
BuildTxWith forall a. Maybe a
Nothing)
validateProtocolParameters CardanoEra era
era (Just ProtocolParameters
pparams) =
    case forall era. CardanoEra era -> Maybe (ScriptDataSupportedInEra era)
scriptDataSupportedInEra CardanoEra era
era of
      Maybe (ScriptDataSupportedInEra era)
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ AnyCardanoEra -> TxProtocolParametersValidationError
ProtocolParametersNotSupported
                      forall a b. (a -> b) -> a -> b
$ forall era a. CardanoEra era -> (IsCardanoEra era => a) -> a
getIsCardanoEraConstraint CardanoEra era
era
                      forall a b. (a -> b) -> a -> b
$ forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra era
era
      Just ScriptDataSupportedInEra era
_  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> BuildTxWith BuildTx a
BuildTxWith forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ProtocolParameters
pparams

newtype TxUpdateProposalValidationError
  = TxUpdateProposalNotSupported AnyCardanoEra
  deriving Int -> TxUpdateProposalValidationError -> ShowS
[TxUpdateProposalValidationError] -> ShowS
TxUpdateProposalValidationError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxUpdateProposalValidationError] -> ShowS
$cshowList :: [TxUpdateProposalValidationError] -> ShowS
show :: TxUpdateProposalValidationError -> String
$cshow :: TxUpdateProposalValidationError -> String
showsPrec :: Int -> TxUpdateProposalValidationError -> ShowS
$cshowsPrec :: Int -> TxUpdateProposalValidationError -> ShowS
Show

instance Error TxUpdateProposalValidationError where
  displayError :: TxUpdateProposalValidationError -> String
displayError (TxUpdateProposalNotSupported AnyCardanoEra
e) =
    String
"Transaction update proposal is not supported in " forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack (AnyCardanoEra -> Text
renderEra AnyCardanoEra
e)

validateTxUpdateProposal
  :: CardanoEra era
  -> Maybe UpdateProposal
  -> Either TxUpdateProposalValidationError (TxUpdateProposal era)
validateTxUpdateProposal :: forall era.
CardanoEra era
-> Maybe UpdateProposal
-> Either TxUpdateProposalValidationError (TxUpdateProposal era)
validateTxUpdateProposal CardanoEra era
_ Maybe UpdateProposal
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return forall era. TxUpdateProposal era
TxUpdateProposalNone
validateTxUpdateProposal CardanoEra era
era (Just UpdateProposal
prop) =
    case forall era.
CardanoEra era -> Maybe (UpdateProposalSupportedInEra era)
updateProposalSupportedInEra CardanoEra era
era of
      Maybe (UpdateProposalSupportedInEra era)
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ AnyCardanoEra -> TxUpdateProposalValidationError
TxUpdateProposalNotSupported
                      forall a b. (a -> b) -> a -> b
$ forall era a. CardanoEra era -> (IsCardanoEra era => a) -> a
getIsCardanoEraConstraint CardanoEra era
era
                      forall a b. (a -> b) -> a -> b
$ forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra era
era
      Just UpdateProposalSupportedInEra era
supported -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall era.
UpdateProposalSupportedInEra era
-> UpdateProposal -> TxUpdateProposal era
TxUpdateProposal UpdateProposalSupportedInEra era
supported UpdateProposal
prop

newtype TxScriptValidityValidationError
  = ScriptValidityNotSupported AnyCardanoEra
  deriving Int -> TxScriptValidityValidationError -> ShowS
[TxScriptValidityValidationError] -> ShowS
TxScriptValidityValidationError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxScriptValidityValidationError] -> ShowS
$cshowList :: [TxScriptValidityValidationError] -> ShowS
show :: TxScriptValidityValidationError -> String
$cshow :: TxScriptValidityValidationError -> String
showsPrec :: Int -> TxScriptValidityValidationError -> ShowS
$cshowsPrec :: Int -> TxScriptValidityValidationError -> ShowS
Show

instance Error TxScriptValidityValidationError where
  displayError :: TxScriptValidityValidationError -> String
displayError (ScriptValidityNotSupported AnyCardanoEra
e) =
    String
"Transaction script validity is not supported in " forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack (AnyCardanoEra -> Text
renderEra AnyCardanoEra
e)

validateTxScriptValidity
  :: CardanoEra era
  -> Maybe ScriptValidity
  -> Either TxScriptValidityValidationError (TxScriptValidity era)
validateTxScriptValidity :: forall era.
CardanoEra era
-> Maybe ScriptValidity
-> Either TxScriptValidityValidationError (TxScriptValidity era)
validateTxScriptValidity CardanoEra era
_ Maybe ScriptValidity
Nothing = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall era. TxScriptValidity era
TxScriptValidityNone
validateTxScriptValidity CardanoEra era
era (Just ScriptValidity
scriptValidity) =
  case forall era.
CardanoEra era -> Maybe (TxScriptValiditySupportedInEra era)
txScriptValiditySupportedInCardanoEra CardanoEra era
era of
    Maybe (TxScriptValiditySupportedInEra era)
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ AnyCardanoEra -> TxScriptValidityValidationError
ScriptValidityNotSupported
                    forall a b. (a -> b) -> a -> b
$ forall era a. CardanoEra era -> (IsCardanoEra era => a) -> a
getIsCardanoEraConstraint CardanoEra era
era
                    forall a b. (a -> b) -> a -> b
$ forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra era
era
    Just TxScriptValiditySupportedInEra era
supported -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era.
TxScriptValiditySupportedInEra era
-> ScriptValidity -> TxScriptValidity era
TxScriptValidity TxScriptValiditySupportedInEra era
supported ScriptValidity
scriptValidity