{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

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

import Cardano.Chain.Ssc (
  SscPayload (..),
  SscProof (..),
  dropCommitment,
  dropCommitmentsMap,
  dropInnerSharesMap,
  dropOpeningsMap,
  dropSharesMap,
  dropSignedCommitment,
  dropSscPayload,
  dropSscProof,
  dropVssCertificate,
  dropVssCertificatesMap,
 )
import Cardano.Ledger.Binary (dropBytes)
import Cardano.Prelude
import Hedgehog (Group (..), Property)
import Test.Cardano.Ledger.Binary.Vintage.Helpers.GoldenRoundTrip (
  deprecatedGoldenDecode,
  roundTripsCBORShow,
 )
import Test.Cardano.Prelude
import Test.Options (concatGroups)

--------------------------------------------------------------------------------
-- Commitment
--------------------------------------------------------------------------------

goldenDeprecatedCommitment :: Property
goldenDeprecatedCommitment :: Property
goldenDeprecatedCommitment =
  HasCallStack =>
Text -> (forall s. Decoder s ()) -> FilePath -> Property
Text -> (forall s. Decoder s ()) -> FilePath -> Property
deprecatedGoldenDecode Text
"Commitment" Dropper s
forall s. Decoder s ()
dropCommitment FilePath
"golden/cbor/ssc/Commitment"

--------------------------------------------------------------------------------
-- CommitmentsMap
--------------------------------------------------------------------------------

goldenDeprecatedCommitmentsMap :: Property
goldenDeprecatedCommitmentsMap :: Property
goldenDeprecatedCommitmentsMap =
  HasCallStack =>
Text -> (forall s. Decoder s ()) -> FilePath -> Property
Text -> (forall s. Decoder s ()) -> FilePath -> Property
deprecatedGoldenDecode Text
"CommitmentsMap" Dropper s
forall s. Decoder s ()
dropCommitmentsMap FilePath
"golden/cbor/ssc/CommitmentsMap"

--------------------------------------------------------------------------------
-- InnerSharesMap
--------------------------------------------------------------------------------

goldenDeprecatedInnerSharesMap :: Property
goldenDeprecatedInnerSharesMap :: Property
goldenDeprecatedInnerSharesMap =
  HasCallStack =>
Text -> (forall s. Decoder s ()) -> FilePath -> Property
Text -> (forall s. Decoder s ()) -> FilePath -> Property
deprecatedGoldenDecode Text
"InnerSharesMap" Dropper s
forall s. Decoder s ()
dropInnerSharesMap FilePath
"golden/cbor/ssc/InnerSharesMap"

--------------------------------------------------------------------------------
-- Opening
--------------------------------------------------------------------------------

goldenDeprecatedOpening :: Property
goldenDeprecatedOpening :: Property
goldenDeprecatedOpening = HasCallStack =>
Text -> (forall s. Decoder s ()) -> FilePath -> Property
Text -> (forall s. Decoder s ()) -> FilePath -> Property
deprecatedGoldenDecode Text
"Opening" Dropper s
forall s. Decoder s ()
dropBytes FilePath
"golden/cbor/ssc/Opening"

--------------------------------------------------------------------------------
-- OpeningsMap
--------------------------------------------------------------------------------

goldenDeprecatedOpeningsMap :: Property
goldenDeprecatedOpeningsMap :: Property
goldenDeprecatedOpeningsMap =
  HasCallStack =>
Text -> (forall s. Decoder s ()) -> FilePath -> Property
Text -> (forall s. Decoder s ()) -> FilePath -> Property
deprecatedGoldenDecode Text
"OpeningsMap" Dropper s
forall s. Decoder s ()
dropOpeningsMap FilePath
"golden/cbor/ssc/OpeningsMap"

--------------------------------------------------------------------------------
-- SignedCommitment
--------------------------------------------------------------------------------

goldenDeprecatedSignedCommitment :: Property
goldenDeprecatedSignedCommitment :: Property
goldenDeprecatedSignedCommitment =
  HasCallStack =>
Text -> (forall s. Decoder s ()) -> FilePath -> Property
Text -> (forall s. Decoder s ()) -> FilePath -> Property
deprecatedGoldenDecode Text
"SignedCommitment" Dropper s
forall s. Decoder s ()
dropSignedCommitment FilePath
"golden/cbor/ssc/SignedCommitment"

--------------------------------------------------------------------------------
-- SharesMap
--------------------------------------------------------------------------------

goldenDeprecatedSharesMap :: Property
goldenDeprecatedSharesMap :: Property
goldenDeprecatedSharesMap =
  HasCallStack =>
Text -> (forall s. Decoder s ()) -> FilePath -> Property
Text -> (forall s. Decoder s ()) -> FilePath -> Property
deprecatedGoldenDecode Text
"SharesMap" Dropper s
forall s. Decoder s ()
dropSharesMap FilePath
"golden/cbor/ssc/SharesMap"

--------------------------------------------------------------------------------
-- SscPayload
--------------------------------------------------------------------------------

goldenDeprecatedSscPayload_CommitmentsPayload :: Property
goldenDeprecatedSscPayload_CommitmentsPayload :: Property
goldenDeprecatedSscPayload_CommitmentsPayload =
  HasCallStack =>
Text -> (forall s. Decoder s ()) -> FilePath -> Property
Text -> (forall s. Decoder s ()) -> FilePath -> Property
deprecatedGoldenDecode
    Text
"SscPayload_CommitmentsPayload"
    Dropper s
forall s. Decoder s ()
dropSscPayload
    FilePath
"golden/cbor/ssc/SscPayload_CommitmentsPayload"

goldenDeprecatedSscPayload_OpeningsPayload :: Property
goldenDeprecatedSscPayload_OpeningsPayload :: Property
goldenDeprecatedSscPayload_OpeningsPayload =
  HasCallStack =>
Text -> (forall s. Decoder s ()) -> FilePath -> Property
Text -> (forall s. Decoder s ()) -> FilePath -> Property
deprecatedGoldenDecode
    Text
"SscPayload_OpeningsPayload"
    Dropper s
forall s. Decoder s ()
dropSscPayload
    FilePath
"golden/cbor/ssc/SscPayload_OpeningsPayload"

goldenDeprecatedSscPayload_SharesPayload :: Property
goldenDeprecatedSscPayload_SharesPayload :: Property
goldenDeprecatedSscPayload_SharesPayload =
  HasCallStack =>
Text -> (forall s. Decoder s ()) -> FilePath -> Property
Text -> (forall s. Decoder s ()) -> FilePath -> Property
deprecatedGoldenDecode
    Text
"SscPayload_SharesPayload"
    Dropper s
forall s. Decoder s ()
dropSscPayload
    FilePath
"golden/cbor/ssc/SscPayload_SharesPayload"

goldenDeprecatedSscPayload_CertificatesPayload :: Property
goldenDeprecatedSscPayload_CertificatesPayload :: Property
goldenDeprecatedSscPayload_CertificatesPayload =
  HasCallStack =>
Text -> (forall s. Decoder s ()) -> FilePath -> Property
Text -> (forall s. Decoder s ()) -> FilePath -> Property
deprecatedGoldenDecode
    Text
"SscPayload_CertificatesPayload"
    Dropper s
forall s. Decoder s ()
dropSscPayload
    FilePath
"golden/cbor/ssc/SscPayload_CertificatesPayload"

roundTripSscPayload :: Property
roundTripSscPayload :: Property
roundTripSscPayload = TestLimit
-> Gen SscPayload -> (SscPayload -> PropertyT IO ()) -> Property
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> Property
eachOf TestLimit
1 (SscPayload -> Gen SscPayload
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SscPayload
SscPayload) SscPayload -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Show a, HasCallStack) =>
a -> m ()
roundTripsCBORShow

