{-# LANGUAGE TemplateHaskell #-}

module Test.Cardano.Chain.Delegation.CBOR (
  tests,
)
where

import Cardano.Chain.Delegation (unsafePayload)
import Cardano.Prelude
import Data.List ((!!))
import GetDataFileName ((<:<))
import Hedgehog (Property)
import Test.Cardano.Chain.Delegation.Example (exampleCertificates)
import Test.Cardano.Chain.Delegation.Gen (
  genCertificate,
  genError,
  genPayload,
 )
import Test.Cardano.Crypto.Gen (feedPM)
import Test.Cardano.Ledger.Binary.Vintage.Helpers.GoldenRoundTrip (
  goldenTestCBOR,
  roundTripsCBORBuildable,
  roundTripsCBORShow,
 )
import Test.Cardano.Prelude
import Test.Options (TSGroup, TSProperty, concatTSGroups, eachOfTS)

--------------------------------------------------------------------------------
-- Certificate
--------------------------------------------------------------------------------

goldenCertificate :: Property
goldenCertificate :: Property
goldenCertificate =
  forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR
    Certificate
cert
    (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/cbor/delegation/Certificate"
  where
    cert :: Certificate
cert = [Certificate]
exampleCertificates forall a. [a] -> Int -> a
!! Int
0

ts_roundTripCertificateCBOR :: TSProperty
ts_roundTripCertificateCBOR :: TSProperty
ts_roundTripCertificateCBOR =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
200 (forall a. (ProtocolMagicId -> Gen a) -> Gen a
feedPM ProtocolMagicId -> Gen Certificate
genCertificate) forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- DlgPayload
--------------------------------------------------------------------------------

goldenDlgPayload :: Property
goldenDlgPayload :: Property
goldenDlgPayload = forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR Payload
dp (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/cbor/delegation/DlgPayload"
  where
    dp :: Payload
dp = [Certificate] -> Payload
unsafePayload (forall a. Int -> [a] -> [a]
take Int
4 [Certificate]
exampleCertificates)

ts_roundTripDlgPayloadCBOR :: TSProperty
ts_roundTripDlgPayloadCBOR :: TSProperty
ts_roundTripDlgPayloadCBOR =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 (forall a. (ProtocolMagicId -> Gen a) -> Gen a
feedPM ProtocolMagicId -> Gen Payload
genPayload) forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- Error
--------------------------------------------------------------------------------

ts_roundTripErrorCBOR :: TSProperty
ts_roundTripErrorCBOR :: TSProperty
ts_roundTripErrorCBOR =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen Error
genError forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Show a, HasCallStack) =>
a -> m ()
roundTripsCBORShow

tests :: TSGroup
tests :: TSGroup
tests = [TSGroup] -> TSGroup
concatTSGroups [forall a b. a -> b -> a
const $$FilePath
[(PropertyName, Property)]
Property
FilePath -> PropertyName
FilePath -> GroupName
GroupName -> [(PropertyName, Property)] -> Group
goldenDlgPayload :: Property
goldenCertificate :: Property
discoverGolden, $$discoverRoundTripArg]