{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
module Cardano.Chain.UTxO.Validation
( validateTx,
validateTxAux,
updateUTxO,
updateUTxOTxWitness,
updateUTxOTx,
TxValidationError (..),
Environment (..),
UTxOValidationError (..),
)
where
import Cardano.Binary
( Annotated (..),
Decoder,
DecoderError (DecoderErrorUnknownTag),
FromCBOR (..),
ToCBOR (..),
decodeListLen,
decodeWord8,
encodeListLen,
enforceSize,
matchSize,
)
import Cardano.Chain.Common
( Address (..),
Lovelace,
LovelaceError,
NetworkMagic,
TxFeePolicy (..),
addrNetworkMagic,
calculateTxSizeLinear,
checkRedeemAddress,
checkVerKeyAddress,
makeNetworkMagic,
mkKnownLovelace,
subLovelace,
unknownAttributesLength,
)
import Cardano.Chain.UTxO.Compact (CompactTxOut (..), toCompactTxIn)
import Cardano.Chain.UTxO.Tx (Tx (..), TxIn, TxOut (..))
import Cardano.Chain.UTxO.TxAux (ATxAux (..), aTaTx, taWitness)
import Cardano.Chain.UTxO.TxWitness
( TxInWitness (..),
TxSigData (..),
recoverSigData,
)
import Cardano.Chain.UTxO.UTxO
( UTxO,
UTxOError,
balance,
isRedeemUTxO,
txOutputUTxO,
(</|),
(<|),
)
import qualified Cardano.Chain.UTxO.UTxO as UTxO
import Cardano.Chain.UTxO.UTxOConfiguration
import Cardano.Chain.Update (ProtocolParameters (..))
import Cardano.Chain.ValidationMode
( ValidationMode,
unlessNoTxValidation,
whenTxValidation,
wrapErrorWithValidationMode,
)
import Cardano.Crypto
( AProtocolMagic (..),
ProtocolMagicId,
SignTag (..),
verifyRedeemSigDecoded,
verifySignatureDecoded,
)
import Cardano.Prelude
import qualified Data.ByteString as BS
import qualified Data.List.NonEmpty as NE
import qualified Data.Set as S
import qualified Data.Vector as V
data TxValidationError
= TxValidationLovelaceError Text LovelaceError
| TxValidationFeeTooSmall Tx Lovelace Lovelace
| TxValidationWitnessWrongSignature TxInWitness ProtocolMagicId TxSigData
| TxValidationWitnessWrongKey TxInWitness Address
| TxValidationMissingInput TxIn
|
TxValidationNetworkMagicMismatch NetworkMagic NetworkMagic
| TxValidationTxTooLarge Natural Natural
| TxValidationUnknownAddressAttributes
| TxValidationUnknownAttributes
deriving (TxValidationError -> TxValidationError -> Bool
(TxValidationError -> TxValidationError -> Bool)
-> (TxValidationError -> TxValidationError -> Bool)
-> Eq TxValidationError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxValidationError -> TxValidationError -> Bool
$c/= :: TxValidationError -> TxValidationError -> Bool
== :: TxValidationError -> TxValidationError -> Bool
$c== :: TxValidationError -> TxValidationError -> Bool
Eq, Int -> TxValidationError -> ShowS
[TxValidationError] -> ShowS
TxValidationError -> String
(Int -> TxValidationError -> ShowS)
-> (TxValidationError -> String)
-> ([TxValidationError] -> ShowS)
-> Show TxValidationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxValidationError] -> ShowS
$cshowList :: [TxValidationError] -> ShowS
show :: TxValidationError -> String
$cshow :: TxValidationError -> String
showsPrec :: Int -> TxValidationError -> ShowS
$cshowsPrec :: Int -> TxValidationError -> ShowS
Show)
instance ToCBOR TxValidationError where
toCBOR :: TxValidationError -> Encoding
toCBOR = \case
TxValidationLovelaceError Text
text LovelaceError
loveLaceError ->
Word -> Encoding
encodeListLen Word
3
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR @Word8 Word8
0
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Text -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Text
text
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> LovelaceError -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR LovelaceError
loveLaceError
TxValidationFeeTooSmall Tx
tx Lovelace
lovelace1 Lovelace
lovelace2 ->
Word -> Encoding
encodeListLen Word
4
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR @Word8 Word8
1
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Tx -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Tx
tx
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Lovelace -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Lovelace
lovelace1
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Lovelace -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Lovelace
lovelace2
TxValidationWitnessWrongSignature TxInWitness
txInWitness ProtocolMagicId
pmi TxSigData
sigData ->
Word -> Encoding
encodeListLen Word
4
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR @Word8 Word8
2
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TxInWitness -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR TxInWitness
txInWitness
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ProtocolMagicId -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ProtocolMagicId
pmi
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TxSigData -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR TxSigData
sigData
TxValidationWitnessWrongKey TxInWitness
txInWitness Address
addr ->
Word -> Encoding
encodeListLen Word
3
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR @Word8 Word8
3
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TxInWitness -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR TxInWitness
txInWitness
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Address -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Address
addr
TxValidationMissingInput TxIn
txIn ->
Word -> Encoding
encodeListLen Word
2
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR @Word8 Word8
4
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TxIn -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR TxIn
txIn
TxValidationNetworkMagicMismatch NetworkMagic
networkMagic1 NetworkMagic
networkMagic2 ->
Word -> Encoding
encodeListLen Word
3
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR @Word8 Word8
5
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> NetworkMagic -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR NetworkMagic
networkMagic1
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> NetworkMagic -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR NetworkMagic
networkMagic2
TxValidationTxTooLarge Natural
nat1 Natural
nat2 ->
Word -> Encoding
encodeListLen Word
3
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR @Word8 Word8
6
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Natural -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Natural
nat1
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Natural -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Natural
nat2
TxValidationError
TxValidationUnknownAddressAttributes ->
Word -> Encoding
encodeListLen Word
1
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR @Word8 Word8
7
TxValidationError
TxValidationUnknownAttributes ->
Word -> Encoding
encodeListLen Word
1
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR @Word8 Word8
8
instance FromCBOR TxValidationError where
fromCBOR :: Decoder s TxValidationError
fromCBOR = do
Int
len <- Decoder s Int
forall s. Decoder s Int
decodeListLen
let checkSize :: forall s. Int -> Decoder s ()
checkSize :: Int -> Decoder s ()
checkSize Int
size = Text -> Int -> Int -> Decoder s ()
forall s. Text -> Int -> Int -> Decoder s ()
matchSize Text
"TxValidationError" Int
size Int
len
Word8
tag <- Decoder s Word8
forall s. Decoder s Word8
decodeWord8
case Word8
tag of
Word8
0 -> Int -> Decoder s ()
forall s. Int -> Decoder s ()
checkSize Int
3 Decoder s ()
-> Decoder s TxValidationError -> Decoder s TxValidationError
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> LovelaceError -> TxValidationError
TxValidationLovelaceError (Text -> LovelaceError -> TxValidationError)
-> Decoder s Text -> Decoder s (LovelaceError -> TxValidationError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Text
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (LovelaceError -> TxValidationError)
-> Decoder s LovelaceError -> Decoder s TxValidationError
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s LovelaceError
forall a s. FromCBOR a => Decoder s a
fromCBOR
Word8
1 -> Int -> Decoder s ()
forall s. Int -> Decoder s ()
checkSize Int
4 Decoder s ()
-> Decoder s TxValidationError -> Decoder s TxValidationError
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Tx -> Lovelace -> Lovelace -> TxValidationError
TxValidationFeeTooSmall (Tx -> Lovelace -> Lovelace -> TxValidationError)
-> Decoder s Tx
-> Decoder s (Lovelace -> Lovelace -> TxValidationError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Tx
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (Lovelace -> Lovelace -> TxValidationError)
-> Decoder s Lovelace -> Decoder s (Lovelace -> TxValidationError)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Lovelace
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (Lovelace -> TxValidationError)
-> Decoder s Lovelace -> Decoder s TxValidationError
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Lovelace
forall a s. FromCBOR a => Decoder s a
fromCBOR
Word8
2 -> Int -> Decoder s ()
forall s. Int -> Decoder s ()
checkSize Int
4 Decoder s ()
-> Decoder s TxValidationError -> Decoder s TxValidationError
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TxInWitness -> ProtocolMagicId -> TxSigData -> TxValidationError
TxValidationWitnessWrongSignature (TxInWitness -> ProtocolMagicId -> TxSigData -> TxValidationError)
-> Decoder s TxInWitness
-> Decoder s (ProtocolMagicId -> TxSigData -> TxValidationError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s TxInWitness
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (ProtocolMagicId -> TxSigData -> TxValidationError)
-> Decoder s ProtocolMagicId
-> Decoder s (TxSigData -> TxValidationError)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s ProtocolMagicId
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (TxSigData -> TxValidationError)
-> Decoder s TxSigData -> Decoder s TxValidationError
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s TxSigData
forall a s. FromCBOR a => Decoder s a
fromCBOR
Word8
3 -> Int -> Decoder s ()
forall s. Int -> Decoder s ()
checkSize Int
3 Decoder s ()
-> Decoder s TxValidationError -> Decoder s TxValidationError
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TxInWitness -> Address -> TxValidationError
TxValidationWitnessWrongKey (TxInWitness -> Address -> TxValidationError)
-> Decoder s TxInWitness
-> Decoder s (Address -> TxValidationError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s TxInWitness
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (Address -> TxValidationError)
-> Decoder s Address -> Decoder s TxValidationError
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Address
forall a s. FromCBOR a => Decoder s a
fromCBOR
Word8
4 -> Int -> Decoder s ()
forall s. Int -> Decoder s ()
checkSize Int
2 Decoder s ()
-> Decoder s TxValidationError -> Decoder s TxValidationError
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TxIn -> TxValidationError
TxValidationMissingInput (TxIn -> TxValidationError)
-> Decoder s TxIn -> Decoder s TxValidationError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s TxIn
forall a s. FromCBOR a => Decoder s a
fromCBOR
Word8
5 -> Int -> Decoder s ()
forall s. Int -> Decoder s ()
checkSize Int
3 Decoder s ()
-> Decoder s TxValidationError -> Decoder s TxValidationError
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> NetworkMagic -> NetworkMagic -> TxValidationError
TxValidationNetworkMagicMismatch (NetworkMagic -> NetworkMagic -> TxValidationError)
-> Decoder s NetworkMagic
-> Decoder s (NetworkMagic -> TxValidationError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s NetworkMagic
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (NetworkMagic -> TxValidationError)
-> Decoder s NetworkMagic -> Decoder s TxValidationError
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s NetworkMagic
forall a s. FromCBOR a => Decoder s a
fromCBOR
Word8
6 -> Int -> Decoder s ()
forall s. Int -> Decoder s ()
checkSize Int
3 Decoder s ()
-> Decoder s TxValidationError -> Decoder s TxValidationError
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Natural -> Natural -> TxValidationError
TxValidationTxTooLarge (Natural -> Natural -> TxValidationError)
-> Decoder s Natural -> Decoder s (Natural -> TxValidationError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Natural
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (Natural -> TxValidationError)
-> Decoder s Natural -> Decoder s TxValidationError
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Natural
forall a s. FromCBOR a => Decoder s a
fromCBOR
Word8
7 -> Int -> Decoder s ()
forall s. Int -> Decoder s ()
checkSize Int
1 Decoder s () -> TxValidationError -> Decoder s TxValidationError
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TxValidationError
TxValidationUnknownAddressAttributes
Word8
8 -> Int -> Decoder s ()
forall s. Int -> Decoder s ()
checkSize Int
1 Decoder s () -> TxValidationError -> Decoder s TxValidationError
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TxValidationError
TxValidationUnknownAttributes
Word8
_ -> DecoderError -> Decoder s TxValidationError
forall e s a. Buildable e => e -> Decoder s a
cborError (DecoderError -> Decoder s TxValidationError)
-> DecoderError -> Decoder s TxValidationError
forall a b. (a -> b) -> a -> b
$ Text -> Word8 -> DecoderError
DecoderErrorUnknownTag Text
"TxValidationError" Word8
tag
validateTxAux ::
MonadError TxValidationError m =>
Environment ->
UTxO ->
ATxAux ByteString ->
m ()
validateTxAux :: Environment -> UTxO -> ATxAux ByteString -> m ()
validateTxAux Environment
env UTxO
utxo (ATxAux (Annotated Tx
tx ByteString
_) Annotated TxWitness ByteString
_ ByteString
txBytes) = do
Natural
txSize Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= Natural
maxTxSize
Bool -> TxValidationError -> m ()
forall e (m :: * -> *). MonadError e m => Bool -> e -> m ()
`orThrowError` Natural -> Natural -> TxValidationError
TxValidationTxTooLarge Natural
txSize Natural
maxTxSize
Lovelace
minFee <-
if UTxO -> Bool
isRedeemUTxO UTxO
inputUTxO
then Lovelace -> m Lovelace
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lovelace -> m Lovelace) -> Lovelace -> m Lovelace
forall a b. (a -> b) -> a -> b
$ (KnownNat 0, 0 <= 45000000000000000) => Lovelace
forall (n :: Nat). (KnownNat n, n <= 45000000000000000) => Lovelace
mkKnownLovelace @0
else TxFeePolicy -> m Lovelace
forall (m :: * -> *).
MonadError TxValidationError m =>
TxFeePolicy -> m Lovelace
calculateMinimumFee TxFeePolicy
feePolicy
Lovelace
balanceOut <-
UTxO -> Either LovelaceError Lovelace
balance (Tx -> UTxO
txOutputUTxO Tx
tx)
Either LovelaceError Lovelace
-> (LovelaceError -> TxValidationError) -> m Lovelace
forall e' (m :: * -> *) e a.
MonadError e' m =>
Either e a -> (e -> e') -> m a
`wrapError` Text -> LovelaceError -> TxValidationError
TxValidationLovelaceError Text
"Output Balance"
Lovelace
balanceIn <-
UTxO -> Either LovelaceError Lovelace
balance UTxO
inputUTxO
Either LovelaceError Lovelace
-> (LovelaceError -> TxValidationError) -> m Lovelace
forall e' (m :: * -> *) e a.
MonadError e' m =>
Either e a -> (e -> e') -> m a
`wrapError` Text -> LovelaceError -> TxValidationError
TxValidationLovelaceError Text
"Input Balance"
Lovelace
fee <-
Lovelace -> Lovelace -> Either LovelaceError Lovelace
subLovelace Lovelace
balanceIn Lovelace
balanceOut
Either LovelaceError Lovelace
-> (LovelaceError -> TxValidationError) -> m Lovelace
forall e' (m :: * -> *) e a.
MonadError e' m =>
Either e a -> (e -> e') -> m a
`wrapError` Text -> LovelaceError -> TxValidationError
TxValidationLovelaceError Text
"Fee"
(Lovelace
minFee Lovelace -> Lovelace -> Bool
forall a. Ord a => a -> a -> Bool
<= Lovelace
fee) Bool -> TxValidationError -> m ()
forall e (m :: * -> *). MonadError e m => Bool -> e -> m ()
`orThrowError` Tx -> Lovelace -> Lovelace -> TxValidationError
TxValidationFeeTooSmall Tx
tx Lovelace
minFee Lovelace
fee
where
Environment {ProtocolParameters
protocolParameters :: Environment -> ProtocolParameters
protocolParameters :: ProtocolParameters
protocolParameters} = Environment
env
maxTxSize :: Natural
maxTxSize = ProtocolParameters -> Natural
ppMaxTxSize ProtocolParameters
protocolParameters
feePolicy :: TxFeePolicy
feePolicy = ProtocolParameters -> TxFeePolicy
ppTxFeePolicy ProtocolParameters
protocolParameters
txSize :: Natural
txSize :: Natural
txSize = Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural) -> Int -> Natural
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
txBytes
inputUTxO :: UTxO
inputUTxO = [TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
S.fromList (NonEmpty TxIn -> [TxIn]
forall a. NonEmpty a -> [a]
NE.toList (Tx -> NonEmpty TxIn
txInputs Tx
tx)) Set TxIn -> UTxO -> UTxO
<| UTxO
utxo
calculateMinimumFee ::
MonadError TxValidationError m => TxFeePolicy -> m Lovelace
calculateMinimumFee :: TxFeePolicy -> m Lovelace
calculateMinimumFee = \case
TxFeePolicyTxSizeLinear TxSizeLinear
txSizeLinear ->
TxSizeLinear -> Natural -> Either LovelaceError Lovelace
calculateTxSizeLinear TxSizeLinear
txSizeLinear Natural
txSize
Either LovelaceError Lovelace
-> (LovelaceError -> TxValidationError) -> m Lovelace
forall e' (m :: * -> *) e a.
MonadError e' m =>
Either e a -> (e -> e') -> m a
`wrapError` Text -> LovelaceError -> TxValidationError
TxValidationLovelaceError Text
"Minimum Fee"
validateTx ::
MonadError TxValidationError m =>
Environment ->
UTxO ->
Annotated Tx ByteString ->
m ()
validateTx :: Environment -> UTxO -> Annotated Tx ByteString -> m ()
validateTx Environment
env UTxO
utxo (Annotated Tx
tx ByteString
_) = do
Attributes () -> Int
forall a. Attributes a -> Int
unknownAttributesLength (Tx -> Attributes ()
txAttributes Tx
tx) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
128
Bool -> TxValidationError -> m ()
forall e (m :: * -> *). MonadError e m => Bool -> e -> m ()
`orThrowError` TxValidationError
TxValidationUnknownAttributes
let nm :: NetworkMagic
nm = AProtocolMagic ByteString -> NetworkMagic
forall a. AProtocolMagic a -> NetworkMagic
makeNetworkMagic AProtocolMagic ByteString
protocolMagic
Tx -> NonEmpty TxOut
txOutputs Tx
tx NonEmpty TxOut -> (TxOut -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
`forM_` NetworkMagic -> TxOut -> m ()
forall (m :: * -> *).
MonadError TxValidationError m =>
NetworkMagic -> TxOut -> m ()
validateTxOutNM NetworkMagic
nm
Tx -> NonEmpty TxIn
txInputs Tx
tx NonEmpty TxIn -> (TxIn -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
`forM_` UTxOConfiguration -> UTxO -> TxIn -> m ()
forall (m :: * -> *).
MonadError TxValidationError m =>
UTxOConfiguration -> UTxO -> TxIn -> m ()
validateTxIn UTxOConfiguration
utxoConfiguration UTxO
utxo
where
Environment {AProtocolMagic ByteString
protocolMagic :: Environment -> AProtocolMagic ByteString
protocolMagic :: AProtocolMagic ByteString
protocolMagic, UTxOConfiguration
utxoConfiguration :: Environment -> UTxOConfiguration
utxoConfiguration :: UTxOConfiguration
utxoConfiguration} = Environment
env
validateTxIn ::
MonadError TxValidationError m =>
UTxOConfiguration ->
UTxO ->
TxIn ->
m ()
validateTxIn :: UTxOConfiguration -> UTxO -> TxIn -> m ()
validateTxIn UTxOConfiguration {Set CompactAddress
tcAssetLockedSrcAddrs :: UTxOConfiguration -> Set CompactAddress
tcAssetLockedSrcAddrs :: Set CompactAddress
tcAssetLockedSrcAddrs} UTxO
utxo TxIn
txIn
| Set CompactAddress -> Bool
forall a. Set a -> Bool
S.null Set CompactAddress
tcAssetLockedSrcAddrs,
TxIn
txIn TxIn -> UTxO -> Bool
`UTxO.member` UTxO
utxo =
() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
| Just CompactTxOut
txOut <- CompactTxIn -> UTxO -> Maybe CompactTxOut
UTxO.lookupCompact (TxIn -> CompactTxIn
toCompactTxIn TxIn
txIn) UTxO
utxo,
let (CompactTxOut CompactAddress
txOutAddr Lovelace
_) = CompactTxOut
txOut,
CompactAddress
txOutAddr CompactAddress -> Set CompactAddress -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set CompactAddress
tcAssetLockedSrcAddrs =
() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
| Bool
otherwise =
TxValidationError -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TxValidationError -> m ()) -> TxValidationError -> m ()
forall a b. (a -> b) -> a -> b
$ TxIn -> TxValidationError
TxValidationMissingInput TxIn
txIn
validateTxOutNM ::
MonadError TxValidationError m =>
NetworkMagic ->
TxOut ->
m ()
validateTxOutNM :: NetworkMagic -> TxOut -> m ()
validateTxOutNM NetworkMagic
nm TxOut
txOut = do
Attributes AddrAttributes -> Int
forall a. Attributes a -> Int
unknownAttributesLength (Address -> Attributes AddrAttributes
addrAttributes (TxOut -> Address
txOutAddress TxOut
txOut)) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
128
Bool -> TxValidationError -> m ()
forall e (m :: * -> *). MonadError e m => Bool -> e -> m ()
`orThrowError` TxValidationError
TxValidationUnknownAddressAttributes
(NetworkMagic
nm NetworkMagic -> NetworkMagic -> Bool
forall a. Eq a => a -> a -> Bool
== NetworkMagic
addrNm) Bool -> TxValidationError -> m ()
forall e (m :: * -> *). MonadError e m => Bool -> e -> m ()
`orThrowError` NetworkMagic -> NetworkMagic -> TxValidationError
TxValidationNetworkMagicMismatch NetworkMagic
nm NetworkMagic
addrNm
where
addrNm :: NetworkMagic
addrNm = Address -> NetworkMagic
addrNetworkMagic (Address -> NetworkMagic)
-> (TxOut -> Address) -> TxOut -> NetworkMagic
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TxOut -> Address
txOutAddress (TxOut -> NetworkMagic) -> TxOut -> NetworkMagic
forall a b. (a -> b) -> a -> b
$ TxOut
txOut
validateWitness ::
MonadError TxValidationError m =>
Annotated ProtocolMagicId ByteString ->
Annotated TxSigData ByteString ->
Address ->
TxInWitness ->
m ()
validateWitness :: Annotated ProtocolMagicId ByteString
-> Annotated TxSigData ByteString -> Address -> TxInWitness -> m ()
validateWitness Annotated ProtocolMagicId ByteString
pmi Annotated TxSigData ByteString
sigData Address
addr TxInWitness
witness = case TxInWitness
witness of
VKWitness VerificationKey
vk TxSig
sig -> do
Annotated ProtocolMagicId ByteString
-> SignTag
-> VerificationKey
-> Annotated TxSigData ByteString
-> Signature (BaseType (Annotated TxSigData ByteString))
-> Bool
forall t.
Decoded t =>
Annotated ProtocolMagicId ByteString
-> SignTag
-> VerificationKey
-> t
-> Signature (BaseType t)
-> Bool
verifySignatureDecoded Annotated ProtocolMagicId ByteString
pmi SignTag
SignTx VerificationKey
vk Annotated TxSigData ByteString
sigData Signature (BaseType (Annotated TxSigData ByteString))
TxSig
sig
Bool -> TxValidationError -> m ()
forall e (m :: * -> *). MonadError e m => Bool -> e -> m ()
`orThrowError` TxInWitness -> ProtocolMagicId -> TxSigData -> TxValidationError
TxValidationWitnessWrongSignature
TxInWitness
witness
(Annotated ProtocolMagicId ByteString -> ProtocolMagicId
forall b a. Annotated b a -> b
unAnnotated Annotated ProtocolMagicId ByteString
pmi)
(Annotated TxSigData ByteString -> TxSigData
forall b a. Annotated b a -> b
unAnnotated Annotated TxSigData ByteString
sigData)
VerificationKey -> Address -> Bool
checkVerKeyAddress VerificationKey
vk Address
addr
Bool -> TxValidationError -> m ()
forall e (m :: * -> *). MonadError e m => Bool -> e -> m ()
`orThrowError` TxInWitness -> Address -> TxValidationError
TxValidationWitnessWrongKey
TxInWitness
witness
Address
addr
RedeemWitness RedeemVerificationKey
vk RedeemSignature TxSigData
sig -> do
Annotated ProtocolMagicId ByteString
-> SignTag
-> RedeemVerificationKey
-> Annotated TxSigData ByteString
-> RedeemSignature (BaseType (Annotated TxSigData ByteString))
-> Bool
forall t.
Decoded t =>
Annotated ProtocolMagicId ByteString
-> SignTag
-> RedeemVerificationKey
-> t
-> RedeemSignature (BaseType t)
-> Bool
verifyRedeemSigDecoded Annotated ProtocolMagicId ByteString
pmi SignTag
SignRedeemTx RedeemVerificationKey
vk Annotated TxSigData ByteString
sigData RedeemSignature (BaseType (Annotated TxSigData ByteString))
RedeemSignature TxSigData
sig
Bool -> TxValidationError -> m ()
forall e (m :: * -> *). MonadError e m => Bool -> e -> m ()
`orThrowError` TxInWitness -> ProtocolMagicId -> TxSigData -> TxValidationError
TxValidationWitnessWrongSignature
TxInWitness
witness
(Annotated ProtocolMagicId ByteString -> ProtocolMagicId
forall b a. Annotated b a -> b
unAnnotated Annotated ProtocolMagicId ByteString
pmi)
(Annotated TxSigData ByteString -> TxSigData
forall b a. Annotated b a -> b
unAnnotated Annotated TxSigData ByteString
sigData)
RedeemVerificationKey -> Address -> Bool
checkRedeemAddress RedeemVerificationKey
vk Address
addr
Bool -> TxValidationError -> m ()
forall e (m :: * -> *). MonadError e m => Bool -> e -> m ()
`orThrowError` TxInWitness -> Address -> TxValidationError
TxValidationWitnessWrongKey TxInWitness
witness Address
addr
data Environment = Environment
{ Environment -> AProtocolMagic ByteString
protocolMagic :: !(AProtocolMagic ByteString),
Environment -> ProtocolParameters
protocolParameters :: !ProtocolParameters,
Environment -> UTxOConfiguration
utxoConfiguration :: !UTxOConfiguration
}
deriving (Environment -> Environment -> Bool
(Environment -> Environment -> Bool)
-> (Environment -> Environment -> Bool) -> Eq Environment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Environment -> Environment -> Bool
$c/= :: Environment -> Environment -> Bool
== :: Environment -> Environment -> Bool
$c== :: Environment -> Environment -> Bool
Eq, Int -> Environment -> ShowS
[Environment] -> ShowS
Environment -> String
(Int -> Environment -> ShowS)
-> (Environment -> String)
-> ([Environment] -> ShowS)
-> Show Environment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Environment] -> ShowS
$cshowList :: [Environment] -> ShowS
show :: Environment -> String
$cshow :: Environment -> String
showsPrec :: Int -> Environment -> ShowS
$cshowsPrec :: Int -> Environment -> ShowS
Show)
data UTxOValidationError
= UTxOValidationTxValidationError TxValidationError
| UTxOValidationUTxOError UTxOError
deriving (UTxOValidationError -> UTxOValidationError -> Bool
(UTxOValidationError -> UTxOValidationError -> Bool)
-> (UTxOValidationError -> UTxOValidationError -> Bool)
-> Eq UTxOValidationError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UTxOValidationError -> UTxOValidationError -> Bool
$c/= :: UTxOValidationError -> UTxOValidationError -> Bool
== :: UTxOValidationError -> UTxOValidationError -> Bool
$c== :: UTxOValidationError -> UTxOValidationError -> Bool
Eq, Int -> UTxOValidationError -> ShowS
[UTxOValidationError] -> ShowS
UTxOValidationError -> String
(Int -> UTxOValidationError -> ShowS)
-> (UTxOValidationError -> String)
-> ([UTxOValidationError] -> ShowS)
-> Show UTxOValidationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UTxOValidationError] -> ShowS
$cshowList :: [UTxOValidationError] -> ShowS
show :: UTxOValidationError -> String
$cshow :: UTxOValidationError -> String
showsPrec :: Int -> UTxOValidationError -> ShowS
$cshowsPrec :: Int -> UTxOValidationError -> ShowS
Show)
instance ToCBOR UTxOValidationError where
toCBOR :: UTxOValidationError -> Encoding
toCBOR = \case
UTxOValidationTxValidationError TxValidationError
txValidationError ->
Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR @Word8 Word8
0 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TxValidationError -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR TxValidationError
txValidationError
UTxOValidationUTxOError UTxOError
uTxOError ->
Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR @Word8 Word8
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> UTxOError -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR UTxOError
uTxOError
instance FromCBOR UTxOValidationError where
fromCBOR :: Decoder s UTxOValidationError
fromCBOR = do
Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"UTxOValidationError" Int
2
Decoder s Word8
forall s. Decoder s Word8
decodeWord8 Decoder s Word8
-> (Word8 -> Decoder s UTxOValidationError)
-> Decoder s UTxOValidationError
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Word8
0 -> TxValidationError -> UTxOValidationError
UTxOValidationTxValidationError (TxValidationError -> UTxOValidationError)
-> Decoder s TxValidationError -> Decoder s UTxOValidationError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s TxValidationError
forall a s. FromCBOR a => Decoder s a
fromCBOR
Word8
1 -> UTxOError -> UTxOValidationError
UTxOValidationUTxOError (UTxOError -> UTxOValidationError)
-> Decoder s UTxOError -> Decoder s UTxOValidationError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s UTxOError
forall a s. FromCBOR a => Decoder s a
fromCBOR
Word8
tag -> DecoderError -> Decoder s UTxOValidationError
forall e s a. Buildable e => e -> Decoder s a
cborError (DecoderError -> Decoder s UTxOValidationError)
-> DecoderError -> Decoder s UTxOValidationError
forall a b. (a -> b) -> a -> b
$ Text -> Word8 -> DecoderError
DecoderErrorUnknownTag Text
"UTxOValidationError" Word8
tag
updateUTxOTx ::
(MonadError UTxOValidationError m, MonadReader ValidationMode m) =>
Environment ->
UTxO ->
Annotated Tx ByteString ->
m UTxO
updateUTxOTx :: Environment -> UTxO -> Annotated Tx ByteString -> m UTxO
updateUTxOTx Environment
env UTxO
utxo aTx :: Annotated Tx ByteString
aTx@(Annotated Tx
tx ByteString
_) = do
ReaderT ValidationMode (Either TxValidationError) ()
-> ReaderT ValidationMode (Either TxValidationError) ()
forall err (m :: * -> *).
(MonadError err m, MonadReader ValidationMode m) =>
m () -> m ()
unlessNoTxValidation (Environment
-> UTxO
-> Annotated Tx ByteString
-> ReaderT ValidationMode (Either TxValidationError) ()
forall (m :: * -> *).
MonadError TxValidationError m =>
Environment -> UTxO -> Annotated Tx ByteString -> m ()
validateTx Environment
env UTxO
utxo Annotated Tx ByteString
aTx)
ReaderT ValidationMode (Either TxValidationError) ()
-> (TxValidationError -> UTxOValidationError) -> m ()
forall e' (m :: * -> *) e a.
(MonadError e' m, MonadReader ValidationMode m) =>
ReaderT ValidationMode (Either e) a -> (e -> e') -> m a
`wrapErrorWithValidationMode` TxValidationError -> UTxOValidationError
UTxOValidationTxValidationError
UTxO -> UTxO -> Either UTxOError UTxO
forall (m :: * -> *).
MonadError UTxOError m =>
UTxO -> UTxO -> m UTxO
UTxO.union ([TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
S.fromList (NonEmpty TxIn -> [TxIn]
forall a. NonEmpty a -> [a]
NE.toList (Tx -> NonEmpty TxIn
txInputs Tx
tx)) Set TxIn -> UTxO -> UTxO
</| UTxO
utxo) (Tx -> UTxO
txOutputUTxO Tx
tx)
Either UTxOError UTxO
-> (UTxOError -> UTxOValidationError) -> m UTxO
forall e' (m :: * -> *) e a.
MonadError e' m =>
Either e a -> (e -> e') -> m a
`wrapError` UTxOError -> UTxOValidationError
UTxOValidationUTxOError
updateUTxOTxWitness ::
(MonadError UTxOValidationError m, MonadReader ValidationMode m) =>
Environment ->
UTxO ->
ATxAux ByteString ->
m UTxO
updateUTxOTxWitness :: Environment -> UTxO -> ATxAux ByteString -> m UTxO
updateUTxOTxWitness Environment
env UTxO
utxo ATxAux ByteString
ta = do
m () -> m ()
forall err (m :: * -> *).
(MonadError err m, MonadReader ValidationMode m) =>
m () -> m ()
whenTxValidation (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
[Address]
addresses <-
(TxIn -> Either UTxOError Address)
-> [TxIn] -> Either UTxOError [Address]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (TxIn -> UTxO -> Either UTxOError Address
`UTxO.lookupAddress` UTxO
utxo) (NonEmpty TxIn -> [TxIn]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty TxIn -> [TxIn]) -> NonEmpty TxIn -> [TxIn]
forall a b. (a -> b) -> a -> b
$ Tx -> NonEmpty TxIn
txInputs Tx
tx)
Either UTxOError [Address]
-> (UTxOError -> UTxOValidationError) -> m [Address]
forall e' (m :: * -> *) e a.
MonadError e' m =>
Either e a -> (e -> e') -> m a
`wrapError` UTxOError -> UTxOValidationError
UTxOValidationUTxOError
((Address, TxInWitness) -> Either TxValidationError ())
-> [(Address, TxInWitness)] -> Either TxValidationError ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
((Address -> TxInWitness -> Either TxValidationError ())
-> (Address, TxInWitness) -> Either TxValidationError ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Address -> TxInWitness -> Either TxValidationError ())
-> (Address, TxInWitness) -> Either TxValidationError ())
-> (Address -> TxInWitness -> Either TxValidationError ())
-> (Address, TxInWitness)
-> Either TxValidationError ()
forall a b. (a -> b) -> a -> b
$ Annotated ProtocolMagicId ByteString
-> Annotated TxSigData ByteString
-> Address
-> TxInWitness
-> Either TxValidationError ()
forall (m :: * -> *).
MonadError TxValidationError m =>
Annotated ProtocolMagicId ByteString
-> Annotated TxSigData ByteString -> Address -> TxInWitness -> m ()
validateWitness Annotated ProtocolMagicId ByteString
pmi Annotated TxSigData ByteString
sigData)
([Address] -> [TxInWitness] -> [(Address, TxInWitness)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Address]
addresses (TxWitness -> [TxInWitness]
forall a. Vector a -> [a]
V.toList TxWitness
witness))
Either TxValidationError ()
-> (TxValidationError -> UTxOValidationError) -> m ()
forall e' (m :: * -> *) e a.
MonadError e' m =>
Either e a -> (e -> e') -> m a
`wrapError` TxValidationError -> UTxOValidationError
UTxOValidationTxValidationError
Environment
-> UTxO -> ATxAux ByteString -> Either TxValidationError ()
forall (m :: * -> *).
MonadError TxValidationError m =>
Environment -> UTxO -> ATxAux ByteString -> m ()
validateTxAux Environment
env UTxO
utxo ATxAux ByteString
ta
Either TxValidationError ()
-> (TxValidationError -> UTxOValidationError) -> m ()
forall e' (m :: * -> *) e a.
MonadError e' m =>
Either e a -> (e -> e') -> m a
`wrapError` TxValidationError -> UTxOValidationError
UTxOValidationTxValidationError
Environment -> UTxO -> Annotated Tx ByteString -> m UTxO
forall (m :: * -> *).
(MonadError UTxOValidationError m, MonadReader ValidationMode m) =>
Environment -> UTxO -> Annotated Tx ByteString -> m UTxO
updateUTxOTx Environment
env UTxO
utxo Annotated Tx ByteString
aTx
where
Environment {AProtocolMagic ByteString
protocolMagic :: AProtocolMagic ByteString
protocolMagic :: Environment -> AProtocolMagic ByteString
protocolMagic} = Environment
env
pmi :: Annotated ProtocolMagicId ByteString
pmi = AProtocolMagic ByteString -> Annotated ProtocolMagicId ByteString
forall a. AProtocolMagic a -> Annotated ProtocolMagicId a
getAProtocolMagicId AProtocolMagic ByteString
protocolMagic
aTx :: Annotated Tx ByteString
aTx@(Annotated Tx
tx ByteString
_) = ATxAux ByteString -> Annotated Tx ByteString
forall a. ATxAux a -> Annotated Tx a
aTaTx ATxAux ByteString
ta
witness :: TxWitness
witness = ATxAux ByteString -> TxWitness
forall a. ATxAux a -> TxWitness
taWitness ATxAux ByteString
ta
sigData :: Annotated TxSigData ByteString
sigData = Annotated Tx ByteString -> Annotated TxSigData ByteString
recoverSigData Annotated Tx ByteString
aTx
updateUTxO ::
(MonadError UTxOValidationError m, MonadReader ValidationMode m) =>
Environment ->
UTxO ->
[ATxAux ByteString] ->
m UTxO
updateUTxO :: Environment -> UTxO -> [ATxAux ByteString] -> m UTxO
updateUTxO Environment
env UTxO
as = (UTxO -> ATxAux ByteString -> m UTxO)
-> UTxO -> [ATxAux ByteString] -> m UTxO
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Environment -> UTxO -> ATxAux ByteString -> m UTxO
forall (m :: * -> *).
(MonadError UTxOValidationError m, MonadReader ValidationMode m) =>
Environment -> UTxO -> ATxAux ByteString -> m UTxO
updateUTxOTxWitness Environment
env) UTxO
as