{-# 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 = [Int] -> Set Int
forall a. Ord a => [a] -> Set a
Set.fromList ([Int] -> Set Int) -> Gen [Int] -> Gen (Set Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int -> Gen [Int]
forall a. Gen a -> Gen [a]
listOf Gen Int
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 = Set Int -> [Int]
forall a. Set a -> [a]
Set.toList Set Int
xsSet
      definite :: Encoding
definite = Word -> Encoding
encodeListLen (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [Int]
xs) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (Int -> Encoding) -> [Int] -> Encoding
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Int -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR [Int]
xs
      indefinite :: Encoding
indefinite = Encoding
encodeListLenIndef Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (Int -> Encoding) -> [Int] -> Encoding
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Int -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR [Int]
xs Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
encodeBreak
  (,) Set Int
xsSet
    (Encoding -> (Set Int, Encoding))
-> Gen Encoding -> Gen (Set Int, Encoding)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Encoding] -> Gen Encoding
forall a. HasCallStack => [a] -> Gen a
elements
      [ Encoding
definite
      , Word -> Encoding
encodeTag Word
258 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
definite
      , Encoding
indefinite
      , Word -> Encoding
encodeTag Word
258 Encoding -> Encoding -> Encoding
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 =
  Gen (Set Int, Encoding)
-> ((Set Int, Encoding) -> Property) -> Property
forall prop a. Testable prop => Gen a -> (a -> prop) -> Property
forAllBlind Gen (Set Int, Encoding)
genUniqueListEncoding (((Set Int, Encoding) -> Property) -> Property)
-> ((Set Int, Encoding) -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
    \(Set Int
s, Encoding
setEncoder) ->
      let trip :: Trip Encoding (Set Int)
trip = (Encoding -> Encoding)
-> (forall s. Decoder s (Set Int))
-> (forall s. Decoder s ())
-> Trip Encoding (Set Int)
forall a b.
(a -> Encoding)
-> (forall s. Decoder s b) -> (forall s. Decoder s ()) -> Trip a b
Trip Encoding -> Encoding
forall a. a -> a
id (forall a s. DecCBOR a => Decoder s a
decCBOR @(Set.Set Int)) (Proxy (Set Int) -> Decoder s ()
forall s. Proxy (Set Int) -> Decoder s ()
forall a s. DecCBOR a => Proxy a -> Decoder s ()
dropCBOR (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Set.Set Int)))
       in IO () -> Property
forall prop. Testable prop => prop -> Property
property (IO () -> Property) -> IO () -> Property
forall a b. (a -> b) -> a -> b
$
            [Version] -> (Version -> IO ()) -> IO ()
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) .. Version
forall a. Bounded a => a
maxBound] ((Version -> IO ()) -> IO ()) -> (Version -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
              \Version
v -> Version
-> Version
-> Trip Encoding (Set Int)
-> (Set Int -> Encoding -> IO ())
-> Encoding
-> IO ()
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' Set Int -> Set Int -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Set Int
s)) Encoding
setEncoder

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