{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- RecordWildCards cause name shadowing warnings in ghc-8.10.
#if __GLASGOW_HASKELL__ < 900
{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# OPTIONS_GHC -O0 #-}
#endif

-- | This module provides `HasSpec` and `HasSimpleRep` instances for
--   Basic types. A type is 'Basic' if it is used to define PParams.
--   See Test.Cardano.Ledger.Constrained.Conway.SimplePParams
--   We divide these `HasSpec` and `HasSimpleRep` instances into two files
--   because SimplePParams, needs these instances but not the 100's of other
--   ones defined in Test.Cardano.Ledger.Constrained.Conway.Instances.Ledger
--   And too many instances causes GHC 8.10.7 to blow up.
module Test.Cardano.Ledger.Constrained.Conway.Instances.Basic (
  cSNothing_,
  cSJust_,
  succV_,
  makePrices,
  makeUnitInterval,
  makeNonNegativeInterval,
  SimplePParams (..),
  SimplePPUpdate (..),
  EraSpecPParams (..),
  prettyE,
) where

import Cardano.Ledger.Alonzo.PParams
import Cardano.Ledger.BaseTypes hiding (inject)
import Cardano.Ledger.Coin
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.Scripts ()
import Cardano.Ledger.Plutus.CostModels (CostModels)
import Cardano.Ledger.Plutus.ExUnits
import Cardano.Ledger.Shelley.PParams (ProposedPPUpdates (..))
import Constrained.API
import Constrained.Base
import Constrained.GenT
import Constrained.NumSpec
import Constrained.SumList (genListWithSize)
import Constrained.TheKnot
import Control.Monad.Identity (Identity (..))
import Control.Monad.Trans.Fail.String
import Data.Maybe
import Data.Ratio ((%))
import Data.TreeDiff
import Data.Typeable
import Data.Word
import GHC.Generics (Generic)
import Numeric.Natural (Natural)
import System.Random
import Test.Cardano.Ledger.Allegra.Arbitrary ()
import Test.Cardano.Ledger.Alonzo.Arbitrary ()
import Test.QuickCheck hiding (Args, Fun, NonZero, forAll)
import Text.PrettyPrint.HughesPJ (Doc)

-- ===============================================
-- Pretty printing via TreeDiff Expr

prettyE :: ToExpr x => x -> Doc
prettyE :: forall x. ToExpr x => x -> Doc
prettyE x
x = Expr -> Doc
prettyExpr (forall a. ToExpr a => a -> Expr
toExpr x
x)

-- ============================================================================
-- Making Intervals based on Ratios, These can fail, so be careful using them.

makePrices :: Integer -> Integer -> Prices
makePrices :: Integer -> Integer -> Prices
makePrices Integer
x Integer
y = NonNegativeInterval -> NonNegativeInterval -> Prices
Prices (forall a. HasCallStack => Maybe a -> a
fromJust (forall r. BoundedRational r => Rational -> Maybe r
boundRational (Integer
x forall a. Integral a => a -> a -> Ratio a
% Integer
1))) (forall a. HasCallStack => Maybe a -> a
fromJust (forall r. BoundedRational r => Rational -> Maybe r
boundRational (Integer
y forall a. Integral a => a -> a -> Ratio a
% Integer
1)))

makeUnitInterval :: Integer -> Integer -> UnitInterval
makeUnitInterval :: Integer -> Integer -> UnitInterval
makeUnitInterval Integer
i Integer
j = forall a. HasCallStack => Maybe a -> a
fromJust (forall r. BoundedRational r => Rational -> Maybe r
boundRational (Integer
i forall a. Integral a => a -> a -> Ratio a
% Integer
j))

makeNonNegativeInterval :: Integer -> Integer -> NonNegativeInterval
makeNonNegativeInterval :: Integer -> Integer -> NonNegativeInterval
makeNonNegativeInterval Integer
i Integer
j = forall a. HasCallStack => Maybe a -> a
fromJust (forall r. BoundedRational r => Rational -> Maybe r
boundRational (Integer
i forall a. Integral a => a -> a -> Ratio a
% Integer
j))

-- =============================================================
-- HasSpec instances for types that appear in PParams

instance HasSimpleRep Coin where
  type SimpleRep Coin = Word64
  toSimpleRep :: Coin -> SimpleRep Coin
toSimpleRep (Coin Integer
i) = case Integer -> Maybe Word64
integerToWord64 Integer
i of
    Maybe Word64
Nothing -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"The impossible happened in toSimpleRep for (Coin " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Integer
i forall a. [a] -> [a] -> [a]
++ [Char]
")"
    Just Word64
w -> Word64
w
  fromSimpleRep :: SimpleRep Coin -> Coin
fromSimpleRep = Word64 -> Coin
word64ToCoin
instance HasSpec Coin

instance MaybeBounded Coin where
  lowerBound :: Maybe Coin
lowerBound = forall a. a -> Maybe a
Just (Word64 -> Coin
word64ToCoin Word64
0)
  upperBound :: Maybe Coin
upperBound = forall a. a -> Maybe a
Just (Word64 -> Coin
word64ToCoin (forall a. Bounded a => a
maxBound @Word64))

instance OrdLike Coin

instance NumLike Coin

instance Foldy Coin where
  genList :: forall (m :: * -> *).
MonadGenError m =>
Specification Coin -> Specification Coin -> GenT m [Coin]
genList Specification Coin
s Specification Coin
s' = forall a b. (a -> b) -> [a] -> [b]
map forall a. HasSimpleRep a => SimpleRep a -> a
fromSimpleRep forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *).
(Foldy a, MonadGenError m) =>
Specification a -> Specification a -> GenT m [a]
genList @Word64 (forall a.
(HasSpec (SimpleRep a), HasSimpleRep a,
 TypeSpec a ~ TypeSpec (SimpleRep a)) =>
Specification a -> Specification (SimpleRep a)
toSimpleRepSpec Specification Coin
s) (forall a.
(HasSpec (SimpleRep a), HasSimpleRep a,
 TypeSpec a ~ TypeSpec (SimpleRep a)) =>
Specification a -> Specification (SimpleRep a)
toSimpleRepSpec Specification Coin
s')
  theAddFn :: IntW '[Coin, Coin] Coin
theAddFn = forall b. NumLike b => IntW '[b, b] b
AddW
  theZero :: Coin
theZero = Integer -> Coin
Coin Integer
0
  genSizedList :: forall (m :: * -> *).
MonadGenError m =>
Specification Integer
-> Specification Coin -> Specification Coin -> GenT m [Coin]
genSizedList Specification Integer
sz Specification Coin
elemSpec Specification Coin
foldSpec =
    forall a b. (a -> b) -> [a] -> [b]
map forall a. HasSimpleRep a => SimpleRep a -> a
fromSimpleRep
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *).
(Complete a, TypeSpec a ~ NumSpec a, MonadGenError m, Random a,
 Integral a, Arbitrary a, MaybeBounded a, Complete Integer,
 TypeSpec Integer ~ NumSpec Integer) =>
Specification Integer
-> Specification a -> Specification a -> GenT m [a]
genListWithSize @Word64 Specification Integer
sz (forall a.
(HasSpec (SimpleRep a), HasSimpleRep a,
 TypeSpec a ~ TypeSpec (SimpleRep a)) =>
Specification a -> Specification (SimpleRep a)
toSimpleRepSpec Specification Coin
elemSpec) (forall a.
(HasSpec (SimpleRep a), HasSimpleRep a,
 TypeSpec a ~ TypeSpec (SimpleRep a)) =>
Specification a -> Specification (SimpleRep a)
toSimpleRepSpec Specification Coin
foldSpec)
  noNegativeValues :: Bool
noNegativeValues = Bool
True

-- TODO: This is hack to get around the need for `Num` in `NumLike`. We should possibly split
-- this up so that `NumLike` has its own addition etc. instead?
deriving via Integer instance Num Coin

instance Typeable a => HasSimpleRep (StrictMaybe a)
instance (HasSpec a, IsNormalType a) => HasSpec (StrictMaybe a)

cSNothing_ :: (HasSpec a, IsNormalType a) => Term (StrictMaybe a)
cSNothing_ :: forall a. (HasSpec a, IsNormalType a) => Term (StrictMaybe a)
cSNothing_ = forall (c :: Symbol) a r.
(SimpleRep a ~ SOP (TheSop a),
 TypeSpec a ~ TypeSpec (SOP (TheSop a)),
 TypeList (ConstrOf c (TheSop a)), HasSpec a, HasSimpleRep a,
 r ~ FunTy (MapList Term (ConstrOf c (TheSop a))) (Term a),
 ResultType r ~ Term a, SOPTerm c (TheSop a),
 ConstrTerm (ConstrOf c (TheSop a))) =>
r
con @"SNothing" (forall a. HasSpec a => a -> Term a
lit ())

cSJust_ :: (HasSpec a, IsNormalType a) => Term a -> Term (StrictMaybe a)
cSJust_ :: forall a.
(HasSpec a, IsNormalType a) =>
Term a -> Term (StrictMaybe a)
cSJust_ = forall (c :: Symbol) a r.
(SimpleRep a ~ SOP (TheSop a),
 TypeSpec a ~ TypeSpec (SOP (TheSop a)),
 TypeList (ConstrOf c (TheSop a)), HasSpec a, HasSimpleRep a,
 r ~ FunTy (MapList Term (ConstrOf c (TheSop a))) (Term a),
 ResultType r ~ Term a, SOPTerm c (TheSop a),
 ConstrTerm (ConstrOf c (TheSop a))) =>
r
con @"SJust"

instance HasSimpleRep EpochInterval
instance OrdLike EpochInterval
instance HasSpec EpochInterval

instance HasSpec UnitInterval where
  type TypeSpec UnitInterval = ()
  emptySpec :: TypeSpec UnitInterval
emptySpec = ()
  combineSpec :: TypeSpec UnitInterval
-> TypeSpec UnitInterval -> Specification UnitInterval
combineSpec TypeSpec UnitInterval
_ TypeSpec UnitInterval
_ = forall a. Specification a
TrueSpec
  genFromTypeSpec :: forall (m :: * -> *).
(HasCallStack, MonadGenError m) =>
TypeSpec UnitInterval -> GenT m UnitInterval
genFromTypeSpec TypeSpec UnitInterval
_ = forall (m :: * -> *) a. Applicative m => Gen a -> GenT m a
pureGen forall a. Arbitrary a => Gen a
arbitrary
  cardinalTypeSpec :: TypeSpec UnitInterval -> Specification Integer
cardinalTypeSpec TypeSpec UnitInterval
_ = forall a. Specification a
TrueSpec
  shrinkWithTypeSpec :: TypeSpec UnitInterval -> UnitInterval -> [UnitInterval]
shrinkWithTypeSpec TypeSpec UnitInterval
_ = forall a. Arbitrary a => a -> [a]
shrink
  conformsTo :: HasCallStack => UnitInterval -> TypeSpec UnitInterval -> Bool
conformsTo UnitInterval
_ TypeSpec UnitInterval
_ = Bool
True
  toPreds :: Term UnitInterval -> TypeSpec UnitInterval -> Pred
toPreds Term UnitInterval
_ TypeSpec UnitInterval
_ = forall p. IsPred p => p -> Pred
toPred Bool
True

instance HasSpec NonNegativeInterval where
  type TypeSpec NonNegativeInterval = ()
  emptySpec :: TypeSpec NonNegativeInterval
emptySpec = ()
  combineSpec :: TypeSpec NonNegativeInterval
-> TypeSpec NonNegativeInterval
-> Specification NonNegativeInterval
combineSpec TypeSpec NonNegativeInterval
_ TypeSpec NonNegativeInterval
_ = forall a. Specification a
TrueSpec
  genFromTypeSpec :: forall (m :: * -> *).
(HasCallStack, MonadGenError m) =>
TypeSpec NonNegativeInterval -> GenT m NonNegativeInterval
genFromTypeSpec TypeSpec NonNegativeInterval
_ = forall (m :: * -> *) a. Applicative m => Gen a -> GenT m a
pureGen forall a. Arbitrary a => Gen a
arbitrary
  cardinalTypeSpec :: TypeSpec NonNegativeInterval -> Specification Integer
cardinalTypeSpec TypeSpec NonNegativeInterval
_ = forall a. Specification a
TrueSpec
  shrinkWithTypeSpec :: TypeSpec NonNegativeInterval
-> NonNegativeInterval -> [NonNegativeInterval]
shrinkWithTypeSpec TypeSpec NonNegativeInterval
_ = forall a. Arbitrary a => a -> [a]
shrink
  conformsTo :: HasCallStack =>
NonNegativeInterval -> TypeSpec NonNegativeInterval -> Bool
conformsTo NonNegativeInterval
_ TypeSpec NonNegativeInterval
_ = Bool
True
  toPreds :: Term NonNegativeInterval -> TypeSpec NonNegativeInterval -> Pred
toPreds Term NonNegativeInterval
_ TypeSpec NonNegativeInterval
_ = forall p. IsPred p => p -> Pred
toPred Bool
True

instance HasSimpleRep CostModels
instance HasSpec CostModels where
  type TypeSpec CostModels = ()
  emptySpec :: TypeSpec CostModels
emptySpec = ()
  combineSpec :: TypeSpec CostModels
-> TypeSpec CostModels -> Specification CostModels
combineSpec TypeSpec CostModels
_ TypeSpec CostModels
_ = forall a. Specification a
TrueSpec
  genFromTypeSpec :: forall (m :: * -> *).
(HasCallStack, MonadGenError m) =>
TypeSpec CostModels -> GenT m CostModels
genFromTypeSpec TypeSpec CostModels
_ = forall (m :: * -> *) a. Applicative m => Gen a -> GenT m a
pureGen forall a. Arbitrary a => Gen a
arbitrary
  cardinalTypeSpec :: TypeSpec CostModels -> Specification Integer
cardinalTypeSpec TypeSpec CostModels
_ = forall a. Specification a
TrueSpec
  shrinkWithTypeSpec :: TypeSpec CostModels -> CostModels -> [CostModels]
shrinkWithTypeSpec TypeSpec CostModels
_ = forall a. Arbitrary a => a -> [a]
shrink
  conformsTo :: HasCallStack => CostModels -> TypeSpec CostModels -> Bool
conformsTo CostModels
_ TypeSpec CostModels
_ = Bool
True
  toPreds :: Term CostModels -> TypeSpec CostModels -> Pred
toPreds Term CostModels
_ TypeSpec CostModels
_ = forall p. IsPred p => p -> Pred
toPred Bool
True

instance HasSimpleRep Prices
instance HasSpec Prices

instance HasSimpleRep ExUnits where
  type SimpleRep ExUnits = SimpleRep (Natural, Natural)
  fromSimpleRep :: SimpleRep ExUnits -> ExUnits
fromSimpleRep = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Natural -> Natural -> ExUnits
ExUnits forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasSimpleRep a => SimpleRep a -> a
fromSimpleRep
  toSimpleRep :: ExUnits -> SimpleRep ExUnits
toSimpleRep (ExUnits Natural
a Natural
b) = forall a. HasSimpleRep a => a -> SimpleRep a
toSimpleRep (Natural
a, Natural
b)
instance HasSpec ExUnits

instance HasSimpleRep OrdExUnits where
  type SimpleRep OrdExUnits = SimpleRep ExUnits
  fromSimpleRep :: SimpleRep OrdExUnits -> OrdExUnits
fromSimpleRep = ExUnits -> OrdExUnits
OrdExUnits forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasSimpleRep a => SimpleRep a -> a
fromSimpleRep
  toSimpleRep :: OrdExUnits -> SimpleRep OrdExUnits
toSimpleRep = forall a. HasSimpleRep a => a -> SimpleRep a
toSimpleRep forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrdExUnits -> ExUnits
unOrdExUnits
instance HasSpec OrdExUnits

instance HasSimpleRep PoolVotingThresholds
instance HasSpec PoolVotingThresholds

instance HasSimpleRep DRepVotingThresholds
instance HasSpec DRepVotingThresholds

instance HasSimpleRep ProtVer
instance HasSpec ProtVer

-- We do this like this to get the right bounds for `VersionRep`
-- while ensuring that we don't have to add instances for e.g. `Num`
-- to version.
newtype VersionRep = VersionRep Word8
  deriving (Int -> VersionRep -> ShowS
[VersionRep] -> ShowS
VersionRep -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [VersionRep] -> ShowS
$cshowList :: [VersionRep] -> ShowS
show :: VersionRep -> [Char]
$cshow :: VersionRep -> [Char]
showsPrec :: Int -> VersionRep -> ShowS
$cshowsPrec :: Int -> VersionRep -> ShowS
Show, VersionRep -> VersionRep -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VersionRep -> VersionRep -> Bool
$c/= :: VersionRep -> VersionRep -> Bool
== :: VersionRep -> VersionRep -> Bool
$c== :: VersionRep -> VersionRep -> Bool
Eq, Eq VersionRep
VersionRep -> VersionRep -> Bool
VersionRep -> VersionRep -> Ordering
VersionRep -> VersionRep -> VersionRep
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VersionRep -> VersionRep -> VersionRep
$cmin :: VersionRep -> VersionRep -> VersionRep
max :: VersionRep -> VersionRep -> VersionRep
$cmax :: VersionRep -> VersionRep -> VersionRep
>= :: VersionRep -> VersionRep -> Bool
$c>= :: VersionRep -> VersionRep -> Bool
> :: VersionRep -> VersionRep -> Bool
$c> :: VersionRep -> VersionRep -> Bool
<= :: VersionRep -> VersionRep -> Bool
$c<= :: VersionRep -> VersionRep -> Bool
< :: VersionRep -> VersionRep -> Bool
$c< :: VersionRep -> VersionRep -> Bool
compare :: VersionRep -> VersionRep -> Ordering
$ccompare :: VersionRep -> VersionRep -> Ordering
Ord, Integer -> VersionRep
VersionRep -> VersionRep
VersionRep -> VersionRep -> VersionRep
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> VersionRep
$cfromInteger :: Integer -> VersionRep
signum :: VersionRep -> VersionRep
$csignum :: VersionRep -> VersionRep
abs :: VersionRep -> VersionRep
$cabs :: VersionRep -> VersionRep
negate :: VersionRep -> VersionRep
$cnegate :: VersionRep -> VersionRep
* :: VersionRep -> VersionRep -> VersionRep
$c* :: VersionRep -> VersionRep -> VersionRep
- :: VersionRep -> VersionRep -> VersionRep
$c- :: VersionRep -> VersionRep -> VersionRep
+ :: VersionRep -> VersionRep -> VersionRep
$c+ :: VersionRep -> VersionRep -> VersionRep
Num, forall g. RandomGen g => g -> [VersionRep]
forall g. RandomGen g => g -> (VersionRep, g)
forall g.
RandomGen g =>
(VersionRep, VersionRep) -> g -> [VersionRep]
forall g.
RandomGen g =>
(VersionRep, VersionRep) -> g -> (VersionRep, g)
forall a.
(forall g. RandomGen g => (a, a) -> g -> (a, g))
-> (forall g. RandomGen g => g -> (a, g))
-> (forall g. RandomGen g => (a, a) -> g -> [a])
-> (forall g. RandomGen g => g -> [a])
-> Random a
randoms :: forall g. RandomGen g => g -> [VersionRep]
$crandoms :: forall g. RandomGen g => g -> [VersionRep]
randomRs :: forall g.
RandomGen g =>
(VersionRep, VersionRep) -> g -> [VersionRep]
$crandomRs :: forall g.
RandomGen g =>
(VersionRep, VersionRep) -> g -> [VersionRep]
random :: forall g. RandomGen g => g -> (VersionRep, g)
$crandom :: forall g. RandomGen g => g -> (VersionRep, g)
randomR :: forall g.
RandomGen g =>
(VersionRep, VersionRep) -> g -> (VersionRep, g)
$crandomR :: forall g.
RandomGen g =>
(VersionRep, VersionRep) -> g -> (VersionRep, g)
Random, Gen VersionRep
VersionRep -> [VersionRep]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
shrink :: VersionRep -> [VersionRep]
$cshrink :: VersionRep -> [VersionRep]
arbitrary :: Gen VersionRep
$carbitrary :: Gen VersionRep
Arbitrary, Enum VersionRep
Real VersionRep
VersionRep -> Integer
VersionRep -> VersionRep -> (VersionRep, VersionRep)
VersionRep -> VersionRep -> VersionRep
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: VersionRep -> Integer
$ctoInteger :: VersionRep -> Integer
divMod :: VersionRep -> VersionRep -> (VersionRep, VersionRep)
$cdivMod :: VersionRep -> VersionRep -> (VersionRep, VersionRep)
quotRem :: VersionRep -> VersionRep -> (VersionRep, VersionRep)
$cquotRem :: VersionRep -> VersionRep -> (VersionRep, VersionRep)
mod :: VersionRep -> VersionRep -> VersionRep
$cmod :: VersionRep -> VersionRep -> VersionRep
div :: VersionRep -> VersionRep -> VersionRep
$cdiv :: VersionRep -> VersionRep -> VersionRep
rem :: VersionRep -> VersionRep -> VersionRep
$crem :: VersionRep -> VersionRep -> VersionRep
quot :: VersionRep -> VersionRep -> VersionRep
$cquot :: VersionRep -> VersionRep -> VersionRep
Integral, Num VersionRep
Ord VersionRep
VersionRep -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: VersionRep -> Rational
$ctoRational :: VersionRep -> Rational
Real, Int -> VersionRep
VersionRep -> Int
VersionRep -> [VersionRep]
VersionRep -> VersionRep
VersionRep -> VersionRep -> [VersionRep]
VersionRep -> VersionRep -> VersionRep -> [VersionRep]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: VersionRep -> VersionRep -> VersionRep -> [VersionRep]
$cenumFromThenTo :: VersionRep -> VersionRep -> VersionRep -> [VersionRep]
enumFromTo :: VersionRep -> VersionRep -> [VersionRep]
$cenumFromTo :: VersionRep -> VersionRep -> [VersionRep]
enumFromThen :: VersionRep -> VersionRep -> [VersionRep]
$cenumFromThen :: VersionRep -> VersionRep -> [VersionRep]
enumFrom :: VersionRep -> [VersionRep]
$cenumFrom :: VersionRep -> [VersionRep]
fromEnum :: VersionRep -> Int
$cfromEnum :: VersionRep -> Int
toEnum :: Int -> VersionRep
$ctoEnum :: Int -> VersionRep
pred :: VersionRep -> VersionRep
$cpred :: VersionRep -> VersionRep
succ :: VersionRep -> VersionRep
$csucc :: VersionRep -> VersionRep
Enum) via Word8
instance HasSpec VersionRep where
  type TypeSpec VersionRep = NumSpec VersionRep
  emptySpec :: TypeSpec VersionRep
emptySpec = forall a. Ord a => NumSpec a
emptyNumSpec
  combineSpec :: TypeSpec VersionRep
-> TypeSpec VersionRep -> Specification VersionRep
combineSpec = forall n.
(HasSpec n, Ord n, TypeSpec n ~ NumSpec n) =>
NumSpec n -> NumSpec n -> Specification n
combineNumSpec
  genFromTypeSpec :: forall (m :: * -> *).
(HasCallStack, MonadGenError m) =>
TypeSpec VersionRep -> GenT m VersionRep
genFromTypeSpec = forall (m :: * -> *) n.
(MonadGenError m, Show n, Random n, Ord n, Num n,
 MaybeBounded n) =>
NumSpec n -> GenT m n
genFromNumSpec
  shrinkWithTypeSpec :: TypeSpec VersionRep -> VersionRep -> [VersionRep]
shrinkWithTypeSpec = forall n. Arbitrary n => NumSpec n -> n -> [n]
shrinkWithNumSpec
  conformsTo :: HasCallStack => VersionRep -> TypeSpec VersionRep -> Bool
conformsTo = forall n. Ord n => n -> NumSpec n -> Bool
conformsToNumSpec
  toPreds :: Term VersionRep -> TypeSpec VersionRep -> Pred
toPreds = forall n. OrdLike n => Term n -> NumSpec n -> Pred
toPredsNumSpec
  cardinalTypeSpec :: TypeSpec VersionRep -> Specification Integer
cardinalTypeSpec = forall n.
(Integral n, MaybeBounded n) =>
NumSpec n -> Specification Integer
cardinalNumSpec
instance Bounded VersionRep where
  minBound :: VersionRep
minBound = Word8 -> VersionRep
VersionRep forall a b. (a -> b) -> a -> b
$ forall i. Integral i => Version -> i
getVersion forall a. Bounded a => a
minBound
  maxBound :: VersionRep
maxBound = Word8 -> VersionRep
VersionRep forall a b. (a -> b) -> a -> b
$ forall i. Integral i => Version -> i
getVersion forall a. Bounded a => a
maxBound
instance MaybeBounded VersionRep

instance HasSimpleRep Version where
  type SimpleRep Version = VersionRep
  fromSimpleRep :: SimpleRep Version -> Version
fromSimpleRep (VersionRep Word8
rep) = case forall a. Fail a -> Either [Char] a
runFail forall a b. (a -> b) -> a -> b
$ forall i (m :: * -> *). (Integral i, MonadFail m) => i -> m Version
mkVersion Word8
rep of
    Left [Char]
err ->
      forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$
        [[Char]] -> [Char]
unlines
          [ [Char]
"fromSimpleRep @Version:"
          , forall a. Show a => a -> [Char]
show Word8
rep
          , [Char]
err
          ]
    Right Version
a -> Version
a
  toSimpleRep :: Version -> SimpleRep Version
toSimpleRep = Word8 -> VersionRep
VersionRep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Integral i => Version -> i
getVersion
instance HasSpec Version
instance OrdLike Version

succV_ :: Term Version -> Term Version
succV_ :: Term Version -> Term Version
succV_ = forall a.
(GenericRequires a, AppRequires BaseW '[SimpleRep a] a) =>
Term (SimpleRep a) -> Term a
fromGeneric_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
+ Term VersionRep
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. GenericRequires a => Term a -> Term (SimpleRep a)
toGeneric_

instance Typeable r => HasSpec (KeyHash r) where
  type TypeSpec (KeyHash r) = ()
  emptySpec :: TypeSpec (KeyHash r)
emptySpec = ()
  combineSpec :: TypeSpec (KeyHash r)
-> TypeSpec (KeyHash r) -> Specification (KeyHash r)
combineSpec TypeSpec (KeyHash r)
_ TypeSpec (KeyHash r)
_ = forall a. Specification a
TrueSpec
  genFromTypeSpec :: forall (m :: * -> *).
(HasCallStack, MonadGenError m) =>
TypeSpec (KeyHash r) -> GenT m (KeyHash r)
genFromTypeSpec TypeSpec (KeyHash r)
_ = forall (m :: * -> *) a. Applicative m => Gen a -> GenT m a
pureGen forall a. Arbitrary a => Gen a
arbitrary
  cardinalTypeSpec :: TypeSpec (KeyHash r) -> Specification Integer
cardinalTypeSpec TypeSpec (KeyHash r)
_ = forall a. Specification a
TrueSpec
  shrinkWithTypeSpec :: TypeSpec (KeyHash r) -> KeyHash r -> [KeyHash r]
shrinkWithTypeSpec TypeSpec (KeyHash r)
_ = forall a. Arbitrary a => a -> [a]
shrink
  conformsTo :: HasCallStack => KeyHash r -> TypeSpec (KeyHash r) -> Bool
conformsTo KeyHash r
_ TypeSpec (KeyHash r)
_ = Bool
True
  toPreds :: Term (KeyHash r) -> TypeSpec (KeyHash r) -> Pred
toPreds Term (KeyHash r)
_ TypeSpec (KeyHash r)
_ = forall p. IsPred p => p -> Pred
toPred Bool
True

-- =========================================================================================

-- =============================================================================
-- So now we define very simple types to serve as the SimpleRep for PParams and
-- its related types  (PParamsUpdate, FuturePParams etc.)

-- | Use this as the SimpleRep of (PParams era). It is polymorphic enough to
--   encode PParams in EVERY Era. The EraPParams instances remove the fields
--   that do not appear in that Era.
data SimplePParams era = SimplePParams
  { forall era. SimplePParams era -> Coin
minFeeA :: Coin
  , forall era. SimplePParams era -> Coin
minFeeB :: Coin
  , forall era. SimplePParams era -> Word32
maxBBSize :: Word32
  , forall era. SimplePParams era -> Word32
maxTxSize :: Word32
  , forall era. SimplePParams era -> Word32
maxBHSize :: Word32 -- Need to be downsized inside reify to Word16
  , forall era. SimplePParams era -> Coin
keyDeposit :: Coin
  , forall era. SimplePParams era -> Coin
poolDeposit :: Coin
  , forall era. SimplePParams era -> EpochInterval
eMax :: EpochInterval
  , forall era. SimplePParams era -> Word16
nOpt :: Word16
  , forall era. SimplePParams era -> NonNegativeInterval
a0 :: NonNegativeInterval
  , forall era. SimplePParams era -> UnitInterval
rho :: UnitInterval
  , forall era. SimplePParams era -> UnitInterval
tau :: UnitInterval
  , forall era. SimplePParams era -> UnitInterval
decentral :: UnitInterval
  , forall era. SimplePParams era -> ProtVer
protocolVersion :: ProtVer
  , forall era. SimplePParams era -> Coin
minUTxOValue :: Coin
  , forall era. SimplePParams era -> Coin
minPoolCost :: Coin
  -- ^ Alonzo
  , forall era. SimplePParams era -> Coin
coinsPerUTxOWord :: Coin
  , forall era. SimplePParams era -> CostModels
costModels :: CostModels
  , forall era. SimplePParams era -> Prices
prices :: Prices
  , forall era. SimplePParams era -> ExUnits
maxTxExUnits :: ExUnits
  , forall era. SimplePParams era -> ExUnits
maxBlockExUnits :: ExUnits
  , forall era. SimplePParams era -> Natural
maxValSize :: Natural
  , forall era. SimplePParams era -> Natural
collateralPercentage :: Natural
  , forall era. SimplePParams era -> Natural
maxCollateralInputs :: Natural
  -- ^  Babbage
  , forall era. SimplePParams era -> Coin
coinsPerUTxOByte :: Coin
  -- ^ Conway
  , forall era. SimplePParams era -> PoolVotingThresholds
poolVotingThresholds :: PoolVotingThresholds
  , forall era. SimplePParams era -> DRepVotingThresholds
drepVotingThresholds :: DRepVotingThresholds
  , forall era. SimplePParams era -> Natural
committeeMinSize :: Natural
  , forall era. SimplePParams era -> EpochInterval
committeeMaxTermLength :: EpochInterval
  , forall era. SimplePParams era -> EpochInterval
govActionLifetime :: EpochInterval
  , forall era. SimplePParams era -> Coin
govActionDeposit :: Coin
  , forall era. SimplePParams era -> Coin
dRepDeposit :: Coin
  , forall era. SimplePParams era -> EpochInterval
dRepActivity :: EpochInterval
  , forall era. SimplePParams era -> NonNegativeInterval
minFeeRefScriptCostPerByte :: NonNegativeInterval
  }
  deriving (SimplePParams era -> SimplePParams era -> Bool
forall era. SimplePParams era -> SimplePParams era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SimplePParams era -> SimplePParams era -> Bool
$c/= :: forall era. SimplePParams era -> SimplePParams era -> Bool
== :: SimplePParams era -> SimplePParams era -> Bool
$c== :: forall era. SimplePParams era -> SimplePParams era -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (SimplePParams era) x -> SimplePParams era
forall era x. SimplePParams era -> Rep (SimplePParams era) x
$cto :: forall era x. Rep (SimplePParams era) x -> SimplePParams era
$cfrom :: forall era x. SimplePParams era -> Rep (SimplePParams era) x
Generic)

instance (EraSpecPParams era, EraGov era, EraTxOut era) => Show (SimplePParams era) where
  show :: SimplePParams era -> [Char]
show SimplePParams era
x = forall a. Show a => a -> [Char]
show (forall era. EraSpecPParams era => SimplePParams era -> PParams era
subsetToPP @era SimplePParams era
x)

-- | Use then generic HasSimpleRep and HasSpec instances for SimplePParams
instance HasSimpleRep (SimplePParams era)

instance (EraSpecPParams era, EraGov era, EraTxOut era) => HasSpec (SimplePParams era)

-- | Use this as the SimpleRep of (PParamsUpdate era)
data SimplePPUpdate = SimplePPUpdate
  { SimplePPUpdate -> StrictMaybe Coin
uminFeeA :: StrictMaybe Coin
  , SimplePPUpdate -> StrictMaybe Coin
uminFeeB :: StrictMaybe Coin
  , SimplePPUpdate -> StrictMaybe Word32
umaxBBSize :: StrictMaybe Word32
  , SimplePPUpdate -> StrictMaybe Word32
umaxTxSize :: StrictMaybe Word32
  , SimplePPUpdate -> StrictMaybe Word32
umaxBHSize :: StrictMaybe Word32 -- Need to be downsized inside reify to Word16
  , SimplePPUpdate -> StrictMaybe Coin
ukeyDeposit :: StrictMaybe Coin
  , SimplePPUpdate -> StrictMaybe Coin
upoolDeposit :: StrictMaybe Coin
  , SimplePPUpdate -> StrictMaybe EpochInterval
ueMax :: StrictMaybe EpochInterval
  , SimplePPUpdate -> StrictMaybe Word16
unOpt :: StrictMaybe Word16
  , SimplePPUpdate -> StrictMaybe NonNegativeInterval
ua0 :: StrictMaybe NonNegativeInterval
  , SimplePPUpdate -> StrictMaybe UnitInterval
urho :: StrictMaybe UnitInterval
  , SimplePPUpdate -> StrictMaybe UnitInterval
utau :: StrictMaybe UnitInterval
  , SimplePPUpdate -> StrictMaybe UnitInterval
udecentral :: StrictMaybe UnitInterval
  , SimplePPUpdate -> StrictMaybe ProtVer
uprotocolVersion :: StrictMaybe ProtVer
  , SimplePPUpdate -> StrictMaybe Coin
uminUTxOValue :: StrictMaybe Coin
  , SimplePPUpdate -> StrictMaybe Coin
uminPoolCost :: StrictMaybe Coin
  , -- Alonzo
    SimplePPUpdate -> StrictMaybe Coin
ucoinsPerUTxOWord :: StrictMaybe Coin
  , SimplePPUpdate -> StrictMaybe CostModels
ucostModels :: StrictMaybe CostModels
  , SimplePPUpdate -> StrictMaybe Prices
uprices :: StrictMaybe Prices
  , SimplePPUpdate -> StrictMaybe ExUnits
umaxTxExUnits :: StrictMaybe ExUnits
  , SimplePPUpdate -> StrictMaybe ExUnits
umaxBlockExUnits :: StrictMaybe ExUnits
  , SimplePPUpdate -> StrictMaybe Natural
umaxValSize :: StrictMaybe Natural
  , SimplePPUpdate -> StrictMaybe Natural
ucollateralPercentage :: StrictMaybe Natural
  , SimplePPUpdate -> StrictMaybe Natural
umaxCollateralInputs :: StrictMaybe Natural
  , -- Babbage
    SimplePPUpdate -> StrictMaybe Coin
ucoinsPerUTxOByte :: StrictMaybe Coin
  , -- Conway
    SimplePPUpdate -> StrictMaybe PoolVotingThresholds
upoolVotingThresholds :: StrictMaybe PoolVotingThresholds
  , SimplePPUpdate -> StrictMaybe DRepVotingThresholds
udrepVotingThresholds :: StrictMaybe DRepVotingThresholds
  , SimplePPUpdate -> StrictMaybe Natural
ucommitteeMinSize :: StrictMaybe Natural
  , SimplePPUpdate -> StrictMaybe EpochInterval
ucommitteeMaxTermLength :: StrictMaybe EpochInterval
  , SimplePPUpdate -> StrictMaybe EpochInterval
ugovActionLifetime :: StrictMaybe EpochInterval
  , SimplePPUpdate -> StrictMaybe Coin
ugovActionDeposit :: StrictMaybe Coin
  , SimplePPUpdate -> StrictMaybe Coin
udRepDeposit :: StrictMaybe Coin
  , SimplePPUpdate -> StrictMaybe EpochInterval
udRepActivity :: StrictMaybe EpochInterval
  , SimplePPUpdate -> StrictMaybe NonNegativeInterval
uminFeeRefScriptCostPerByte :: StrictMaybe NonNegativeInterval
  }
  deriving (SimplePPUpdate -> SimplePPUpdate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SimplePPUpdate -> SimplePPUpdate -> Bool
$c/= :: SimplePPUpdate -> SimplePPUpdate -> Bool
== :: SimplePPUpdate -> SimplePPUpdate -> Bool
$c== :: SimplePPUpdate -> SimplePPUpdate -> Bool
Eq, Int -> SimplePPUpdate -> ShowS
[SimplePPUpdate] -> ShowS
SimplePPUpdate -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SimplePPUpdate] -> ShowS
$cshowList :: [SimplePPUpdate] -> ShowS
show :: SimplePPUpdate -> [Char]
$cshow :: SimplePPUpdate -> [Char]
showsPrec :: Int -> SimplePPUpdate -> ShowS
$cshowsPrec :: Int -> SimplePPUpdate -> ShowS
Show, forall x. Rep SimplePPUpdate x -> SimplePPUpdate
forall x. SimplePPUpdate -> Rep SimplePPUpdate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SimplePPUpdate x -> SimplePPUpdate
$cfrom :: forall x. SimplePPUpdate -> Rep SimplePPUpdate x
Generic)

-- ==============================================================================

-- | Use the generic HasSimpleRep and HasSpec instances for SimplePParams
instance HasSimpleRep SimplePPUpdate

instance HasSpec SimplePPUpdate

-- | SimpleRep instance for PParamsUpdate
instance EraSpecPParams era => HasSimpleRep (PParamsUpdate era) where
  type SimpleRep (PParamsUpdate era) = SimplePPUpdate
  toSimpleRep :: PParamsUpdate era -> SimpleRep (PParamsUpdate era)
toSimpleRep = forall era.
EraSpecPParams era =>
PParamsUpdate era -> SimplePPUpdate
ppuToUpdate
  fromSimpleRep :: SimpleRep (PParamsUpdate era) -> PParamsUpdate era
fromSimpleRep = forall era.
EraSpecPParams era =>
SimplePPUpdate -> PParamsUpdate era
updateToPPU

-- | HasSpec instance for PParams
instance EraSpecPParams era => HasSpec (PParamsUpdate era) where
  genFromTypeSpec :: forall (m :: * -> *).
(HasCallStack, MonadGenError m) =>
TypeSpec (PParamsUpdate era) -> GenT m (PParamsUpdate era)
genFromTypeSpec TypeSpec (PParamsUpdate era)
x = forall a. HasSimpleRep a => SimpleRep a -> a
fromSimpleRep forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *).
(HasSpec a, HasCallStack, MonadGenError m) =>
TypeSpec a -> GenT m a
genFromTypeSpec TypeSpec (PParamsUpdate era)
x