--------------------------------------------------------------------------------
-- SscProof
--------------------------------------------------------------------------------

goldenDeprecatedSscProof_CommitmentsProof :: Property
goldenDeprecatedSscProof_CommitmentsProof :: Property
goldenDeprecatedSscProof_CommitmentsProof =
  HasCallStack =>
Text -> (forall s. Decoder s ()) -> FilePath -> Property
Text -> (forall s. Decoder s ()) -> FilePath -> Property
deprecatedGoldenDecode
    Text
"SscProof_CommitmentsProof"
    Dropper s
forall s. Decoder s ()
dropSscProof
    FilePath
"golden/cbor/ssc/SscProof_CommitmentsProof"

goldenDeprecatedSscProof_OpeningsProof :: Property
goldenDeprecatedSscProof_OpeningsProof :: Property
goldenDeprecatedSscProof_OpeningsProof =
  HasCallStack =>
Text -> (forall s. Decoder s ()) -> FilePath -> Property
Text -> (forall s. Decoder s ()) -> FilePath -> Property
deprecatedGoldenDecode
    Text
"SscProof_OpeningsProof"
    Dropper s
forall s. Decoder s ()
dropSscProof
    FilePath
"golden/cbor/ssc/SscProof_OpeningsProof"

goldenDeprecatedSscProof_SharesProof :: Property
goldenDeprecatedSscProof_SharesProof :: Property
goldenDeprecatedSscProof_SharesProof =
  HasCallStack =>
Text -> (forall s. Decoder s ()) -> FilePath -> Property
Text -> (forall s. Decoder s ()) -> FilePath -> Property
deprecatedGoldenDecode
    Text
