{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Ledger.Shelley.Binary.RoundTrip (
  roundTripShelleyCommonSpec,
  roundTripStateEraTypesSpec,
) where

import Cardano.Ledger.Binary
import Cardano.Ledger.Core
import Cardano.Ledger.Metadata (Metadatum (I))
import Cardano.Ledger.Shelley (ShelleyEra)
import Cardano.Ledger.Shelley.LedgerState
import Cardano.Ledger.Shelley.State
import qualified Data.Text as T
import Test.Cardano.Base.Bytes (genByteString)
import Test.Cardano.Ledger.Binary.RoundTrip (
  embedTrip,
  embedTripRangeFailureExpectation,
  mkTrip,
 )
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Core.Binary.RoundTrip
import Test.Cardano.Ledger.Shelley.Arbitrary ()
import Test.Cardano.Ledger.Shelley.Binary.Annotator ()
import Test.Cardano.Ledger.Shelley.Era (ShelleyEraTest)

roundTripShelleyCommonSpec ::
  forall era.
  ( ShelleyEraTest era
  , RuleListEra era
  ) =>
  Spec
roundTripShelleyCommonSpec :: forall era. (ShelleyEraTest era, RuleListEra era) => Spec
roundTripShelleyCommonSpec = do
  forall era.
(EraTx era, EraCertState era, Arbitrary (Tx TopTx era),
 Arbitrary (TxBody TopTx era), Arbitrary (TxOut era),
 Arbitrary (TxCert era), Arbitrary (TxWits era),
 Arbitrary (TxAuxData era), Arbitrary (Value era),
 Arbitrary (CompactForm (Value era)), Arbitrary (Script era),
 Arbitrary (PParams era), Arbitrary (PParamsUpdate era),
 Arbitrary (CertState era), Arbitrary (Accounts era),
 DecCBOR (Script era), DecCBOR (TxAuxData era),
 DecCBOR (TxWits era), DecCBOR (TxBody TopTx era),
 DecCBOR (Tx TopTx era), Typeable (CertState era), HasCallStack) =>
Spec
roundTripCoreEraTypesSpec @era
  forall era.
(EraTxOut era, EraGov era, EraStake era, EraCertState era,
 Eq (StashedAVVMAddresses era), Show (StashedAVVMAddresses era),
 EncCBOR (StashedAVVMAddresses era),
 DecCBOR (StashedAVVMAddresses era),
 Arbitrary (StashedAVVMAddresses era), Arbitrary (TxOut era),
 Arbitrary (Value era), Arbitrary (PParams era),
 Arbitrary (GovState era), Arbitrary (CertState era),
 Arbitrary (InstantStake era)) =>
Spec
roundTripStateEraTypesSpec @era
  forall era. (RuleListEra era, Era era, HasCallStack) => Spec
roundTripAllPredicateFailures @era
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Metadatum size limits" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
    forall era. (Era era, HasCallStack) => (Version -> Spec) -> Spec
forEachEraVersion @era Version -> Spec
metadatumSizeLimitSpec
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Metadatum int range" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
    Version -> Version -> Spec
metadatumIntRangeSpec (forall era. Era era => Version
eraProtVerLow @era) (forall era. Era era => Version
eraProtVerHigh @era)

roundTripStateEraTypesSpec ::
  forall era.
  ( EraTxOut era
  , EraGov era
  , EraStake era
  , EraCertState era
  , Eq (StashedAVVMAddresses era)
  , Show (StashedAVVMAddresses era)
  , EncCBOR (StashedAVVMAddresses era)
  , DecCBOR (StashedAVVMAddresses era)
  , Arbitrary (StashedAVVMAddresses era)
  , Arbitrary (TxOut era)
  , Arbitrary (Value era)
  , Arbitrary (PParams era)
  , Arbitrary (GovState era)
  , Arbitrary (CertState era)
  , Arbitrary (InstantStake era)
  ) =>
  Spec
roundTripStateEraTypesSpec :: forall era.
(EraTxOut era, EraGov era, EraStake era, EraCertState era,
 Eq (StashedAVVMAddresses era), Show (StashedAVVMAddresses era),
 EncCBOR (StashedAVVMAddresses era),
 DecCBOR (StashedAVVMAddresses era),
 Arbitrary (StashedAVVMAddresses era), Arbitrary (TxOut era),
 Arbitrary (Value era), Arbitrary (PParams era),
 Arbitrary (GovState era), Arbitrary (CertState era),
 Arbitrary (InstantStake era)) =>
Spec
roundTripStateEraTypesSpec = do
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"State Types Families" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    forall era t.
(Era era, Typeable t, Show t, Eq t, EncCBOR t, DecShareCBOR t,
 Arbitrary t, HasCallStack) =>
Spec
roundTripShareEraSpec @era @(GovState era)
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"State Types" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    forall era (t :: * -> *).
(Era era, Typeable t, Show (t era), Eq (t era), EncCBOR (t era),
 DecShareCBOR (t era), Arbitrary (t era), HasCallStack) =>
Spec
roundTripShareEraTypeSpec @era @UTxOState
    forall era (t :: * -> *).
(Era era, Show (t era), Eq (t era), EncCBOR (t era),
 DecCBOR (t era), Arbitrary (t era), HasCallStack) =>
Spec
roundTripEraTypeSpec @era @EpochState
    forall era (t :: * -> *).
(Era era, Show (t era), Eq (t era), EncCBOR (t era),
 DecCBOR (t era), Arbitrary (t era), HasCallStack) =>
Spec
roundTripEraTypeSpec @era @NewEpochState

metadatumSizeLimitSpec :: Version -> Spec
metadatumSizeLimitSpec :: Version -> Spec
metadatumSizeLimitSpec Version
v = do
  let
    genAsciiText :: Int -> Gen Text
genAsciiText Int
n = String -> Text
T.pack (String -> Text) -> Gen String -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Char -> Gen String
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n ((Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
choose (Char
'a', Char
'z'))
    dec :: ToCBOR a => a -> Either DecoderError Metadatum
    dec :: forall a. ToCBOR a => a -> Either DecoderError Metadatum
dec = Version -> ByteString -> Either DecoderError Metadatum
forall a.
DecCBOR a =>
Version -> ByteString -> Either DecoderError a
decodeFull Version
v (ByteString -> Either DecoderError Metadatum)
-> (a -> ByteString) -> a -> Either DecoderError Metadatum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> ByteString
toLazyByteString (Encoding -> ByteString) -> (a -> Encoding) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
  String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Accepts bytes up to 64 bytes" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
    Gen ByteString -> (ByteString -> IO ()) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll ((Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
64) Gen Int -> (Int -> Gen ByteString) -> Gen ByteString
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Gen ByteString
genByteString) ((ByteString -> IO ()) -> Property)
-> (ByteString -> IO ()) -> Property
forall a b. (a -> b) -> a -> b
$ \ByteString
bs ->
      Either DecoderError Metadatum -> IO ()
forall a b.
(HasCallStack, ToExpr a, NFData b) =>
Either a b -> IO ()
expectRightDeepExpr_ (Either DecoderError Metadatum -> IO ())
-> Either DecoderError Metadatum -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Either DecoderError Metadatum
forall a. ToCBOR a => a -> Either DecoderError Metadatum
dec ByteString
bs
  String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Accepts text up to 64 bytes" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
    Gen Text -> (Text -> IO ()) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll ((Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
64) Gen Int -> (Int -> Gen Text) -> Gen Text
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Gen Text
genAsciiText) ((Text -> IO ()) -> Property) -> (Text -> IO ()) -> Property
forall a b. (a -> b) -> a -> b
$ \Text
txt ->
      Either DecoderError Metadatum -> IO ()
forall a b.
(HasCallStack, ToExpr a, NFData b) =>
Either a b -> IO ()
expectRightDeepExpr_ (Either DecoderError Metadatum -> IO ())
-> Either DecoderError Metadatum -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Either DecoderError Metadatum
forall a. ToCBOR a => a -> Either DecoderError Metadatum
dec Text
txt
  if Version
v Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
> forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @2
    then do
      String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Rejects bytes exceeding 64 bytes" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
        Gen ByteString -> (ByteString -> IO ()) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll ((Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
65, Int
1000) Gen Int -> (Int -> Gen ByteString) -> Gen ByteString
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Gen ByteString
genByteString) ((ByteString -> IO ()) -> Property)
-> (ByteString -> IO ()) -> Property
forall a b. (a -> b) -> a -> b
$ \ByteString
bs ->
          IO DecoderError -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO DecoderError -> IO ())
-> (Either DecoderError Metadatum -> IO DecoderError)
-> Either DecoderError Metadatum
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either DecoderError Metadatum -> IO DecoderError
forall b a. (HasCallStack, ToExpr b) => Either a b -> IO a
expectLeftExpr (Either DecoderError Metadatum -> IO ())
-> Either DecoderError Metadatum -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Either DecoderError Metadatum
forall a. ToCBOR a => a -> Either DecoderError Metadatum
dec ByteString
bs
      String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Rejects text exceeding 64 bytes" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
        Gen Text -> (Text -> IO ()) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll ((Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
65, Int
1000) Gen Int -> (Int -> Gen Text) -> Gen Text
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Gen Text
genAsciiText) ((Text -> IO ()) -> Property) -> (Text -> IO ()) -> Property
forall a b. (a -> b) -> a -> b
$ \Text
txt ->
          IO DecoderError -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO DecoderError -> IO ())