-- ===============================================================

-- | SimpleRep instance for PParams
instance EraSpecPParams era => HasSimpleRep (PParams era) where
  type SimpleRep (PParams era) = SimplePParams era
  toSimpleRep :: PParams era -> SimpleRep (PParams era)
toSimpleRep = forall era. EraSpecPParams era => PParams era -> SimplePParams era
ppToSubset
  fromSimpleRep :: SimpleRep (PParams era) -> PParams era
fromSimpleRep = forall era. EraSpecPParams era => SimplePParams era -> PParams era
subsetToPP

-- | HasSpec instance for PParams
instance (EraSpecPParams era, EraTxOut era, EraGov era) => HasSpec (PParams era) where
  genFromTypeSpec :: forall (m :: * -> *).
(HasCallStack, MonadGenError m) =>
TypeSpec (PParams era) -> GenT m (PParams era)
genFromTypeSpec TypeSpec (PParams era)
x = forall a. HasSimpleRep a => SimpleRep a -> a
fromSimpleRep forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *).
(HasSpec a, HasCallStack, MonadGenError m) =>
TypeSpec a -> GenT m a
genFromTypeSpec TypeSpec (PParams era)
x

-- =======================================

instance EraSpecPParams era => HasSimpleRep (ProposedPPUpdates era)
instance EraSpecPParams era => HasSpec (ProposedPPUpdates era)

instance EraSpecPParams era => HasSimpleRep (FuturePParams era)
instance (EraGov era, EraTxOut era, EraSpecPParams era) => HasSpec (FuturePParams era)

-- =============================================================

-- \| EraSpecPParams era means we can go back and forth between (SimplePParams era) and (PParams era)
--   This allow us to use (SimplePParams era) as the (SimpleRep (PParams era))
--   Much easier to constrain (SimplePParams era) than (PParams era) with all the THKD stuff.
class
  ( Eq (PParamsHKD Identity era)
  , Show (PParamsHKD Identity era)
  , Eq (PParamsHKD StrictMaybe era)
  , Show (PParamsHKD StrictMaybe era)
  , EraPParams era
  , EraTxOut era
  , EraGov era
  , EraTx era
  ) =>
  EraSpecPParams era
  where
  subsetToPP :: SimplePParams era -> PParams era
  ppToSubset :: PParams era -> SimplePParams era
  updateToPPU :: SimplePPUpdate -> PParamsUpdate era
  ppuToUpdate :: PParamsUpdate era -> SimplePPUpdate