{-# LANGUAGE DataKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.Binary.Success (spec) where

import Cardano.Ledger.Binary
import Control.Monad (forM_)
import Data.Proxy (Proxy (Proxy))
import qualified Data.Set as Set
import Test.Cardano.Ledger.Binary.RoundTrip (Trip (..), embedTripExpectation)
import Test.Hspec
import Test.Hspec.QuickCheck
import Test.QuickCheck

-- | Generate a list with unique elements
genIntSet :: Gen (Set.Set Int)
genIntSet :: Gen (Set Int)
genIntSet = forall a. Ord a => [a] -> Set a
Set.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Gen a -> Gen [a]
listOf forall a. Random a => Gen a
chooseAny

-- | Generate a CBOR encoded list with no duplicates, with and with the set tag
genUniqueListEncoding :: Gen (Set.Set Int, Encoding)
genUniqueListEncoding :: Gen (Set Int, Encoding)
genUniqueListEncoding = do
  Set Int
xsSet <- Gen (Set Int)
genIntSet
  let xs :: [Int]
xs = forall a. Set a -> [a]
Set.toList Set Int
xsSet
      definite :: Encoding
definite = Word -> Encoding
encodeListLen (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [Int]
xs) forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a. EncCBOR a => a -> Encoding
encCBOR [Int]
xs
      indefinite :: Encoding
indefinite = Encoding
encodeListLenIndef forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a. EncCBOR a => a -> Encoding
encCBOR [Int]
xs forall a. Semigroup a => a -> a -> a
<> Encoding
encodeBreak
  (,) Set Int
xsSet
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasCallStack => [a] -> Gen a
elements
      [ Encoding
definite
      , Word -> Encoding
encodeTag Word
258 forall a. Semigroup a => a -> a -> a
<> Encoding
definite
      , Encoding
indefinite
      , Word -> Encoding
encodeTag Word
258 forall a. Semigroup a => a -> a -> a
<> Encoding
indefinite
      ]

-- | Starting in version 9, check set decoding with and without tag 258
prop_setWithNoDuplicatesAndTag :: Property
prop_setWithNoDuplicatesAndTag :: Property
prop_setWithNoDuplicatesAndTag =
  forall prop a. Testable prop => Gen a -> (a -> prop) -> Property
forAllBlind Gen (Set Int, Encoding)
genUniqueListEncoding forall a b. (a -> b) -> a -> b
$
    \(Set Int
s, Encoding
setEncoder) ->
      let trip :: Trip Encoding (Set Int)
trip = forall a b.
(a -> Encoding)
-> (forall s. Decoder s b) -> (forall s. Decoder s ()) -> Trip a b
Trip forall a. a -> a
id (forall a s. DecCBOR a => Decoder s a
decCBOR @(Set.Set Int)) (forall a s. DecCBOR a => Proxy a -> Decoder s ()
dropCBOR (forall {k} (t :: k). Proxy t
Proxy @(Set.Set Int)))
       in forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$
            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 @9) .. forall a. Bounded a => a
maxBound] forall a b. (a -> b) -> a -> b
$
              \Version
v -> forall a b.
(Typeable b, Eq b, HasCallStack) =>
Version -> Version -> Trip a b -> (b -> a -> IO ()) -> a -> IO ()
embedTripExpectation Version
v Version
v Trip Encoding (Set Int)
trip (\Set Int
s' Encoding
_ -> (Set Int
s' forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Set Int
s)) Encoding
setEncoder

spec :: Spec
spec :: Spec
spec = do
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Successes" forall a b. (a -> b) -> a -> b
$ do
    forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"encode Set, v9" Property
prop_setWithNoDuplicatesAndTag