-> (Either DecoderError Metadatum -> IO DecoderError)
-> Either DecoderError Metadatum
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either DecoderError Metadatum -> IO DecoderError
forall b a. (HasCallStack, ToExpr b) => Either a b -> IO a
expectLeftExpr (Either DecoderError Metadatum -> IO ())
-> Either DecoderError Metadatum -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Either DecoderError Metadatum
forall a. ToCBOR a => a -> Either DecoderError Metadatum
dec Text
txt
    else do
      String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Accepts bytes exceeding 64 bytes" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
        Gen ByteString -> (ByteString -> IO ()) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll ((Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
65, Int
1000) Gen Int -> (Int -> Gen ByteString) -> Gen ByteString
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Gen ByteString
genByteString) ((ByteString -> IO ()) -> Property)
-> (ByteString -> IO ()) -> Property
forall a b. (a -> b) -> a -> b
$ \ByteString
bs ->
          Either DecoderError Metadatum -> IO ()
forall a b.
(HasCallStack, ToExpr a, NFData b) =>
Either a b -> IO ()
expectRightDeepExpr_ (Either DecoderError Metadatum -> IO ())
-> Either DecoderError Metadatum -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Either DecoderError Metadatum
forall a. ToCBOR a => a -> Either DecoderError Metadatum
dec ByteString
bs
      String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Accepts text exceeding 64 bytes" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
        Gen Text -> (Text -> IO ()) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll ((Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
65, Int
1000) Gen Int -> (Int -> Gen Text) -> Gen Text
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Gen Text
genAsciiText) ((Text -> IO ()) -> Property) -> (Text -> IO ()) -> Property
forall a b. (a -> b) -> a -> b
$ \Text
txt ->
          Either DecoderError Metadatum -> IO ()
