{-# 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 #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- 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 (..),
) 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 hiding (Value)
import Constrained.Base (genListWithSize)
import Constrained.Univ ()
import Control.Monad.Identity (Identity (..))
import Control.Monad.Trans.Fail.String
import Data.Maybe
import Data.Ratio ((%))
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.Cardano.Ledger.Generic.PrettyCore (PrettyA (..))
import Test.Cardano.Ledger.Generic.Proof (Reflect (..))
import Test.QuickCheck hiding (Args, Fun, NonZero, forAll)

-- ============================================================================
-- 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 BaseUniverse fn => HasSpec fn Coin
instance BaseUniverse fn => OrdLike fn Coin
instance BaseUniverse fn => NumLike fn Coin
instance BaseUniverse fn => Foldy fn Coin where
  genList :: forall (m :: * -> *).
(BaseUniverse fn, MonadGenError m) =>
Specification fn Coin -> Specification fn Coin -> GenT m [Coin]
genList Specification fn Coin
s Specification fn 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 (fn :: [*] -> * -> *) a (m :: * -> *).
(Foldy fn a, BaseUniverse fn, MonadGenError m) =>
Specification fn a -> Specification fn a -> GenT m [a]
genList @fn @Word64 (forall a (fn :: [*] -> * -> *).
(HasSpec fn a, HasSpec fn (SimpleRep a), HasSimpleRep a,
 TypeSpec fn a ~ TypeSpec fn (SimpleRep a)) =>
Specification fn a -> Specification fn (SimpleRep a)
toSimpleRepSpec Specification fn Coin
s) (forall a (fn :: [*] -> * -> *).
(HasSpec fn a, HasSpec fn (SimpleRep a), HasSimpleRep a,
 TypeSpec fn a ~ TypeSpec fn (SimpleRep a)) =>
Specification fn a -> Specification fn (SimpleRep a)
toSimpleRepSpec Specification fn Coin
s')
  theAddFn :: fn '[Coin, Coin] Coin
theAddFn = forall (fn :: [*] -> * -> *) a. NumLike fn a => fn '[a, a] a
addFn
  theZero :: Coin
theZero = Integer -> Coin
Coin Integer
0
  genSizedList :: forall (m :: * -> *).
(BaseUniverse fn, MonadGenError m) =>
Specification fn Integer
-> Specification fn Coin -> Specification fn Coin -> GenT m [Coin]
genSizedList Specification fn Integer
sz Specification fn Coin
elemSpec Specification fn 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 (fn :: [*] -> * -> *) a (m :: * -> *).
(Foldy fn a, MonadGenError m, Random a, Integral a,
 TypeSpec fn a ~ NumSpec fn a) =>
Specification fn Integer
-> Specification fn a -> Specification fn a -> GenT m [a]
genListWithSize @fn @Word64 Specification fn Integer
sz (forall a (fn :: [*] -> * -> *).
(HasSpec fn a, HasSpec fn (SimpleRep a), HasSimpleRep a,
 TypeSpec fn a ~ TypeSpec fn (SimpleRep a)) =>
Specification fn a -> Specification fn (SimpleRep a)
toSimpleRepSpec Specification fn Coin
elemSpec) (forall a (fn :: [*] -> * -> *).
(HasSpec fn a, HasSpec fn (SimpleRep a), HasSimpleRep a,
 TypeSpec fn a ~ TypeSpec fn (SimpleRep a)) =>
Specification fn a -> Specification fn (SimpleRep a)
toSimpleRepSpec Specification fn 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 HasSimpleRep (StrictMaybe a)
instance (HasSpec fn a, IsNormalType a) => HasSpec fn (StrictMaybe a)

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

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

instance HasSimpleRep EpochInterval
instance BaseUniverse fn => OrdLike fn EpochInterval
instance BaseUniverse fn => HasSpec fn EpochInterval

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

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

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

instance HasSimpleRep Prices
instance BaseUniverse fn => HasSpec fn 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 BaseUniverse fn => HasSpec fn 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 BaseUniverse fn => HasSpec fn OrdExUnits

instance HasSimpleRep PoolVotingThresholds
instance BaseUniverse fn => HasSpec fn PoolVotingThresholds

instance HasSimpleRep DRepVotingThresholds
instance BaseUniverse fn => HasSpec fn DRepVotingThresholds

instance HasSimpleRep ProtVer
instance BaseUniverse fn => HasSpec fn 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 BaseUniverse fn => HasSpec fn VersionRep where
  type TypeSpec fn VersionRep = NumSpec fn VersionRep
  emptySpec :: TypeSpec fn VersionRep
emptySpec = forall a (fn :: [*] -> * -> *). Ord a => NumSpec fn a
emptyNumSpec
  combineSpec :: TypeSpec fn VersionRep
-> TypeSpec fn VersionRep -> Specification fn VersionRep
combineSpec = forall (fn :: [*] -> * -> *) n.
(HasSpec fn n, Ord n, TypeSpec fn n ~ NumSpec fn n) =>
NumSpec fn n -> NumSpec fn n -> Specification fn n
combineNumSpec
  genFromTypeSpec :: forall (m :: * -> *).
(HasCallStack, MonadGenError m) =>
TypeSpec fn VersionRep -> GenT m VersionRep
genFromTypeSpec = forall (m :: * -> *) n (fn :: [*] -> * -> *).
(MonadGenError m, Show n, Random n, Ord n, Num n,
 MaybeBounded n) =>
NumSpec fn n -> GenT m n
genFromNumSpec
  shrinkWithTypeSpec :: TypeSpec fn VersionRep -> VersionRep -> [VersionRep]
shrinkWithTypeSpec = forall n (fn :: [*] -> * -> *).
Arbitrary n =>
NumSpec fn n -> n -> [n]
shrinkWithNumSpec
  conformsTo :: HasCallStack => VersionRep -> TypeSpec fn VersionRep -> Bool
conformsTo = forall n (fn :: [*] -> * -> *). Ord n => n -> NumSpec fn n -> Bool
conformsToNumSpec
  toPreds :: Term fn VersionRep -> TypeSpec fn VersionRep -> Pred fn
toPreds = forall n (fn :: [*] -> * -> *).
(Ord n, OrdLike fn n) =>
Term fn n -> NumSpec fn n -> Pred fn
toPredsNumSpec
  cardinalTypeSpec :: TypeSpec fn VersionRep -> Specification fn Integer
cardinalTypeSpec = forall n (fn :: [*] -> * -> *).
(Integral n, MaybeBounded n) =>
NumSpec fn n -> Specification fn 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 BaseUniverse fn => HasSpec fn Version
instance BaseUniverse fn => OrdLike fn Version

succV_ :: BaseUniverse fn => Term fn Version -> Term fn Version
succV_ :: forall (fn :: [*] -> * -> *).
BaseUniverse fn =>
Term fn Version -> Term fn Version
succV_ = forall a (fn :: [*] -> * -> *).
(HasSpec fn a, HasSpec fn (SimpleRep a), HasSimpleRep a,
 TypeSpec fn a ~ TypeSpec fn (SimpleRep a)) =>
Term fn (SimpleRep a) -> Term fn a
fromGeneric_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
+ Term fn VersionRep
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (fn :: [*] -> * -> *).
(HasSpec fn a, HasSpec fn (SimpleRep a), HasSimpleRep a,
 TypeSpec fn a ~ TypeSpec fn (SimpleRep a)) =>
Term fn a -> Term fn (SimpleRep a)
toGeneric_

instance (BaseUniverse fn, Typeable r) => HasSpec fn (KeyHash r) where
  type TypeSpec fn (KeyHash r) = ()
  emptySpec :: TypeSpec fn (KeyHash r)
emptySpec = ()
  combineSpec :: TypeSpec fn (KeyHash r)
-> TypeSpec fn (KeyHash r) -> Specification fn (KeyHash r)
combineSpec TypeSpec fn (KeyHash r)
_ TypeSpec fn (KeyHash r)
_ = forall (fn :: [*] -> * -> *) a. Specification fn a
TrueSpec
  genFromTypeSpec :: forall (m :: * -> *).
(HasCallStack, MonadGenError m) =>
TypeSpec fn (KeyHash r) -> GenT m (KeyHash r)
genFromTypeSpec TypeSpec fn (KeyHash r)
_ = forall (m :: * -> *) a. Applicative m => Gen a -> GenT m a
pureGen forall a. Arbitrary a => Gen a
arbitrary
  cardinalTypeSpec :: TypeSpec fn (KeyHash r) -> Specification fn Integer
cardinalTypeSpec TypeSpec fn (KeyHash r)
_ = forall (fn :: [*] -> * -> *) a. Specification fn a
TrueSpec
  shrinkWithTypeSpec :: TypeSpec fn (KeyHash r) -> KeyHash r -> [KeyHash r]
shrinkWithTypeSpec TypeSpec fn (KeyHash r)
_ = forall a. Arbitrary a => a -> [a]
shrink
  conformsTo :: HasCallStack => KeyHash r -> TypeSpec fn (KeyHash r) -> Bool
conformsTo KeyHash r
_ TypeSpec fn (KeyHash r)
_ = Bool
True
  toPreds :: Term fn (KeyHash r) -> TypeSpec fn (KeyHash r) -> Pred fn
toPreds Term fn (KeyHash r)
_ TypeSpec fn (KeyHash r)
_ = forall (fn :: [*] -> * -> *) p.
(BaseUniverse fn, PredLike p, UnivConstr p fn) =>
p -> Pred fn
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, Reflect era) => Show (SimplePParams era) where
  show :: SimplePParams era -> [Char]
show SimplePParams era
x = forall a. Show a => a -> [Char]
show (forall t. PrettyA t => t -> PDoc
prettyA (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, Reflect era, BaseUniverse fn) => HasSpec fn (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 BaseUniverse fn => HasSpec fn 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 (BaseUniverse fn, EraSpecPParams era) => HasSpec fn (PParamsUpdate era) where
  genFromTypeSpec :: forall (m :: * -> *).
(HasCallStack, MonadGenError m) =>
TypeSpec fn (PParamsUpdate era) -> GenT m (PParamsUpdate era)
genFromTypeSpec TypeSpec fn (PParamsUpdate era)
x = forall a. HasSimpleRep a => SimpleRep a -> a
fromSimpleRep forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (fn :: [*] -> * -> *) a (m :: * -> *).
(HasSpec fn a, HasCallStack, MonadGenError m) =>
TypeSpec fn a -> GenT m a
genFromTypeSpec TypeSpec fn (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 (BaseUniverse fn, EraSpecPParams era, HasSpec fn Coin) => HasSpec fn (PParams era) where
  genFromTypeSpec :: forall (m :: * -> *).
(HasCallStack, MonadGenError m) =>
TypeSpec fn (PParams era) -> GenT m (PParams era)
genFromTypeSpec TypeSpec fn (PParams era)
x = forall a. HasSimpleRep a => SimpleRep a -> a
fromSimpleRep forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (fn :: [*] -> * -> *) a (m :: * -> *).
(HasSpec fn a, HasCallStack, MonadGenError m) =>
TypeSpec fn a -> GenT m a
genFromTypeSpec TypeSpec fn (PParams era)
x

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

instance EraSpecPParams era => HasSimpleRep (ProposedPPUpdates era)
instance (EraSpecPParams era, BaseUniverse fn) => HasSpec fn (ProposedPPUpdates era)

instance EraSpecPParams era => HasSimpleRep (FuturePParams era)
instance (EraSpecPParams era, BaseUniverse fn) => HasSpec fn (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
  ( Reflect era
  , Eq (PParamsHKD Identity era)
  , Show (PParamsHKD Identity era)
  , Eq (PParamsHKD StrictMaybe era)
  , Show (PParamsHKD StrictMaybe era)
  , EraPParams era
  ) =>
  EraSpecPParams era
  where
  subsetToPP :: SimplePParams era -> PParams era
  ppToSubset :: PParams era -> SimplePParams era
  updateToPPU :: SimplePPUpdate -> PParamsUpdate era
  ppuToUpdate :: PParamsUpdate era -> SimplePPUpdate