{-# LANGUAGE ConstraintKinds     #-}
{-# LANGUAGE DeriveAnyClass      #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE DerivingVia         #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell     #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

module Ledger.Index.Internal where

import Prelude hiding (lookup)

import Cardano.Ledger.Alonzo.Scripts (ExUnits)
import Cardano.Ledger.Alonzo.TxWitness (RdmrPtr)
import Codec.Serialise (Serialise)
import Control.DeepSeq (NFData)
import Control.Lens (makeClassyPrisms)
import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Map qualified as Map
import Data.OpenApi.Schema qualified as OpenApi
import Data.Text (Text)
import GHC.Generics (Generic)
import Ledger.Orphans ()
import Ledger.Tx.Internal (TxOut)
import Plutus.V1.Ledger.Scripts qualified as Scripts
import Plutus.V1.Ledger.Tx qualified as PV1
import Prettyprinter (Pretty)
import Prettyprinter.Extras (PrettyShow (..))

-- | The UTxOs of a blockchain indexed by their references.
newtype UtxoIndex = UtxoIndex { UtxoIndex -> Map TxOutRef TxOut
getIndex :: Map.Map PV1.TxOutRef TxOut }
    deriving stock (Int -> UtxoIndex -> ShowS
[UtxoIndex] -> ShowS
UtxoIndex -> String
(Int -> UtxoIndex -> ShowS)
-> (UtxoIndex -> String)
-> ([UtxoIndex] -> ShowS)
-> Show UtxoIndex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UtxoIndex] -> ShowS
$cshowList :: [UtxoIndex] -> ShowS
show :: UtxoIndex -> String
$cshow :: UtxoIndex -> String
showsPrec :: Int -> UtxoIndex -> ShowS
$cshowsPrec :: Int -> UtxoIndex -> ShowS
Show, (forall x. UtxoIndex -> Rep UtxoIndex x)
-> (forall x. Rep UtxoIndex x -> UtxoIndex) -> Generic UtxoIndex
forall x. Rep UtxoIndex x -> UtxoIndex
forall x. UtxoIndex -> Rep UtxoIndex x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UtxoIndex x -> UtxoIndex
$cfrom :: forall x. UtxoIndex -> Rep UtxoIndex x
Generic)
    deriving newtype (UtxoIndex -> UtxoIndex -> Bool
(UtxoIndex -> UtxoIndex -> Bool)
-> (UtxoIndex -> UtxoIndex -> Bool) -> Eq UtxoIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UtxoIndex -> UtxoIndex -> Bool
$c/= :: UtxoIndex -> UtxoIndex -> Bool
== :: UtxoIndex -> UtxoIndex -> Bool
$c== :: UtxoIndex -> UtxoIndex -> Bool
Eq, b -> UtxoIndex -> UtxoIndex
NonEmpty UtxoIndex -> UtxoIndex
UtxoIndex -> UtxoIndex -> UtxoIndex
(UtxoIndex -> UtxoIndex -> UtxoIndex)
-> (NonEmpty UtxoIndex -> UtxoIndex)
-> (forall b. Integral b => b -> UtxoIndex -> UtxoIndex)
-> Semigroup UtxoIndex
forall b. Integral b => b -> UtxoIndex -> UtxoIndex
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> UtxoIndex -> UtxoIndex
$cstimes :: forall b. Integral b => b -> UtxoIndex -> UtxoIndex
sconcat :: NonEmpty UtxoIndex -> UtxoIndex
$csconcat :: NonEmpty UtxoIndex -> UtxoIndex
<> :: UtxoIndex -> UtxoIndex -> UtxoIndex
$c<> :: UtxoIndex -> UtxoIndex -> UtxoIndex
Semigroup, Typeable UtxoIndex
Typeable UtxoIndex
-> (Proxy UtxoIndex -> Declare (Definitions Schema) NamedSchema)
-> ToSchema UtxoIndex
Proxy UtxoIndex -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> ToSchema a
declareNamedSchema :: Proxy UtxoIndex -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy UtxoIndex -> Declare (Definitions Schema) NamedSchema
$cp1ToSchema :: Typeable UtxoIndex
OpenApi.ToSchema, Semigroup UtxoIndex
UtxoIndex
Semigroup UtxoIndex
-> UtxoIndex
-> (UtxoIndex -> UtxoIndex -> UtxoIndex)
-> ([UtxoIndex] -> UtxoIndex)
-> Monoid UtxoIndex
[UtxoIndex] -> UtxoIndex
UtxoIndex -> UtxoIndex -> UtxoIndex
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [UtxoIndex] -> UtxoIndex
$cmconcat :: [UtxoIndex] -> UtxoIndex
mappend :: UtxoIndex -> UtxoIndex -> UtxoIndex
$cmappend :: UtxoIndex -> UtxoIndex -> UtxoIndex
mempty :: UtxoIndex
$cmempty :: UtxoIndex
$cp1Monoid :: Semigroup UtxoIndex
Monoid, Decoder s UtxoIndex
Decoder s [UtxoIndex]
[UtxoIndex] -> Encoding
UtxoIndex -> Encoding
(UtxoIndex -> Encoding)
-> (forall s. Decoder s UtxoIndex)
-> ([UtxoIndex] -> Encoding)
-> (forall s. Decoder s [UtxoIndex])
-> Serialise UtxoIndex
forall s. Decoder s [UtxoIndex]
forall s. Decoder s UtxoIndex
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: Decoder s [UtxoIndex]
$cdecodeList :: forall s. Decoder s [UtxoIndex]
encodeList :: [UtxoIndex] -> Encoding
$cencodeList :: [UtxoIndex] -> Encoding
decode :: Decoder s UtxoIndex
$cdecode :: forall s. Decoder s UtxoIndex
encode :: UtxoIndex -> Encoding
$cencode :: UtxoIndex -> Encoding
Serialise)
    deriving anyclass (Value -> Parser [UtxoIndex]
Value -> Parser UtxoIndex
(Value -> Parser UtxoIndex)
-> (Value -> Parser [UtxoIndex]) -> FromJSON UtxoIndex
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [UtxoIndex]
$cparseJSONList :: Value -> Parser [UtxoIndex]
parseJSON :: Value -> Parser UtxoIndex
$cparseJSON :: Value -> Parser UtxoIndex
FromJSON, [UtxoIndex] -> Encoding
[UtxoIndex] -> Value
UtxoIndex -> Encoding
UtxoIndex -> Value
(UtxoIndex -> Value)
-> (UtxoIndex -> Encoding)
-> ([UtxoIndex] -> Value)
-> ([UtxoIndex] -> Encoding)
-> ToJSON UtxoIndex
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [UtxoIndex] -> Encoding
$ctoEncodingList :: [UtxoIndex] -> Encoding
toJSONList :: [UtxoIndex] -> Value
$ctoJSONList :: [UtxoIndex] -> Value
toEncoding :: UtxoIndex -> Encoding
$ctoEncoding :: UtxoIndex -> Encoding
toJSON :: UtxoIndex -> Value
$ctoJSON :: UtxoIndex -> Value
ToJSON, UtxoIndex -> ()
(UtxoIndex -> ()) -> NFData UtxoIndex
forall a. (a -> ()) -> NFData a
rnf :: UtxoIndex -> ()
$crnf :: UtxoIndex -> ()
NFData)

-- | A reason why a transaction is invalid.
data ValidationError =
    TxOutRefNotFound PV1.TxOutRef
    -- ^ The transaction output consumed by a transaction input could not be found (either because it was already spent, or because
    -- there was no transaction with the given hash on the blockchain).
    | ScriptFailure Scripts.ScriptError
    -- ^ For pay-to-script outputs: evaluation of the validator script failed.
    | CardanoLedgerValidationError Text
    -- ^ An error from Cardano.Ledger validation
    deriving (ValidationError -> ValidationError -> Bool
(ValidationError -> ValidationError -> Bool)
-> (ValidationError -> ValidationError -> Bool)
-> Eq ValidationError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValidationError -> ValidationError -> Bool
$c/= :: ValidationError -> ValidationError -> Bool
== :: ValidationError -> ValidationError -> Bool
$c== :: ValidationError -> ValidationError -> Bool
Eq, Int -> ValidationError -> ShowS
[ValidationError] -> ShowS
ValidationError -> String
(Int -> ValidationError -> ShowS)
-> (ValidationError -> String)
-> ([ValidationError] -> ShowS)
-> Show ValidationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValidationError] -> ShowS
$cshowList :: [ValidationError] -> ShowS
show :: ValidationError -> String
$cshow :: ValidationError -> String
showsPrec :: Int -> ValidationError -> ShowS
$cshowsPrec :: Int -> ValidationError -> ShowS
Show, (forall x. ValidationError -> Rep ValidationError x)
-> (forall x. Rep ValidationError x -> ValidationError)
-> Generic ValidationError
forall x. Rep ValidationError x -> ValidationError
forall x. ValidationError -> Rep ValidationError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ValidationError x -> ValidationError
$cfrom :: forall x. ValidationError -> Rep ValidationError x
Generic)
makeClassyPrisms ''ValidationError