forall a b.
(HasCallStack, ToExpr a, NFData b) =>
Either a b -> IO ()
expectRightDeepExpr_ (Either DecoderError Metadatum -> IO ())
-> Either DecoderError Metadatum -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Either DecoderError Metadatum
forall a. ToCBOR a => a -> Either DecoderError Metadatum
dec Text
txt

metadatumIntRangeSpec :: Version -> Version -> Spec
metadatumIntRangeSpec :: Version -> Version -> Spec
metadatumIntRangeSpec Version
fromVersion Version
toVersion = do
  let
    -- CBOR int range: -2^64 .. 2^64-1
    maxInt :: Integer
    maxInt :: Integer
maxInt = Integer
2 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
64 :: Int) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1
    minInt :: Integer
    minInt :: Integer
minInt = -(Integer
2 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
64 :: Int))
    intToMetadatum :: Trip Integer Metadatum
intToMetadatum = (Integer -> Encoding)
-> (forall s. Decoder s Metadatum) -> Trip Integer Metadatum
forall a b. (a -> Encoding) -> (forall s. Decoder s b) -> Trip a b
mkTrip (forall a. EncCBOR a => a -> Encoding
encCBOR @Integer) (forall a s. DecCBOR a => Decoder s a
decCBOR @Metadatum)
    expectAccepted :: Integer -> IO ()
