{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Test.Cardano.Ledger.Conway.Genesis (expectedConwayGenesis) where

import Cardano.Ledger.BaseTypes (EpochInterval (..), textToUrl)
import Cardano.Ledger.CertState (DRep (..), DRepState (..))
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Conway
import Cardano.Ledger.Conway.Genesis (ConwayGenesis (..))
import Cardano.Ledger.Conway.Governance (Anchor (..), Committee (..))
import Cardano.Ledger.Conway.PParams
import Cardano.Ledger.Conway.TxCert (Delegatee (..))
import Cardano.Ledger.Core
import Cardano.Ledger.Credential
import Cardano.Ledger.Slot (EpochNo (..))
import Data.Default (Default (def))
import qualified Data.ListMap as ListMap
import Data.Map as Map
import Data.Maybe (fromJust)
import Data.Maybe.Strict (StrictMaybe (..))
import Data.Ratio ((%))
import Test.Cardano.Ledger.Conway.Arbitrary ()
import Test.Cardano.Ledger.Core.Utils (unsafeBoundRational)
import Test.Cardano.Ledger.Plutus (zeroTestingCostModelV3)

credMember :: Credential 'ColdCommitteeRole
credMember :: Credential 'ColdCommitteeRole
credMember = forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (forall (r :: KeyRole).
Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
KeyHash Hash ADDRHASH (VerKeyDSIGN DSIGN)
"4e88cc2d27c364aaf90648a87dfb95f8ee103ba67fa1f12f5e86c42a")

scriptMember :: Credential 'ColdCommitteeRole
scriptMember :: Credential 'ColdCommitteeRole
scriptMember = forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj (Hash ADDRHASH EraIndependentScript -> ScriptHash
ScriptHash Hash ADDRHASH EraIndependentScript
"4e88cc2d27c364aaf90648a87dfb95f8ee103ba67fa1f12f5e86c42a")

comm :: Committee ConwayEra
comm :: Committee ConwayEra
comm =
  forall era.
Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval -> Committee era
Committee
    ( forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [
          ( Credential 'ColdCommitteeRole
credMember
          , Word64 -> EpochNo
EpochNo Word64
1
          )
        ,
          ( Credential 'ColdCommitteeRole
scriptMember
          , Word64 -> EpochNo
EpochNo Word64
2
          )
        ]
    )
    (forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational (Integer
1 forall a. Integral a => a -> a -> Ratio a
% Integer
2))

expectedConwayGenesis :: ConwayGenesis
expectedConwayGenesis :: ConwayGenesis
expectedConwayGenesis =
  ConwayGenesis
    { cgCommittee :: Committee ConwayEra
cgCommittee = Committee ConwayEra
comm
    , cgInitialDReps :: ListMap (Credential 'DRepRole) DRepState
cgInitialDReps =
        forall k v. [(k, v)] -> ListMap k v
ListMap.fromList
          [
            ( forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj
                (forall (r :: KeyRole).
Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
KeyHash Hash ADDRHASH (VerKeyDSIGN DSIGN)
"78301005df84ba67fa1f12f95f8ee10335bc5e86c42afbc593ab4cdd")
            , DRepState
                { drepExpiry :: EpochNo
drepExpiry = Word64 -> EpochNo
EpochNo Word64
1000
                , drepAnchor :: StrictMaybe Anchor
drepAnchor = forall a. StrictMaybe a
SNothing
                , drepDeposit :: Coin
drepDeposit = Integer -> Coin
Coin Integer
5000
                , drepDelegs :: Set (Credential 'Staking)
drepDelegs = forall a. Monoid a => a
mempty
                }
            )
          ,
            ( forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj
                (Hash ADDRHASH EraIndependentScript -> ScriptHash
ScriptHash Hash ADDRHASH EraIndependentScript
"01305df84b078ac5e86c42afbc593ab4cdd67fa1f12f95f8ee10335b")
            , DRepState
                { drepExpiry :: EpochNo
drepExpiry = Word64 -> EpochNo
EpochNo Word64
300
                , drepAnchor :: StrictMaybe Anchor
drepAnchor =
                    forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$
                      Anchor
                        { anchorUrl :: Url
anchorUrl = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadFail m => Int -> Text -> m Url
textToUrl Int
99 Text
"example.com"
                        , anchorDataHash :: SafeHash AnchorData
anchorDataHash = forall a. Default a => a
def
                        }
                , drepDeposit :: Coin
drepDeposit = Integer -> Coin
Coin Integer
6000
                , drepDelegs :: Set (Credential 'Staking)
drepDelegs = forall a. Monoid a => a
mempty
                }
            )
          ]
    , cgDelegs :: ListMap (Credential 'Staking) Delegatee
cgDelegs =
        forall k v. [(k, v)] -> ListMap k v
ListMap.fromList
          [
            ( forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj
                (forall (r :: KeyRole).
Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
KeyHash Hash ADDRHASH (VerKeyDSIGN DSIGN)
"35bc5e86c42afbc593ab4cdd78301005df84ba67fa1f12f95f8ee103")
            , DRep -> Delegatee
DelegVote DRep
DRepAlwaysNoConfidence
            )
          ,
            ( forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj
                (forall (r :: KeyRole).
Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
KeyHash Hash ADDRHASH (VerKeyDSIGN DSIGN)
"4e88cc2d27c364aaf90648a87dfb95f8ee103ba67fa1f12f5e86c42a")
            , DRep -> Delegatee
DelegVote DRep
DRepAlwaysAbstain
            )
          ,
            ( forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj
                (forall (r :: KeyRole).
Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
KeyHash Hash ADDRHASH (VerKeyDSIGN DSIGN)
"5df84bcdd7a5f8ee93aafbc500b435bc5e83067fa1f12f9110386c42")
            , KeyHash 'StakePool -> Delegatee
DelegStake forall a b. (a -> b) -> a -> b
$ forall (r :: KeyRole).
Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
KeyHash Hash ADDRHASH (VerKeyDSIGN DSIGN)
"0335bc5e86c42afbc578301005df84ba67fa1f12f95f8ee193ab4cdd"
            )
          ,
            ( forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj
                (forall (r :: KeyRole).
Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
KeyHash Hash ADDRHASH (VerKeyDSIGN DSIGN)
"8ee93a5df84bc42cdd7a5fafbc500b435bc5e83067fa1f12f9110386")
            , KeyHash 'StakePool -> DRep -> Delegatee
DelegStakeVote
                (forall (r :: KeyRole).
Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
KeyHash Hash ADDRHASH (VerKeyDSIGN DSIGN)
"086c42afbc578301005df84ba67fa1f12f95f8ee193ab4cdd335bc5e")
                DRep
DRepAlwaysAbstain
            )
          ,
            ( forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj
                (forall (r :: KeyRole).
Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
KeyHash Hash ADDRHASH (VerKeyDSIGN DSIGN)
"df93ab435bc5eafbc500583067fa1f12f9110386c42cdd784ba5f8ee")
            , DRep -> Delegatee
DelegVote forall a b. (a -> b) -> a -> b
$
                Credential 'DRepRole -> DRep
DRepCredential
                  (forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj (Hash ADDRHASH EraIndependentScript -> ScriptHash
ScriptHash Hash ADDRHASH EraIndependentScript
"01305df84b078ac5e86c42afbc593ab4cdd67fa1f12f95f8ee10335b"))
            )
          ,
            ( forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj
                (Hash ADDRHASH EraIndependentScript -> ScriptHash
ScriptHash Hash ADDRHASH EraIndependentScript
"afbc5005df84ba5f8ee93ab435bc5e83067fa1f12f9c42cdd7110386")
            , DRep -> Delegatee
DelegVote forall a b. (a -> b) -> a -> b
$
                Credential 'DRepRole -> DRep
DRepCredential
                  (forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (forall (r :: KeyRole).
Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
KeyHash Hash ADDRHASH (VerKeyDSIGN DSIGN)
"78301005df84ba67fa1f12f95f8ee10335bc5e86c42afbc593ab4cdd"))
            )
          ]
    , cgConstitution :: Constitution ConwayEra
cgConstitution = forall a. Default a => a
def
    , cgUpgradePParams :: UpgradeConwayPParams Identity
cgUpgradePParams =
        UpgradeConwayPParams
          { ucppPoolVotingThresholds :: HKD Identity PoolVotingThresholds
ucppPoolVotingThresholds = forall a. Default a => a
def
          , ucppDRepVotingThresholds :: HKD Identity DRepVotingThresholds
ucppDRepVotingThresholds = forall a. Default a => a
def
          , ucppCommitteeMinSize :: HKD Identity Word16
ucppCommitteeMinSize = Word16
0
          , ucppCommitteeMaxTermLength :: HKD Identity EpochInterval
ucppCommitteeMaxTermLength = Word32 -> EpochInterval
EpochInterval Word32
0
          , ucppGovActionLifetime :: HKD Identity EpochInterval
ucppGovActionLifetime = Word32 -> EpochInterval
EpochInterval Word32
0
          , ucppGovActionDeposit :: HKD Identity Coin
ucppGovActionDeposit = Integer -> Coin
Coin Integer
0
          , ucppDRepDeposit :: HKD Identity Coin
ucppDRepDeposit = Integer -> Coin
Coin Integer
0
          , ucppDRepActivity :: HKD Identity EpochInterval
ucppDRepActivity = Word32 -> EpochInterval
EpochInterval Word32
0
          , ucppMinFeeRefScriptCostPerByte :: HKD Identity NonNegativeInterval
ucppMinFeeRefScriptCostPerByte = forall a. Bounded a => a
minBound
          , ucppPlutusV3CostModel :: HKD Identity CostModel
ucppPlutusV3CostModel = HasCallStack => CostModel
zeroTestingCostModelV3
          }
    }