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

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

import Cardano.Chain.Common (rationalToLovelacePortion)
import Cardano.Chain.Update (ApplicationName (..), SoftforkRule (..))
import Cardano.Crypto (Hash, abstractHash)
import Cardano.Crypto.Raw (Raw (..))
import Cardano.Prelude
import GetDataFileName ((<:<))
import Hedgehog (Property)
import Test.Cardano.Chain.Update.Example (
  exampleInstallerHash,
  examplePayload,
  exampleProof,
  exampleProposal,
  exampleProposalBody,
  exampleProtocolParameters,
  exampleProtocolParametersUpdate,
  exampleProtocolVersion,
  exampleSoftwareVersion,
  exampleSystemTag,
  exampleUpId,
  exampleVote,
 )
import Test.Cardano.Chain.Update.Gen (
  genApplicationName,
  genInstallerHash,
  genPayload,
  genProof,
  genProposal,
  genProposalBody,
  genProtocolParameters,
  genProtocolParametersUpdate,
  genProtocolVersion,
  genSoftforkRule,
  genSoftwareVersion,
  genSystemTag,
  genUpId,
  genUpsData,
  genVote,
 )
import Test.Cardano.Crypto.Gen (feedPM, genHashRaw)
import Test.Cardano.Ledger.Binary.Vintage.Helpers.GoldenRoundTrip (
  goldenTestCBOR,
  roundTripsCBORBuildable,
  roundTripsCBORShow,
 )
import Test.Cardano.Prelude
import Test.Options (TSGroup, TSProperty, concatTSGroups, eachOfTS)

--------------------------------------------------------------------------------
-- ApplicationName
--------------------------------------------------------------------------------

goldenApplicationName :: Property
goldenApplicationName :: Property
goldenApplicationName =
  forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR
    ApplicationName