expectAccepted Integer
n =
      [Version] -> (Version -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Version
fromVersion .. Version
toVersion] ((Version -> IO ()) -> IO ()) -> (Version -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Version
v ->
        case Version
-> Version
-> Trip Integer Metadatum
-> Integer
-> Either RoundTripFailure Metadatum
forall a b.
(Eq b, Typeable b) =>
Version -> Version -> Trip a b -> a -> Either RoundTripFailure b
embedTrip Version
v Version
v Trip Integer Metadatum
intToMetadatum Integer
n of
          Left RoundTripFailure
err -> HasCallStack => String -> IO ()
String -> IO ()
expectationFailure (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Failed to deserialize: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ RoundTripFailure -> String
forall a. Show a => a -> String
show RoundTripFailure
err
          Right Metadatum
m -> Metadatum
m Metadatum -> Metadatum -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Integer -> Metadatum
I Integer
n
    expectRejected :: Integer -> IO ()
expectRejected = Trip Integer Metadatum -> Version -> Version -> Integer -> IO ()
forall a b.
(Typeable b, Eq b, HasCallStack) =>
Trip a b -> Version -> Version -> a -> IO ()
embedTripRangeFailureExpectation Trip Integer Metadatum
intToMetadatum Version
fromVersion Version
toVersion
    -- Test the binary decoder directly, bypassing FlatTerm.
    -- This is needed because cborg's FlatTerm has an off-by-one bug in
    -- tokenTypeOf that misclassifies -(2^64) as TypeInteger instead of
    -- TypeNInt64 (https://github.com/well-typed/cborg/issues/377)
    --
    -- This bug only affect the tests, not the actual decoder, because the
    -- actual decoder does not go through FlatTerm
    expectBinaryAccepted :: Integer -> IO ()
expectBinaryAccepted Integer
n =
      [Version] -> (Version -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Version
fromVersion .. Version
toVersion] ((Version -> IO ()) -> IO ()) -> (Version -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Version
v ->
        forall a.
DecCBOR a =>
Version -> ByteString -> Either DecoderError a
decodeFull @Metadatum Version
v (Version -> Integer -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize Version
v Integer
n) Either DecoderError Metadatum
-> Either DecoderError Metadatum -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Metadatum -> Either DecoderError Metadatum
forall a b. b -> Either a b
Right (Integer -> Metadatum
I Integer
n)
    expectBinaryRejected :: Integer -> IO ()
expectBinaryRejected Integer
n =
      [Version] -> (Version -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Version
fromVersion .. Version
toVersion] ((Version -> IO ()) -> IO ()) -> (Version -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Version
v ->
        case forall a.
DecCBOR a =>
Version -> ByteString -> Either DecoderError a
decodeFull @Metadatum Version
v (Version -> Integer -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize Version
v Integer
n) of
          Left DecoderError
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Right Metadatum
_ -> HasCallStack => String -> IO ()
String -> IO ()
expectationFailure (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Should not have deserialized: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
n
  String -> IO () -> SpecM (Arg (IO ())) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Accepts max int (2^64-1)" (IO () -> SpecM (Arg (IO ())) ())
-> IO () -> SpecM (Arg (IO ())) ()
forall a b. (a -> b) -> a -> b
$
    Integer -> IO ()
expectAccepted Integer
maxInt
  String -> IO () -> SpecM (Arg (IO ())) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Accepts max int (2^64-1) (binary)" (IO () -> SpecM (Arg (IO ())) ())
-> IO () -> SpecM (Arg (IO ())) ()
forall a b. (a -> b) -> a -> b
$
    Integer -> IO ()
expectBinaryAccepted Integer
maxInt
  -- TODO: enable this once the cborg FlatTerm bug is fixed
  String -> IO () -> SpecM (Arg (IO ())) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
xit String
"Accepts min int (-(2^64))" (IO () -> SpecM (Arg (IO ())) ())
-> IO () -> SpecM (Arg (IO ())) ()
forall a b. (a -> b) -> a -> b
$
    Integer -> IO ()
expectAccepted Integer
minInt
  String -> IO () -> SpecM (Arg (IO ())) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Accepts min int (-(2^64)) (binary)" (IO () -> SpecM (Arg (IO ())) ())
-> IO () -> SpecM (Arg (IO ())) ()
forall a b. (a -> b) -> a -> b
$
    Integer -> IO ()
expectBinaryAccepted Integer
minInt
  String -> IO () -> SpecM (Arg (IO ())) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Rejects positive big integer (2^64)" (IO () -> SpecM (Arg (IO ())) ())
-> IO () -> SpecM (Arg (IO ())) ()
forall a b. (a -> b) -> a -> b
$
    Integer -> IO ()
expectRejected (Integer
maxInt Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)
  String -> IO () -> SpecM (Arg (IO ())) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Rejects positive big integer (2^64) (binary)" (IO () -> SpecM (Arg (IO ())) ())
-> IO () -> SpecM (Arg (IO ())) ()
forall a b. (a -> b) -> a -> b
$
    Integer -> IO ()
expectBinaryRejected (Integer
maxInt Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)
  String -> IO () -> SpecM (Arg (IO ())) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Rejects negative big integer (-(2^64+1))" (IO () -> SpecM (Arg (IO ())) ())
-> IO () -> SpecM (Arg (IO ())) ()
forall a b. (a -> b) -> a -> b
$
    Integer -> IO ()
expectRejected (Integer
minInt Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
  String -> IO () -> SpecM (Arg (IO ())) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Rejects negative big integer (-(2^64+1)) (binary)" (IO () -> SpecM (Arg (IO ())) ())
-> IO () -> SpecM (Arg (IO ())) ()
forall a b. (a -> b) -> a -> b
$
    Integer -> IO ()
expectBinaryRejected (Integer
minInt Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
  String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Accepts any int in CBOR range" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
    Gen Integer -> (Integer -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll ((Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
minInt, Integer
maxInt)) ((Integer -> Property) -> Property)
-> (Integer -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Integer
n ->
      IO () -> Property
forall prop. Testable prop => prop -> Property
property (IO () -> Property) -> IO () -> Property
forall a b. (a -> b) -> a -> b
$ Integer -> IO ()
expectBinaryAccepted Integer
n

instance RuleListEra ShelleyEra where
  type
    EraRules ShelleyEra =
      '[ "DELEG"
       , "DELEGS"
       , "DELPL"
       , "LEDGER"
       , "LEDGERS"
       , "POOL"
       , "PPUP"
       , "UTXO"
       , "UTXOW"
       ]