{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Test.Cardano.Ledger.AddressSpec (spec) where

import qualified Cardano.Chain.Common as Byron
import qualified Cardano.Crypto.Hash.Class as Hash
import Cardano.Ledger.Address
import Cardano.Ledger.Binary (Version, byronProtVer, decodeFull', natVersion, serialize')
import Cardano.Ledger.Credential
import Cardano.Ledger.Hashes (ADDRHASH)
import Cardano.Ledger.Keys (
  BootstrapWitness (..),
  bootstrapWitKeyHash,
  coerceKeyRole,
  unpackByronVKey,
 )
import Control.Monad.Trans.Fail.String (errorFail)
import qualified Data.Binary.Put as B
import Data.Bits
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.Short as SBS
import Data.Either
import Data.Maybe (isNothing)
import Data.Proxy
import Data.Word
import Test.Cardano.Ledger.Binary.RoundTrip (
  cborTrip,
  roundTripCborSpec,
  roundTripRangeExpectation,
 )
import Test.Cardano.Ledger.Common hiding ((.&.))
import Test.Cardano.Ledger.Core.Address
import Test.Cardano.Ledger.Core.Arbitrary (genAddrBadPtr, genCompactAddrBadPtr)
import Test.Cardano.Ledger.Core.KeyPair (genByronVKeyAddr)

spec :: Spec
spec :: Spec
spec =
  forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a
describe [Char]
"Address" forall a b. (a -> b) -> a -> b
$ do
    Spec
roundTripAddressSpec
    forall prop.
(HasCallStack, Testable prop) =>
[Char] -> prop -> Spec
prop [Char]
"rebuild the 'addr root' using a bootstrap witness" forall a b. (a -> b) -> a -> b
$ do
      (VerificationKey
byronVKey, Address
byronAddr) <- Gen (VerificationKey, Address)
genByronVKeyAddr
      SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
sig <- forall a. Arbitrary a => Gen a
arbitrary
      let addr :: BootstrapAddress
addr = Address -> BootstrapAddress
BootstrapAddress Address
byronAddr
          (VKey 'Witness
shelleyVKey, ChainCode
chainCode) = VerificationKey -> (VKey 'Witness, ChainCode)
unpackByronVKey VerificationKey
byronVKey
          wit :: BootstrapWitness
          wit :: BootstrapWitness
wit =
            BootstrapWitness
              { bwKey :: VKey 'Witness
bwKey = VKey 'Witness
shelleyVKey
              , bwChainCode :: ChainCode
bwChainCode = ChainCode
chainCode
              , bwSig :: SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
bwSig = SignedDSIGN DSIGN (Hash HASH EraIndependentTxBody)
sig
              , bwAttributes :: ByteString
bwAttributes = forall a. EncCBOR a => Version -> a -> ByteString
serialize' Version
byronProtVer forall a b. (a -> b) -> a -> b
$ Address -> Attributes AddrAttributes
Byron.addrAttributes Address
byronAddr
              }
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole (BootstrapAddress -> KeyHash 'Payment
bootstrapKeyHash BootstrapAddress
addr)
          forall a. (Eq a, Show a) => a -> a -> Property
=== BootstrapWitness -> KeyHash 'Witness
bootstrapWitKeyHash BootstrapWitness
wit

roundTripAddressSpec :: Spec
roundTripAddressSpec :: Spec
roundTripAddressSpec = do
  forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a
describe [Char]
"CompactAddr" forall a b. (a -> b) -> a -> b
$ do
    forall t. (Show t, Eq t, Arbitrary t, EncCBOR t, DecCBOR t) => Spec
roundTripCborSpec @CompactAddr
    forall prop.
(HasCallStack, Testable prop) =>
[Char] -> prop -> Spec
prop [Char]
"compactAddr/decompactAddr round trip" forall a b. (a -> b) -> a -> b
$
      forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen Addr
genAddrBadPtr forall a b. (a -> b) -> a -> b
$
        Addr -> Property
propCompactAddrRoundTrip
    forall prop.
(HasCallStack, Testable prop) =>
[Char] -> prop -> Spec
prop [Char]
"Compact address binary representation" forall a b. (a -> b) -> a -> b
$
      forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen Addr
genAddrBadPtr forall a b. (a -> b) -> a -> b
$
        Addr -> Property
propCompactSerializationAgree
    forall prop.
(HasCallStack, Testable prop) =>
[Char] -> prop -> Spec
prop [Char]
"Ensure Addr failures on incorrect binary data" forall a b. (a -> b) -> a -> b
$
      Addr -> Gen Property
propDecompactErrors
    forall prop.
(HasCallStack, Testable prop) =>
[Char] -> prop -> Spec
prop [Char]
"Ensure RewardAccount failures on incorrect binary data" forall a b. (a -> b) -> a -> b
$
      Version -> RewardAccount -> Gen Property
propDeserializeRewardAccountErrors
    forall prop.
(HasCallStack, Testable prop) =>
[Char] -> prop -> Spec
prop [Char]
"RoundTrip-invalid" forall a b. (a -> b) -> a -> b
$
      forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen CompactAddr
genCompactAddrBadPtr forall a b. (a -> b) -> a -> b
$
        forall t.
(Show t, Eq t, Typeable t, HasCallStack) =>
Trip t t -> Version -> Version -> t -> Expectation
roundTripRangeExpectation @CompactAddr
          forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip
          (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @2)
          (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @6)
    forall prop.
(HasCallStack, Testable prop) =>
[Char] -> prop -> Spec
prop [Char]
"Decompact addr with junk" forall a b. (a -> b) -> a -> b
$
      HasCallStack => Addr -> ByteString -> Expectation
propDecompactAddrWithJunk
    forall prop.
(HasCallStack, Testable prop) =>
[Char] -> prop -> Spec
prop [Char]
"Same as old decompactor" forall a b. (a -> b) -> a -> b
$ CompactAddr -> Expectation
propSameAsOldDecompactAddr
    forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"fail on extraneous bytes" forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *). MonadFail m => ByteString -> m Addr
decodeAddr HasCallStack => ByteString
addressWithExtraneousBytes forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` forall a. Maybe a
Nothing
  forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a
describe [Char]
"Addr" forall a b. (a -> b) -> a -> b
$ do
    forall t. (Show t, Eq t, Arbitrary t, EncCBOR t, DecCBOR t) => Spec
roundTripCborSpec @Addr
    forall prop.
(HasCallStack, Testable prop) =>
[Char] -> prop -> Spec
prop [Char]
"RoundTrip-invalid" forall a b. (a -> b) -> a -> b
$
      forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen Addr
genAddrBadPtr forall a b. (a -> b) -> a -> b
$
        forall t.
(Show t, Eq t, Typeable t, HasCallStack) =>
Trip t t -> Version -> Version -> t -> Expectation
roundTripRangeExpectation @Addr forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @2) (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @6)
    forall prop.
(HasCallStack, Testable prop) =>
[Char] -> prop -> Spec
prop [Char]
"Deserializing an address matches old implementation" forall a b. (a -> b) -> a -> b
$
      HasCallStack => Addr -> Property
propValidateNewDeserialize
  forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a
describe [Char]
"RewardAccount" forall a b. (a -> b) -> a -> b
$ do
    forall t. (Show t, Eq t, Arbitrary t, EncCBOR t, DecCBOR t) => Spec
roundTripCborSpec @RewardAccount

propSameAsOldDecompactAddr :: CompactAddr -> Expectation
propSameAsOldDecompactAddr :: CompactAddr -> Expectation
propSameAsOldDecompactAddr CompactAddr
cAddr = do
  Addr
addr forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` CompactAddr -> Addr
decompactAddrOld CompactAddr
cAddr
  Addr
addr forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` CompactAddr -> Addr
decompactAddrOldLazy CompactAddr
cAddr
  where
    addr :: Addr
addr = HasCallStack => CompactAddr -> Addr
decompactAddr CompactAddr
cAddr

propDecompactAddrWithJunk ::
  HasCallStack =>
  Addr ->
  BS.ByteString ->
  Expectation
propDecompactAddrWithJunk :: HasCallStack => Addr -> ByteString -> Expectation
propDecompactAddrWithJunk Addr
addr ByteString
junk = do
  -- Add garbage to the end of serialized non-Byron address
  ByteString
bs <- case Addr
addr of
    AddrBootstrap BootstrapAddress
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Addr -> ByteString
serialiseAddr Addr
addr
    Addr
_ -> do
      let bs :: ByteString
bs = Addr -> ByteString
serialiseAddr Addr
addr forall a. Semigroup a => a -> a -> a
<> ByteString
junk
      -- ensure we fail decoding of compact addresses with junk at the end
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int
BS.length ByteString
junk forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$ do
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @7 .. forall a. Bounded a => a
maxBound] forall a b. (a -> b) -> a -> b
$ \Version
version -> do
          let cbor :: ByteString
cbor = forall a. EncCBOR a => Version -> a -> ByteString
serialize' Version
version ByteString
bs
          forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a.
DecCBOR a =>
Version -> ByteString -> Either DecoderError a
decodeFull' Version
version ByteString
cbor) forall a b. (a -> b) -> a -> b
$ \(CompactAddr
cAddr :: CompactAddr) ->
            HasCallStack => [Char] -> Expectation
expectationFailure forall a b. (a -> b) -> a -> b
$
              [[Char]] -> [Char]
unlines
                [ [Char]
"Decoding with version: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Version
version
                , [Char]
"unexpectedly was able to parse an address with junk at the end: "
                , forall a. Show a => a -> [Char]
show ByteString
cbor
                , [Char]
"as: "
                , forall a. Show a => a -> [Char]
show CompactAddr
cAddr
                ]
      forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
bs
  -- Ensure we drop off the junk at the end all the way through Alonzo
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [forall a. Bounded a => a
minBound .. forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @6] forall a b. (a -> b) -> a -> b
$ \Version
version -> do
    -- Encode with garbage
    let cbor :: ByteString
cbor = forall a. EncCBOR a => Version -> a -> ByteString
serialize' Version
version ByteString
bs
    -- Decode as compact address
    CompactAddr
cAddr :: CompactAddr <-
      forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => [Char] -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a.
DecCBOR a =>
Version -> ByteString -> Either DecoderError a
decodeFull' Version
version ByteString
cbor
    -- Ensure that garbage is gone (decodeAddr will fail otherwise)
    forall (m :: * -> *). MonadFail m => ByteString -> m Addr
decodeAddr (Addr -> ByteString
serialiseAddr (HasCallStack => CompactAddr -> Addr
decompactAddr CompactAddr
cAddr)) forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> Expectation
`shouldReturn` Addr
addr

propValidateNewDeserialize :: HasCallStack => Addr -> Property
propValidateNewDeserialize :: HasCallStack => Addr -> Property
propValidateNewDeserialize Addr
addr = forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ do
  let bs :: ByteString
bs = Addr -> ByteString
serialiseAddr Addr
addr
      deserializedOld :: Addr
deserializedOld = forall a. HasCallStack => Fail a -> a
errorFail forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadFail m => ByteString -> m Addr
deserialiseAddrOld ByteString
bs
      deserializedNew :: Addr
deserializedNew = forall a. HasCallStack => Fail a -> a
errorFail forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadFail m => ByteString -> m Addr
decodeAddr ByteString
bs
  Addr
deserializedNew forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Addr
addr
  Addr
deserializedOld forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Addr
deserializedNew

propCompactAddrRoundTrip :: Addr -> Property
propCompactAddrRoundTrip :: Addr -> Property
propCompactAddrRoundTrip Addr
addr =
  let compact :: CompactAddr
compact = Addr -> CompactAddr
compactAddr Addr
addr
      decompact :: Addr
decompact = HasCallStack => CompactAddr -> Addr
decompactAddr CompactAddr
compact
   in Addr
addr forall a. (Eq a, Show a) => a -> a -> Property
=== Addr
decompact

propCompactSerializationAgree :: Addr -> Property
propCompactSerializationAgree :: Addr -> Property
propCompactSerializationAgree Addr
addr =
  let sbs :: ShortByteString
sbs = CompactAddr -> ShortByteString
unCompactAddr forall a b. (a -> b) -> a -> b
$ Addr -> CompactAddr
compactAddr Addr
addr
   in ShortByteString
sbs forall a. (Eq a, Show a) => a -> a -> Property
=== ByteString -> ShortByteString
SBS.toShort (Addr -> ByteString
serialiseAddr Addr
addr)

propDecompactErrors :: Addr -> Gen Property
propDecompactErrors :: Addr -> Gen Property
propDecompactErrors Addr
addr = do
  let sbs :: ShortByteString
sbs = CompactAddr -> ShortByteString
unCompactAddr forall a b. (a -> b) -> a -> b
$ Addr -> CompactAddr
compactAddr Addr
addr
      hashLen :: Int
hashLen = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
Hash.sizeHash (forall {k} (t :: k). Proxy t
Proxy :: Proxy ADDRHASH)
      bs :: ByteString
bs = ShortByteString -> ByteString
SBS.fromShort ShortByteString
sbs
      flipHeaderBit :: Int -> ByteString
flipHeaderBit Int
b =
        case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs of
          Just (Word8
h, ByteString
bsTail) -> Word8 -> ByteString -> ByteString
BS.cons (forall a. Bits a => a -> Int -> a
complementBit Word8
h Int
b) ByteString
bsTail
          Maybe (Word8, ByteString)
Nothing -> forall a. HasCallStack => [Char] -> a
error [Char]
"Impossible: CompactAddr can't be empty"
      mingleHeader :: Gen ([Char], ByteString)
mingleHeader = do
        Int
b <- forall a. HasCallStack => [a] -> Gen a
elements forall a b. (a -> b) -> a -> b
$ case Addr
addr of
          Addr {} -> [Int
1, Int
2, Int
3, Int
7]
          AddrBootstrap {} -> [Int
0 .. Int
7]
        forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char]
"Header", Int -> ByteString
flipHeaderBit Int
b)
      mingleAddLength :: Gen ([Char], ByteString)
mingleAddLength = do
        NonEmpty [Word8]
xs <- forall a. Arbitrary a => Gen a
arbitrary
        forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char]
"Add Length", ByteString
bs forall a. Semigroup a => a -> a -> a
<> [Word8] -> ByteString
BS.pack [Word8]
xs)
      mingleDropLength :: Gen ([Char], ByteString)
mingleDropLength = do
        Int
n <- (Int, Int) -> Gen Int
chooseInt (Int
1, ByteString -> Int
BS.length ByteString
bs)
        forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char]
"Drop Length", Int -> ByteString -> ByteString
BS.take (ByteString -> Int
BS.length ByteString
bs forall a. Num a => a -> a -> a
- Int
n) ByteString
bs)
      mingleStaking :: Gen ([Char], ByteString)
mingleStaking = do
        let (ByteString
prefix, ByteString
suffix) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt (Int
1 forall a. Num a => a -> a -> a
+ Int
hashLen) ByteString
bs
            genBad32 :: Gen Put
genBad32 =
              Word64 -> Put
putVariableLengthWord64
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Random a => (a, a) -> Gen a
choose (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Word32) forall a. Num a => a -> a -> a
+ Word64
1, forall a. Bounded a => a
maxBound :: Word64)
            genBad16 :: Gen Put
genBad16 =
              Word64 -> Put
putVariableLengthWord64
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Random a => (a, a) -> Gen a
choose (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Word16) forall a. Num a => a -> a -> a
+ Word64
1, forall a. Bounded a => a
maxBound :: Word64)
            genGood32 :: Gen Put
genGood32 =
              Word64 -> Put
putVariableLengthWord64 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word32 -> Word64) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
            genGood16 :: Gen Put
genGood16 =
              Word64 -> Put
putVariableLengthWord64 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word16 -> Word64) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
            serializeSuffix :: [f Put] -> f ByteString
serializeSuffix [f Put]
xs = ByteString -> ByteString
BSL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
B.runPut forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [f Put]
xs
        case Addr
addr of
          Addr Network
_ PaymentCredential
_ StakeRefPtr {} -> do
            ByteString
newSuffix <-
              forall a. HasCallStack => [Gen a] -> Gen a
oneof
                [ forall {f :: * -> *}. Monad f => [f Put] -> f ByteString
serializeSuffix [Gen Put
genBad32, Gen Put
genGood16, Gen Put
genGood16]
                , forall {f :: * -> *}. Monad f => [f Put] -> f ByteString
serializeSuffix [Gen Put
genGood32, Gen Put
genBad16, Gen Put
genGood16]
                , forall {f :: * -> *}. Monad f => [f Put] -> f ByteString
serializeSuffix [Gen Put
genGood32, Gen Put
genGood16, Gen Put
genBad16]
                , forall {f :: * -> *}. Monad f => [f Put] -> f ByteString
serializeSuffix [Gen Put
genGood32, Gen Put
genGood16, Gen Put
genGood16, Gen Put
genGood16]
                , -- We need to reset the first bit, to indicate that no more bytes do
                  -- follow. Besides the fact that the original suffix is retained, this
                  -- is similar to:
                  --
                  -- serializeSuffix [genGood8, genGood32, genGood16, genGood16]
                  (\Word8
x -> Word8 -> ByteString
BS.singleton (Word8
x forall a. Bits a => a -> a -> a
.&. Word8
0b01111111) forall a. Semigroup a => a -> a -> a
<> ByteString
suffix) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
                ]
            forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char]
"Mingle Ptr", ByteString
prefix forall a. Semigroup a => a -> a -> a
<> ByteString
newSuffix)
          Addr Network
_ PaymentCredential
_ StakeRefNull {} -> do
            NonEmpty [Word8]
xs <- forall a. Arbitrary a => Gen a
arbitrary
            forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char]
"Bogus Null Ptr", ByteString
prefix forall a. Semigroup a => a -> a -> a
<> [Word8] -> ByteString
BS.pack [Word8]
xs)
          Addr Network
_ PaymentCredential
_ StakeRefBase {} -> do
            [Word8]
xs <- forall a. Arbitrary a => Gen a
arbitrary
            let xs' :: [Word8]
xs' = if forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
xs forall a. Eq a => a -> a -> Bool
== Int
hashLen then Word8
0 forall a. a -> [a] -> [a]
: [Word8]
xs else [Word8]
xs
            forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char]
"Bogus Staking", ByteString
prefix forall a. Semigroup a => a -> a -> a
<> [Word8] -> ByteString
BS.pack [Word8]
xs')
          AddrBootstrap {} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char]
"Bogus Bootstrap", Word8 -> ByteString
BS.singleton Word8
0b10000000 forall a. Semigroup a => a -> a -> a
<> ByteString
bs)
  ([Char]
mingler, ByteString
badAddr) <-
    forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ Gen ([Char], ByteString)
mingleHeader
      , Gen ([Char], ByteString)
mingleAddLength
      , Gen ([Char], ByteString)
mingleDropLength
      , Gen ([Char], ByteString)
mingleStaking
      ]
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    forall a b. (a -> b) -> a -> b
$ forall prop. Testable prop => [Char] -> prop -> Property
counterexample
      ([Char]
"Mingled address with " forall a. [a] -> [a] -> [a]
++ [Char]
mingler forall a. [a] -> [a] -> [a]
++ [Char]
" was parsed: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ByteString
badAddr)
    forall a b. (a -> b) -> a -> b
$ forall a b. Either a b -> Bool
isLeft
    forall a b. (a -> b) -> a -> b
$ ByteString -> Either [Char] Addr
decodeAddrEither ByteString
badAddr

propDeserializeRewardAccountErrors :: Version -> RewardAccount -> Gen Property
propDeserializeRewardAccountErrors :: Version -> RewardAccount -> Gen Property
propDeserializeRewardAccountErrors Version
v RewardAccount
acnt = do
  let bs :: ByteString
bs = forall a. EncCBOR a => Version -> a -> ByteString
serialize' Version
v RewardAccount
acnt
      flipHeaderBit :: Int -> ByteString
flipHeaderBit Int
b =
        case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs of
          Just (Word8
h, ByteString
bsTail) -> Word8 -> ByteString -> ByteString
BS.cons (forall a. Bits a => a -> Int -> a
complementBit Word8
h Int
b) ByteString
bsTail
          Maybe (Word8, ByteString)
Nothing -> forall a. HasCallStack => [Char] -> a
error [Char]
"Impossible: CompactAddr can't be empty"
      mingleHeader :: Gen ([Char], ByteString)
mingleHeader = do
        Int
b <- forall a. HasCallStack => [a] -> Gen a
elements [Int
1, Int
2, Int
3, Int
5, Int
6, Int
7]
        forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char]
"Header", Int -> ByteString
flipHeaderBit Int
b)
      mingleAddLength :: Gen ([Char], ByteString)
mingleAddLength = do
        NonEmpty [Word8]
xs <- forall a. Arbitrary a => Gen a
arbitrary
        forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char]
"Add Length", ByteString
bs forall a. Semigroup a => a -> a -> a
<> [Word8] -> ByteString
BS.pack [Word8]
xs)
      mingleDropLength :: Gen ([Char], ByteString)
mingleDropLength = do
        Int
n <- (Int, Int) -> Gen Int
chooseInt (Int
1, ByteString -> Int
BS.length ByteString
bs)
        forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char]
"Drop Length", Int -> ByteString -> ByteString
BS.take (ByteString -> Int
BS.length ByteString
bs forall a. Num a => a -> a -> a
- Int
n) ByteString
bs)
  ([Char]
mingler, ByteString
badAddr) <-
    forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ Gen ([Char], ByteString)
mingleHeader
      , Gen ([Char], ByteString)
mingleAddLength
      , Gen ([Char], ByteString)
mingleDropLength
      ]
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    forall a b. (a -> b) -> a -> b
$ forall prop. Testable prop => [Char] -> prop -> Property
counterexample
      ([Char]
"Mingled address with " forall a. [a] -> [a] -> [a]
++ [Char]
mingler forall a. [a] -> [a] -> [a]
++ [Char]
" was parsed: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ByteString
badAddr)
    forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> Bool
isNothing
    forall a b. (a -> b) -> a -> b
$ forall b (m :: * -> *).
(AddressBuffer b, MonadFail m) =>
b -> m RewardAccount
decodeRewardAccount ByteString
badAddr

addressWithExtraneousBytes :: HasCallStack => BS.ByteString
addressWithExtraneousBytes :: HasCallStack => ByteString
addressWithExtraneousBytes = ByteString
bs
  where
    bs :: ByteString
bs = case ByteString -> Either [Char] ByteString
B16.decode ByteString
hs of
      Left [Char]
e -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show [Char]
e
      Right ByteString
x -> ByteString
x
    hs :: ByteString
hs =
      ByteString
"01AA5C8B35A934ED83436ABB56CDB44878DAC627529D2DA0B59CDA794405931B9359\
      \46E9391CABDFFDED07EB727F94E9E0F23739FF85978905BD460158907C589B9F1A62"