aN
    (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/cbor/update/ApplicationName"
  where
    aN :: ApplicationName
aN = Text -> ApplicationName
ApplicationName Text
"Golden"

ts_roundTripApplicationName :: TSProperty
ts_roundTripApplicationName :: TSProperty
ts_roundTripApplicationName =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
50 Gen ApplicationName
genApplicationName forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- ProtocolVersion
--------------------------------------------------------------------------------

goldenProtocolVersion :: Property
goldenProtocolVersion :: Property
goldenProtocolVersion =
  forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR
    ProtocolVersion
exampleProtocolVersion
    (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/cbor/update/ProtocolVersion"

ts_roundTripProtocolVersion :: TSProperty
ts_roundTripProtocolVersion :: TSProperty
ts_roundTripProtocolVersion =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
50 Gen ProtocolVersion
genProtocolVersion forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- ProtocolParameters
--------------------------------------------------------------------------------

goldenProtocolParameters :: Property
goldenProtocolParameters :: Property
goldenProtocolParameters =
  forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR
    ProtocolParameters
bVerDat
    (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/cbor/update/ProtocolParameters"
  where
    bVerDat :: ProtocolParameters
bVerDat = ProtocolParameters
exampleProtocolParameters

ts_roundTripProtocolParameters :: TSProperty
ts_roundTripProtocolParameters :: TSProperty
ts_roundTripProtocolParameters =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
50 Gen ProtocolParameters
genProtocolParameters forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- ProtocolParametersUpdate
--------------------------------------------------------------------------------

goldenProtocolParametersUpdate :: Property
goldenProtocolParametersUpdate :: Property
goldenProtocolParametersUpdate =
  forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR
    ProtocolParametersUpdate
ppu
    (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/cbor/update/ProtocolParametersUpdate"
  where
    ppu :: ProtocolParametersUpdate
ppu = ProtocolParametersUpdate
exampleProtocolParametersUpdate

ts_roundTripProtocolParametersUpdate :: TSProperty
ts_roundTripProtocolParametersUpdate :: TSProperty
ts_roundTripProtocolParametersUpdate =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
50 Gen ProtocolParametersUpdate
genProtocolParametersUpdate forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- HashRaw
--------------------------------------------------------------------------------

goldenBlockHashRaw :: Property
goldenBlockHashRaw :: Property
goldenBlockHashRaw = forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR Hash Raw
hRaw (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/cbor/update/HashRaw"
  where
    hRaw :: Hash Raw
hRaw = (forall algo a.
(HashAlgorithm algo, EncCBOR a) =>
a -> AbstractHash algo a
abstractHash forall a b. (a -> b) -> a -> b
$ ByteString -> Raw
Raw (ByteString
"9") :: Hash Raw)

ts_roundTripHashRaw :: TSProperty
ts_roundTripHashRaw :: TSProperty
ts_roundTripHashRaw = forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
50 Gen (Hash Raw)
genHashRaw forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- SoftforkRule
--------------------------------------------------------------------------------

goldenSoftforkRule :: Property
goldenSoftforkRule :: Property
goldenSoftforkRule = forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR SoftforkRule
sfR (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/cbor/update/SoftforkRule"
  where
    sfR :: SoftforkRule
sfR =
      LovelacePortion
-> LovelacePortion -> LovelacePortion -> SoftforkRule
SoftforkRule
        (Rational -> LovelacePortion
rationalToLovelacePortion Rational
99e-15)
        (Rational -> LovelacePortion
rationalToLovelacePortion Rational
99e-15)
        (Rational -> LovelacePortion
rationalToLovelacePortion Rational
99e-15)

ts_roundTripSoftforkRule :: TSProperty
ts_roundTripSoftforkRule :: TSProperty
ts_roundTripSoftforkRule = forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
10 Gen SoftforkRule
genSoftforkRule forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- SoftwareVersion
--------------------------------------------------------------------------------

goldenSoftwareVersion :: Property
goldenSoftwareVersion :: Property
goldenSoftwareVersion =
  forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR
    SoftwareVersion
exampleSoftwareVersion
    (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/cbor/update/SoftwareVersion"

ts_roundTripSoftwareVersion :: TSProperty
ts_roundTripSoftwareVersion :: TSProperty
ts_roundTripSoftwareVersion =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
10 Gen SoftwareVersion
genSoftwareVersion forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- SystemTag
--------------------------------------------------------------------------------

goldenSystemTag :: Property
goldenSystemTag :: Property
goldenSystemTag =
  forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR SystemTag
exampleSystemTag (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/cbor/update/SystemTag"

ts_roundTripSystemTag :: TSProperty
ts_roundTripSystemTag :: TSProperty
ts_roundTripSystemTag = forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
10 Gen SystemTag
genSystemTag forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- InstallerHash
--------------------------------------------------------------------------------

goldenInstallerHash :: Property
goldenInstallerHash :: Property
goldenInstallerHash =
  forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR InstallerHash
exampleInstallerHash (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/cbor/update/InstallerHash"

ts_roundTripInstallerHash :: TSProperty
ts_roundTripInstallerHash :: TSProperty
ts_roundTripInstallerHash = forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
20 Gen InstallerHash
genInstallerHash forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- UpdatePayload
--------------------------------------------------------------------------------

goldenUpdatePayload :: Property
goldenUpdatePayload :: Property
goldenUpdatePayload =
  forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR Payload
examplePayload (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/cbor/update/Payload"

ts_roundTripUpdatePayload :: TSProperty
ts_roundTripUpdatePayload :: TSProperty
ts_roundTripUpdatePayload =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
20 (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

--------------------------------------------------------------------------------
-- UpdateProof
--------------------------------------------------------------------------------

goldenUpdateProof :: Property
goldenUpdateProof :: Property
goldenUpdateProof = forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR Proof
exampleProof (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/cbor/update/Proof"

ts_roundTripUpdateProof :: TSProperty
ts_roundTripUpdateProof :: TSProperty
ts_roundTripUpdateProof = forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
20 (forall a. (ProtocolMagicId -> Gen a) -> Gen a
feedPM ProtocolMagicId -> Gen Proof
genProof) forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- UpdateProposal
--------------------------------------------------------------------------------

goldenUpdateProposal :: Property
goldenUpdateProposal :: Property
goldenUpdateProposal =
  forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR Proposal
exampleProposal (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/cbor/update/Proposal"

ts_roundTripUpdateProposal :: TSProperty
ts_roundTripUpdateProposal :: TSProperty
ts_roundTripUpdateProposal =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
20 (forall a. (ProtocolMagicId -> Gen a) -> Gen a
feedPM ProtocolMagicId -> Gen Proposal
genProposal) forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- ProposalBody
--------------------------------------------------------------------------------

goldenProposalBody :: Property
goldenProposalBody :: Property
goldenProposalBody =
  forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR ProposalBody
exampleProposalBody (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/cbor/update/ProposalBody"

ts_roundTripProposalBody :: TSProperty
ts_roundTripProposalBody :: TSProperty
ts_roundTripProposalBody = forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
20 Gen ProposalBody
genProposalBody forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Show a, HasCallStack) =>
a -> m ()
roundTripsCBORShow

--------------------------------------------------------------------------------
-- UpdateVote
--------------------------------------------------------------------------------

goldenUpdateVote :: Property
goldenUpdateVote :: Property
goldenUpdateVote = forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR Vote
exampleVote (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/cbor/update/Vote"

ts_roundTripUpdateVote :: TSProperty
ts_roundTripUpdateVote :: TSProperty
ts_roundTripUpdateVote = forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
20 (forall a. (ProtocolMagicId -> Gen a) -> Gen a
feedPM ProtocolMagicId -> Gen Vote
genVote) forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- UpId
--------------------------------------------------------------------------------

goldenUpId :: Property
goldenUpId :: Property
goldenUpId = forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR UpId
exampleUpId (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/cbor/update/UpId"

ts_roundTripUpId :: TSProperty
ts_roundTripUpId :: TSProperty
ts_roundTripUpId = forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
20 (forall a. (ProtocolMagicId -> Gen a) -> Gen a
feedPM ProtocolMagicId -> Gen UpId
genUpId) forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- UpsData NB: UpsData is not a type it is a record accessor of `ProposalBody`
--------------------------------------------------------------------------------

ts_roundTripUpsData :: TSProperty
ts_roundTripUpsData :: TSProperty
ts_roundTripUpsData = forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
20 Gen (Map SystemTag InstallerHash)
genUpsData forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Show a, HasCallStack) =>
a -> m ()
roundTripsCBORShow

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

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
goldenUpId :: Property
goldenUpdateVote :: Property
goldenProposalBody :: Property
goldenUpdateProposal :: Property
goldenUpdateProof :: Property
goldenUpdatePayload :: Property
goldenInstallerHash :: Property
goldenSystemTag :: Property
goldenSoftwareVersion :: Property
goldenSoftforkRule :: Property
goldenBlockHashRaw :: Property
goldenProtocolParametersUpdate :: Property
goldenProtocolParameters :: Property
goldenProtocolVersion :: Property
goldenApplicationName :: Property
discoverGolden, $$discoverRoundTripArg]