{-# 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 => SpecWith (ImpInit (LedgerSpec era))
spec :: forall era.
ShelleyEraImp era =>
SpecWith (ImpInit (LedgerSpec era))
spec = String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"UTXOW" (SpecWith (ImpInit (LedgerSpec era))
 -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
  String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"InvalidMetadata" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
    invalidMetadatum <- ImpTestM era (Map Word64 Metadatum)
forall era. ImpTestM era (Map Word64 Metadatum)
genInvalidMetadata
    let auxData = TxAuxData era
forall era. EraTxAuxData era => TxAuxData era
mkBasicTxAuxData TxAuxData era -> (TxAuxData era -> TxAuxData era) -> TxAuxData era
forall a b. a -> (a -> b) -> b
& (Map Word64 Metadatum -> Identity (Map Word64 Metadatum))
-> TxAuxData era -> Identity (TxAuxData era)
forall era.
EraTxAuxData era =>
Lens' (TxAuxData era) (Map Word64 Metadatum)
Lens' (TxAuxData era) (Map Word64 Metadatum)
metadataTxAuxDataL ((Map Word64 Metadatum -> Identity (Map Word64 Metadatum))
 -> TxAuxData era -> Identity (TxAuxData era))
-> Map Word64 Metadatum -> TxAuxData era -> TxAuxData era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map Word64 Metadatum
invalidMetadatum
    let auxDataHash = TxAuxData era -> TxAuxDataHash
forall era. EraTxAuxData era => TxAuxData era -> TxAuxDataHash
hashTxAuxData TxAuxData era
auxData
    let tx =
          TxBody TopTx era -> Tx TopTx era
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l era -> Tx l era
mkBasicTx TxBody TopTx era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody
            Tx TopTx era -> (Tx TopTx era -> Tx TopTx era) -> Tx TopTx era
forall a b. a -> (a -> b) -> b
& (TxBody TopTx era -> Identity (TxBody TopTx era))
-> Tx TopTx era -> Identity (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody TopTx era -> Identity (TxBody TopTx era))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> ((StrictMaybe TxAuxDataHash
     -> Identity (StrictMaybe TxAuxDataHash))
    -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> (StrictMaybe TxAuxDataHash
    -> Identity (StrictMaybe TxAuxDataHash))
-> Tx TopTx era
-> Identity (Tx TopTx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe TxAuxDataHash -> Identity (StrictMaybe TxAuxDataHash))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictMaybe TxAuxDataHash)
forall (l :: TxLevel).
Lens' (TxBody l era) (StrictMaybe TxAuxDataHash)
auxDataHashTxBodyL ((StrictMaybe TxAuxDataHash
  -> Identity (StrictMaybe TxAuxDataHash))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> StrictMaybe TxAuxDataHash -> Tx TopTx era -> Tx TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxAuxDataHash -> StrictMaybe TxAuxDataHash
forall a. a -> StrictMaybe a
SJust TxAuxDataHash
auxDataHash
            Tx TopTx era -> (Tx TopTx era -> Tx TopTx era) -> Tx TopTx era
forall a b. a -> (a -> b) -> b
& (StrictMaybe (TxAuxData era)
 -> Identity (StrictMaybe (TxAuxData era)))
-> Tx TopTx era -> Identity (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (StrictMaybe (TxAuxData era))
forall (l :: TxLevel).
Lens' (Tx l era) (StrictMaybe (TxAuxData era))
auxDataTxL ((StrictMaybe (TxAuxData era)
  -> Identity (StrictMaybe (TxAuxData era)))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> StrictMaybe (TxAuxData era) -> Tx TopTx era -> Tx TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxAuxData era -> StrictMaybe (TxAuxData era)
forall a. a -> StrictMaybe a
SJust TxAuxData era
auxData
    submitFailingTx tx [injectFailure InvalidMetadata]

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