{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Test.Cardano.Ledger.Binary.Vintage.Helpers (
byronProtVer,
U,
U24,
extensionProperty,
cborFlatTermValid,
) where
import Cardano.Ledger.Binary (
DecCBOR (..),
EncCBOR (..),
byronProtVer,
decodeListLenOf,
decodeNestedCborBytes,
encodeListLen,
encodeNestedCborBytes,
serialize,
unsafeDeserialize,
)
import Cardano.Ledger.Binary.FlatTerm (toFlatTerm, validFlatTerm)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Data.Word (Word8)
import Test.Cardano.Ledger.Binary.Arbitrary ()
import Test.Hspec ()
import Test.Hspec.QuickCheck ()
import Test.QuickCheck (
Arbitrary (arbitrary),
Gen,
Property,
choose,
forAll,
property,
(===),
)
cborFlatTermValid :: EncCBOR a => a -> Property
cborFlatTermValid :: forall a. EncCBOR a => a -> Property
cborFlatTermValid = Bool -> Property
forall prop. Testable prop => prop -> Property
property (Bool -> Property) -> (a -> Bool) -> a -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlatTerm -> Bool
validFlatTerm (FlatTerm -> Bool) -> (a -> FlatTerm) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Encoding -> FlatTerm
toFlatTerm Version
byronProtVer (Encoding -> FlatTerm) -> (a -> Encoding) -> a -> FlatTerm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR
data U = U Word8 BS.ByteString deriving (Int -> U -> ShowS
[U] -> ShowS
U -> String
(Int -> U -> ShowS) -> (U -> String) -> ([U] -> ShowS) -> Show U
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> U -> ShowS
showsPrec :: Int -> U -> ShowS
$cshow :: U -> String
show :: U -> String
$cshowList :: [U] -> ShowS
showList :: [U] -> ShowS
Show, U -> U -> Bool
(U -> U -> Bool) -> (U -> U -> Bool) -> Eq U
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: U -> U -> Bool
== :: U -> U -> Bool
$c/= :: U -> U -> Bool
/= :: U -> U -> Bool
Eq)
instance EncCBOR U where
encCBOR :: U -> Encoding
encCBOR (U Word8
word8 ByteString
bs) =
Word -> Encoding
encodeListLen Word
2
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
word8 :: Word8)
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
encodeNestedCborBytes
(ByteString -> ByteString
LBS.fromStrict ByteString
bs)
instance DecCBOR U where
decCBOR :: forall s. Decoder s U
decCBOR = do
Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf Int
2
Word8 -> ByteString -> U
U (Word8 -> ByteString -> U)
-> Decoder s Word8 -> Decoder s (ByteString -> U)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word8
forall s. Decoder s Word8
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder s (ByteString -> U) -> Decoder s ByteString -> Decoder s U
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s ByteString
forall s. Decoder s ByteString
decodeNestedCborBytes
instance Arbitrary U where
arbitrary :: Gen U
arbitrary = Word8 -> ByteString -> U
U (Word8 -> ByteString -> U) -> Gen Word8 -> Gen (ByteString -> U)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8, Word8) -> Gen Word8
forall a. Random a => (a, a) -> Gen a
choose (Word8
0, Word8
255) Gen (ByteString -> U) -> Gen ByteString -> Gen U
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ByteString
forall a. Arbitrary a => Gen a
arbitrary
data U24 = U24 Word8 BS.ByteString deriving (Int -> U24 -> ShowS
[U24] -> ShowS
U24 -> String
(Int -> U24 -> ShowS)
-> (U24 -> String) -> ([U24] -> ShowS) -> Show U24
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> U24 -> ShowS
showsPrec :: Int -> U24 -> ShowS
$cshow :: U24 -> String
show :: U24 -> String
$cshowList :: [U24] -> ShowS
showList :: [U24] -> ShowS
Show, U24 -> U24 -> Bool
(U24 -> U24 -> Bool) -> (U24 -> U24 -> Bool) -> Eq U24
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: U24 -> U24 -> Bool
== :: U24 -> U24 -> Bool
$c/= :: U24 -> U24 -> Bool
/= :: U24 -> U24 -> Bool
Eq)
instance DecCBOR U24 where
decCBOR :: forall s. Decoder s U24
decCBOR = do
Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf Int
2
Word8 -> ByteString -> U24
U24 (Word8 -> ByteString -> U24)
-> Decoder s Word8 -> Decoder s (ByteString -> U24)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word8
forall s. Decoder s Word8
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder s (ByteString -> U24)
-> Decoder s ByteString -> Decoder s U24
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s ByteString
forall s. Decoder s ByteString
decodeNestedCborBytes
instance EncCBOR U24 where
encCBOR :: U24 -> Encoding
encCBOR (U24 Word8
word8 ByteString
bs) =
Word -> Encoding
encodeListLen Word
2
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
word8 :: Word8)
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
encodeNestedCborBytes
(ByteString -> ByteString
LBS.fromStrict ByteString
bs)
extensionProperty ::
forall a. (Arbitrary a, Eq a, Show a, DecCBOR a, EncCBOR a) => Property
extensionProperty :: forall a.
(Arbitrary a, Eq a, Show a, DecCBOR a, EncCBOR a) =>
Property
extensionProperty = forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll @a (Gen a
forall a. Arbitrary a => Gen a
arbitrary :: Gen a) ((a -> Property) -> Property) -> (a -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \a
input ->
let serialized :: ByteString
serialized = Version -> a -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize Version
byronProtVer a
input
(U
u :: U) = Version -> ByteString -> U
forall a. DecCBOR a => Version -> ByteString -> a
unsafeDeserialize Version
byronProtVer ByteString
serialized
(a
encoded :: a) = Version -> ByteString -> a
forall a. DecCBOR a => Version -> ByteString -> a
unsafeDeserialize Version
byronProtVer (Version -> U -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize Version
byronProtVer U
u)
in a
encoded a -> a -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== a
input