{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

module Test.Cardano.Ledger.Allegra.Imp.UtxowSpec (
  spec,
) where

import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Core
import Cardano.Ledger.Shelley.Rules (ShelleyUtxowPredFailure (..))
import Cardano.Ledger.Shelley.TxAuxData (Metadatum (..))
import qualified Data.ByteString.Char8 as BS
import qualified Data.Map as Map
import qualified Data.Text as T
import Data.Word (Word64)
import Lens.Micro
import Test.Cardano.Ledger.Imp.Common
import Test.Cardano.Ledger.Shelley.Arbitrary (genUtf8StringOfSize)
import Test.Cardano.Ledger.Shelley.ImpTest

spec ::
  forall era.
  ( ShelleyEraImp era
  , InjectRuleFailure "LEDGER" ShelleyUtxowPredFailure era
  ) =>
  SpecWith (ImpInit (LedgerSpec era))
spec :: forall era.
(ShelleyEraImp era,
 InjectRuleFailure "LEDGER" ShelleyUtxowPredFailure era) =>
SpecWith (ImpInit (LedgerSpec era))
spec = forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"UTXOW" forall a b. (a -> b) -> a -> b
$ do
  forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"InvalidMetadata" forall a b. (a -> b) -> a -> b
$ do
    Map Word64 Metadatum
invalidMetadatum <- forall era. ImpTestM era (Map Word64 Metadatum)
genInvalidMetadata
    let auxData :: TxAuxData era
auxData = forall era. EraTxAuxData era => TxAuxData era
mkBasicTxAuxData forall a b. a -> (a -> b) -> b
& forall era.
EraTxAuxData era =>
Lens' (TxAuxData era) (Map Word64 Metadatum)
metadataTxAuxDataL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map Word64 Metadatum
invalidMetadatum
    let auxDataHash :: AuxiliaryDataHash (EraCrypto era)
auxDataHash = forall era.
EraTxAuxData era =>
TxAuxData era -> AuxiliaryDataHash (EraCrypto era)
hashTxAuxData TxAuxData era
auxData
    let tx :: Tx era
tx =
          forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
            forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens'
  (TxBody era) (StrictMaybe (AuxiliaryDataHash (EraCrypto era)))
auxDataHashTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictMaybe a
SJust AuxiliaryDataHash (EraCrypto era)
auxDataHash
            forall a b. a -> (a -> b) -> b
& forall era.
EraTx era =>
Lens' (Tx era) (StrictMaybe (TxAuxData era))
auxDataTxL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictMaybe a
SJust TxAuxData era
auxData
    forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx Tx era
tx [forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall era. ShelleyUtxowPredFailure era
InvalidMetadata]

genInvalidMetadata :: ImpTestM era (Map.Map Word64 Metadatum)
genInvalidMetadata :: forall era. ImpTestM era (Map Word64 Metadatum)
genInvalidMetadata = do
  Int
size <- forall (g :: * -> *) a. (MonadGen g, Random a) => (a, a) -> g a
choose (Int
65, Int
1000)
  let genM :: ImpM (LedgerSpec era) Metadatum
genM =
        forall (m :: * -> *) a. MonadGen m => [m a] -> m a
oneof
          [ ByteString -> Metadatum
B forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadGen m => Int -> m a -> m [a]
vectorOf Int
size forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
          , Text -> Metadatum
S forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (g :: * -> *) a. MonadGen g => Gen a -> g a
liftGen (Int -> Gen String
genUtf8StringOfSize Int
size)
          ]
  forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadGen m => m a -> m [a]
listOf1 ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ImpM (LedgerSpec era) Metadatum
genM)