"SscProof_SharesProof"
    Dropper s
forall s. Decoder s ()
dropSscProof
    FilePath
"golden/cbor/ssc/SscProof_SharesProof"

goldenDeprecatedSscProof_CertificatesProof :: Property
goldenDeprecatedSscProof_CertificatesProof :: Property
goldenDeprecatedSscProof_CertificatesProof =
  HasCallStack =>
Text -> (forall s. Decoder s ()) -> FilePath -> Property
Text -> (forall s. Decoder s ()) -> FilePath -> Property
deprecatedGoldenDecode
    Text
"SscProof_CertificatesProof"
    Dropper s
forall s. Decoder s ()
dropSscProof
    FilePath
"golden/cbor/ssc/SscProof_CertificatesProof"

roundTripSscProof :: Property
roundTripSscProof :: Property
roundTripSscProof = TestLimit
-> Gen SscProof -> (SscProof -> PropertyT IO ()) -> Property
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> Property
eachOf TestLimit
1 (SscProof -> Gen SscProof
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SscProof
SscProof) SscProof -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Show a, HasCallStack) =>
a -> m ()
roundTripsCBORShow

--------------------------------------------------------------------------------
-- VssCertificate
--------------------------------------------------------------------------------

goldenDeprecatedVssCertificate :: Property
goldenDeprecatedVssCertificate :: Property
goldenDeprecatedVssCertificate =
  HasCallStack =>
Text -> (forall s. Decoder s ()) -> FilePath -> Property
Text -> (forall s. Decoder s ()) -> FilePath -> Property
deprecatedGoldenDecode
    Text
"VssCertificate"
    Dropper s
forall s. Decoder s ()
dropVssCertificate
    FilePath
"golden/cbor/ssc/VssCertificate"

--------------------------------------------------------------------------------
-- VssCertificatesHash
--------------------------------------------------------------------------------

goldenDeprecatedVssCertificatesHash :: Property
goldenDeprecatedVssCertificatesHash :: Property
goldenDeprecatedVssCertificatesHash =
  HasCallStack =>
Text -> (forall s. Decoder s ()) -> FilePath -> Property
Text -> (forall s. Decoder s ()) -> FilePath -> Property
deprecatedGoldenDecode
    Text
"VssCertiificatesHash"
    Dropper s
forall s. Decoder s ()
dropBytes
    FilePath
"golden/cbor/ssc/VssCertificatesHash"

--------------------------------------------------------------------------------
-- VssCertificatesMap
--------------------------------------------------------------------------------

goldenDeprecatedVssCertificatesMap :: Property
goldenDeprecatedVssCertificatesMap :: Property
goldenDeprecatedVssCertificatesMap =
  HasCallStack =>
Text -> (forall s. Decoder s ()) -> FilePath -> Property
Text -> (forall s. Decoder s ()) -> FilePath -> Property
deprecatedGoldenDecode
    Text
"VssCertificatesMap"
    Dropper s
forall s. Decoder s ()
dropVssCertificatesMap
    FilePath
"golden/cbor/ssc/VssCertificatesMap"

--------------------------------------------------------------------------------
-- Main test export
--------------------------------------------------------------------------------

tests :: Group
tests :: Group
tests = [Group] -> Group
concatGroups [$$FilePath
[(PropertyName, Property)]
Property
FilePath -> GroupName
FilePath -> PropertyName
GroupName -> [(PropertyName, Property)] -> Group
goldenDeprecatedCommitment :: Property
goldenDeprecatedCommitmentsMap :: Property
goldenDeprecatedInnerSharesMap :: Property
goldenDeprecatedOpening :: Property
goldenDeprecatedOpeningsMap :: Property
goldenDeprecatedSignedCommitment :: Property
goldenDeprecatedSharesMap :: Property
goldenDeprecatedSscPayload_CommitmentsPayload :: Property
goldenDeprecatedSscPayload_OpeningsPayload :: Property
goldenDeprecatedSscPayload_SharesPayload :: Property
goldenDeprecatedSscPayload_CertificatesPayload :: Property
goldenDeprecatedSscProof_CommitmentsProof :: Property
goldenDeprecatedSscProof_OpeningsProof :: Property
goldenDeprecatedSscProof_SharesProof :: Property
goldenDeprecatedSscProof_CertificatesProof :: Property
goldenDeprecatedVssCertificate :: Property
goldenDeprecatedVssCertificatesHash :: Property
goldenDeprecatedVssCertificatesMap :: Property
discoverGolden, $$FilePath
[(PropertyName, Property)]
Property
FilePath -> GroupName
FilePath -> PropertyName
GroupName -> [(PropertyName, Property)] -> Group
roundTripSscPayload :: Property
roundTripSscProof :: Property
discoverRoundTrip]