{-# LANGUAGE TemplateHaskell #-}

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

import Cardano.Chain.Delegation (unsafePayload)
import Cardano.Prelude
import Data.List ((!!))
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 = Certificate -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR Certificate
cert FilePath
"golden/cbor/delegation/Certificate"
  where
    cert :: Certificate
cert = [Certificate]
exampleCertificates [Certificate] -> Int -> Certificate
forall a. HasCallStack => [a] -> Int -> a
!! Int
0

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

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

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

ts_roundTripDlgPayloadCBOR :: TSProperty
ts_roundTripDlgPayloadCBOR :: TSProperty
ts_roundTripDlgPayloadCBOR =
  TestLimit
-> Gen Payload -> (Payload -> PropertyT IO ()) -> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 ((ProtocolMagicId -> Gen Payload) -> Gen Payload
forall a. (ProtocolMagicId -> Gen a) -> Gen a
feedPM ProtocolMagicId -> Gen Payload
genPayload) Payload -> PropertyT IO ()
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 =
  TestLimit -> Gen Error -> (Error -> PropertyT IO ()) -> TSProperty
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
100 Gen Error
genError Error -> PropertyT IO ()
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 [Group -> TSGroup
forall a b. a -> b -> a
const $$FilePath
[(PropertyName, Property)]
Property
FilePath -> GroupName
FilePath -> PropertyName
GroupName -> [(PropertyName, Property)] -> Group
goldenCertificate :: Property
goldenDlgPayload :: Property
discoverGolden, $$discoverRoundTripArg]