instance FromJSON ValidationError
instance ToJSON ValidationError
deriving via (PrettyShow ValidationError) instance Pretty ValidationError

data ValidationPhase = Phase1 | Phase2 deriving (ValidationPhase -> ValidationPhase -> Bool
(ValidationPhase -> ValidationPhase -> Bool)
-> (ValidationPhase -> ValidationPhase -> Bool)
-> Eq ValidationPhase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValidationPhase -> ValidationPhase -> Bool
$c/= :: ValidationPhase -> ValidationPhase -> Bool
== :: ValidationPhase -> ValidationPhase -> Bool
$c== :: ValidationPhase -> ValidationPhase -> Bool
Eq, Int -> ValidationPhase -> ShowS
[ValidationPhase] -> ShowS
ValidationPhase -> String
(Int -> ValidationPhase -> ShowS)
-> (ValidationPhase -> String)
-> ([ValidationPhase] -> ShowS)
-> Show ValidationPhase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValidationPhase] -> ShowS
$cshowList :: [ValidationPhase] -> ShowS
show :: ValidationPhase -> String
$cshow :: ValidationPhase -> String
showsPrec :: Int -> ValidationPhase -> ShowS
$cshowsPrec :: Int -> ValidationPhase -> ShowS
Show, (forall x. ValidationPhase -> Rep ValidationPhase x)
-> (forall x. Rep ValidationPhase x -> ValidationPhase)
-> Generic ValidationPhase
forall x. Rep ValidationPhase x -> ValidationPhase
forall x. ValidationPhase -> Rep ValidationPhase x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ValidationPhase x -> ValidationPhase
$cfrom :: forall x. ValidationPhase -> Rep ValidationPhase x
Generic, Value -> Parser [ValidationPhase]
Value -> Parser ValidationPhase
(Value -> Parser ValidationPhase)
-> (Value -> Parser [ValidationPhase]) -> FromJSON ValidationPhase
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ValidationPhase]
$cparseJSONList :: Value -> Parser [ValidationPhase]
parseJSON :: Value -> Parser ValidationPhase
$cparseJSON :: Value -> Parser ValidationPhase
FromJSON, [ValidationPhase] -> Encoding
[ValidationPhase] -> Value
ValidationPhase -> Encoding
ValidationPhase -> Value
(ValidationPhase -> Value)
-> (ValidationPhase -> Encoding)
-> ([ValidationPhase] -> Value)
-> ([ValidationPhase] -> Encoding)
-> ToJSON ValidationPhase
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ValidationPhase] -> Encoding
$ctoEncodingList :: [ValidationPhase] -> Encoding
toJSONList :: [ValidationPhase] -> Value
$ctoJSONList :: [ValidationPhase] -> Value
toEncoding :: ValidationPhase -> Encoding
$ctoEncoding :: ValidationPhase -> Encoding
toJSON :: ValidationPhase -> Value
$ctoJSON :: ValidationPhase -> Value
ToJSON)
deriving via (PrettyShow ValidationPhase) instance Pretty ValidationPhase
type ValidationErrorInPhase = (ValidationPhase, ValidationError)
type ValidationSuccess = Map.Map RdmrPtr ([Text], ExUnits)