-- editorconfig-checker-disable-file
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RankNTypes        #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Cardano.Constitution.Config.Types
    ( PredKey(..)
    , Predicate
    , Predicates(..)
    , PredMeaning
    , Param
    , ParamKey
    , ParamValue(..)
    , ConstitutionConfig(..)
    ) where

import GHC.Generics
import Language.Haskell.TH.Syntax as TH
import PlutusTx.Eq as Tx
import PlutusTx.Ord as Tx
import PlutusTx.Ratio as Tx
import Prelude qualified as Haskell

-- | The "unresolved" Predicate names, as read from JSON. At runtime, these PredKeys
-- will each be resolved to actual `PredMeaning` functions.
data PredKey =
    MinValue
  | MaxValue
  | NotEqual
  deriving stock (PredKey -> PredKey -> Bool
(PredKey -> PredKey -> Bool)
-> (PredKey -> PredKey -> Bool) -> Eq PredKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PredKey -> PredKey -> Bool
== :: PredKey -> PredKey -> Bool
$c/= :: PredKey -> PredKey -> Bool
/= :: PredKey -> PredKey -> Bool
Haskell.Eq, Eq PredKey
Eq PredKey =>
(PredKey -> PredKey -> Ordering)
-> (PredKey -> PredKey -> Bool)
-> (PredKey -> PredKey -> Bool)
-> (PredKey -> PredKey -> Bool)
-> (PredKey -> PredKey -> Bool)
-> (PredKey -> PredKey -> PredKey)
-> (PredKey -> PredKey -> PredKey)
-> Ord PredKey
PredKey -> PredKey -> Bool
PredKey -> PredKey -> Ordering
PredKey -> PredKey -> PredKey
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
$ccompare :: PredKey -> PredKey -> Ordering
compare :: PredKey -> PredKey -> Ordering
$c< :: PredKey -> PredKey -> Bool
< :: PredKey -> PredKey -> Bool
$c<= :: PredKey -> PredKey -> Bool
<= :: PredKey -> PredKey -> Bool
$c> :: PredKey -> PredKey -> Bool
> :: PredKey -> PredKey -> Bool
$c>= :: PredKey -> PredKey -> Bool
>= :: PredKey -> PredKey -> Bool
$cmax :: PredKey -> PredKey -> PredKey
max :: PredKey -> PredKey -> PredKey
$cmin :: PredKey -> PredKey -> PredKey
min :: PredKey -> PredKey -> PredKey
Haskell.Ord, Int -> PredKey -> ShowS
[PredKey] -> ShowS
PredKey -> String
(Int -> PredKey -> ShowS)
-> (PredKey -> String) -> ([PredKey] -> ShowS) -> Show PredKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PredKey -> ShowS
showsPrec :: Int -> PredKey -> ShowS
$cshow :: PredKey -> String
show :: PredKey -> String
$cshowList :: [PredKey] -> ShowS
showList :: [PredKey] -> ShowS
Haskell.Show, Int -> PredKey
PredKey -> Int
PredKey -> [PredKey]
PredKey -> PredKey
PredKey -> PredKey -> [PredKey]
PredKey -> PredKey -> PredKey -> [PredKey]
(PredKey -> PredKey)
-> (PredKey -> PredKey)
-> (Int -> PredKey)
-> (PredKey -> Int)
-> (PredKey -> [PredKey])
-> (PredKey -> PredKey -> [PredKey])
-> (PredKey -> PredKey -> [PredKey])
-> (PredKey -> PredKey -> PredKey -> [PredKey])
-> Enum PredKey
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: PredKey -> PredKey
succ :: PredKey -> PredKey
$cpred :: PredKey -> PredKey
pred :: PredKey -> PredKey
$ctoEnum :: Int -> PredKey
toEnum :: Int -> PredKey
$cfromEnum :: PredKey -> Int
fromEnum :: PredKey -> Int
$cenumFrom :: PredKey -> [PredKey]
enumFrom :: PredKey -> [PredKey]
$cenumFromThen :: PredKey -> PredKey -> [PredKey]
enumFromThen :: PredKey -> PredKey -> [PredKey]
$cenumFromTo :: PredKey -> PredKey -> [PredKey]
enumFromTo :: PredKey -> PredKey -> [PredKey]
$cenumFromThenTo :: PredKey -> PredKey -> PredKey -> [PredKey]
enumFromThenTo :: PredKey -> PredKey -> PredKey -> [PredKey]
Haskell.Enum, PredKey
PredKey -> PredKey -> Bounded PredKey
forall a. a -> a -> Bounded a
$cminBound :: PredKey
minBound :: PredKey
$cmaxBound :: PredKey
maxBound :: PredKey
Haskell.Bounded, (forall x. PredKey -> Rep PredKey x)
-> (forall x. Rep PredKey x -> PredKey) -> Generic PredKey
forall x. Rep PredKey x -> PredKey
forall x. PredKey -> Rep PredKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PredKey -> Rep PredKey x
from :: forall x. PredKey -> Rep PredKey x
$cto :: forall x. Rep PredKey x -> PredKey
to :: forall x. Rep PredKey x -> PredKey
Generic, (forall (m :: * -> *). Quote m => PredKey -> m Exp)
-> (forall (m :: * -> *). Quote m => PredKey -> Code m PredKey)
-> Lift PredKey
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => PredKey -> m Exp
forall (m :: * -> *). Quote m => PredKey -> Code m PredKey
$clift :: forall (m :: * -> *). Quote m => PredKey -> m Exp
lift :: forall (m :: * -> *). Quote m => PredKey -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => PredKey -> Code m PredKey
liftTyped :: forall (m :: * -> *). Quote m => PredKey -> Code m PredKey
TH.Lift)

instance Tx.Eq PredKey where
    {-# INLINABLE (==) #-}
    -- See Note [No catch-all]
    PredKey
MinValue == :: PredKey -> PredKey -> Bool
== PredKey
MinValue = Bool
Haskell.True
    PredKey
MaxValue == PredKey
MaxValue = Bool
Haskell.True
    PredKey
NotEqual == PredKey
NotEqual = Bool
Haskell.True
    PredKey
MinValue == PredKey
_        = Bool
Haskell.False
    PredKey
MaxValue == PredKey
_        = Bool
Haskell.False
    PredKey
NotEqual == PredKey
_        = Bool
Haskell.False

-- | Polymorphic over the values. In reality, the value v is an Tx.Integer or Tx.Rational
type Predicate v = (PredKey, [v])

-- | newtype so we can overload FromJSON
newtype Predicates v = Predicates { forall v. Predicates v -> [Predicate v]
unPredicates :: [Predicate v] }
    deriving stock ((forall (m :: * -> *). Quote m => Predicates v -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    Predicates v -> Code m (Predicates v))
-> Lift (Predicates v)
forall v (m :: * -> *). (Lift v, Quote m) => Predicates v -> m Exp
forall v (m :: * -> *).
(Lift v, Quote m) =>
Predicates v -> Code m (Predicates v)
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Predicates v -> m Exp
forall (m :: * -> *).
Quote m =>
Predicates v -> Code m (Predicates v)
$clift :: forall v (m :: * -> *). (Lift v, Quote m) => Predicates v -> m Exp
lift :: forall (m :: * -> *). Quote m => Predicates v -> m Exp
$cliftTyped :: forall v (m :: * -> *).
(Lift v, Quote m) =>
Predicates v -> Code m (Predicates v)
liftTyped :: forall (m :: * -> *).
Quote m =>
Predicates v -> Code m (Predicates v)
TH.Lift)
    deriving newtype (Predicates v -> Predicates v -> Bool
(Predicates v -> Predicates v -> Bool)
-> (Predicates v -> Predicates v -> Bool) -> Eq (Predicates v)
forall v. Eq v => Predicates v -> Predicates v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall v. Eq v => Predicates v -> Predicates v -> Bool
== :: Predicates v -> Predicates v -> Bool
$c/= :: forall v. Eq v => Predicates v -> Predicates v -> Bool
/= :: Predicates v -> Predicates v -> Bool
Haskell.Eq, Int -> Predicates v -> ShowS
[Predicates v] -> ShowS
Predicates v -> String
(Int -> Predicates v -> ShowS)
-> (Predicates v -> String)
-> ([Predicates v] -> ShowS)
-> Show (Predicates v)
forall v. Show v => Int -> Predicates v -> ShowS
forall v. Show v => [Predicates v] -> ShowS
forall v. Show v => Predicates v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall v. Show v => Int -> Predicates v -> ShowS
showsPrec :: Int -> Predicates v -> ShowS
$cshow :: forall v. Show v => Predicates v -> String
show :: Predicates v -> String
$cshowList :: forall v. Show v => [Predicates v] -> ShowS
showList :: [Predicates v] -> ShowS
Haskell.Show)

-- | The "meaning" of a predicate, resolved from a `PredKey` (a string in JSON)
-- to a Tx binary predicate function.
type PredMeaning a = Tx.Ord a
                   => a  -- ^ the expected value, supplied from the config (json)
                   -> a -- ^ the proposed value, taken from the ScriptContext
                   -> Haskell.Bool -- ^ True means the proposed value meets the expectations.

-- | Promised to be a stable identifier (stable at least for a whole cardano era)
type ParamKey = Haskell.Integer

data ParamValue =
      ParamInteger (Predicates Haskell.Integer)
    | ParamRational (Predicates Tx.Rational)
    | ParamList [ParamValue]
    | ParamAny
    deriving stock (ParamValue -> ParamValue -> Bool
(ParamValue -> ParamValue -> Bool)
-> (ParamValue -> ParamValue -> Bool) -> Eq ParamValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParamValue -> ParamValue -> Bool
== :: ParamValue -> ParamValue -> Bool
$c/= :: ParamValue -> ParamValue -> Bool
/= :: ParamValue -> ParamValue -> Bool
Haskell.Eq, Int -> ParamValue -> ShowS
[ParamValue] -> ShowS
ParamValue -> String
(Int -> ParamValue -> ShowS)
-> (ParamValue -> String)
-> ([ParamValue] -> ShowS)
-> Show ParamValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParamValue -> ShowS
showsPrec :: Int -> ParamValue -> ShowS
$cshow :: ParamValue -> String
show :: ParamValue -> String
$cshowList :: [ParamValue] -> ShowS
showList :: [ParamValue] -> ShowS
Haskell.Show, (forall (m :: * -> *). Quote m => ParamValue -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    ParamValue -> Code m ParamValue)
-> Lift ParamValue
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => ParamValue -> m Exp
forall (m :: * -> *). Quote m => ParamValue -> Code m ParamValue
$clift :: forall (m :: * -> *). Quote m => ParamValue -> m Exp
lift :: forall (m :: * -> *). Quote m => ParamValue -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => ParamValue -> Code m ParamValue
liftTyped :: forall (m :: * -> *). Quote m => ParamValue -> Code m ParamValue
TH.Lift)

type Param = (ParamKey, ParamValue)

{- Note [Manually constructing a Configuration value]

1. The `ConstitutionConfig` has to be sorted before it is passed to
the engine (requirement for the Sorted engine implementation).
2. The `ConstitutionConfig` should not contain duplicates.

Both 1 and 2 are guaranteed by construction only in case of using the JSON constitution format
and not when manually constructing a `ConstitutionConfig` ADT value.
-}

-- | See Note [Manually constructing a Configuration value]
newtype ConstitutionConfig = ConstitutionConfig { ConstitutionConfig -> [Param]
unConstitutionConfig :: [Param] }
    deriving stock ((forall (m :: * -> *). Quote m => ConstitutionConfig -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    ConstitutionConfig -> Code m ConstitutionConfig)
-> Lift ConstitutionConfig
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => ConstitutionConfig -> m Exp
forall (m :: * -> *).
Quote m =>
ConstitutionConfig -> Code m ConstitutionConfig
$clift :: forall (m :: * -> *). Quote m => ConstitutionConfig -> m Exp
lift :: forall (m :: * -> *). Quote m => ConstitutionConfig -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
ConstitutionConfig -> Code m ConstitutionConfig
liftTyped :: forall (m :: * -> *).
Quote m =>
ConstitutionConfig -> Code m ConstitutionConfig
TH.Lift)
    deriving newtype (ConstitutionConfig -> ConstitutionConfig -> Bool
(ConstitutionConfig -> ConstitutionConfig -> Bool)
-> (ConstitutionConfig -> ConstitutionConfig -> Bool)
-> Eq ConstitutionConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConstitutionConfig -> ConstitutionConfig -> Bool
== :: ConstitutionConfig -> ConstitutionConfig -> Bool
$c/= :: ConstitutionConfig -> ConstitutionConfig -> Bool
/= :: ConstitutionConfig -> ConstitutionConfig -> Bool
Haskell.Eq, Int -> ConstitutionConfig -> ShowS
[ConstitutionConfig] -> ShowS
ConstitutionConfig -> String
(Int -> ConstitutionConfig -> ShowS)
-> (ConstitutionConfig -> String)
-> ([ConstitutionConfig] -> ShowS)
-> Show ConstitutionConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConstitutionConfig -> ShowS
showsPrec :: Int -> ConstitutionConfig -> ShowS
$cshow :: ConstitutionConfig -> String
show :: ConstitutionConfig -> String
$cshowList :: [ConstitutionConfig] -> ShowS
showList :: [ConstitutionConfig] -> ShowS
Haskell.Show)

-- Taken from the older Reference impl: src/Cardano/Constitution/Validator/Reference/Types.hs
instance TH.Lift Tx.Rational where
  lift :: forall (m :: * -> *). Quote m => Rational -> m Exp
lift Rational
r =
    [|
      Tx.unsafeRatio
        $(Integer -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Integer -> m Exp
TH.lift (Rational -> Integer
Tx.numerator Rational
r))
        $(Integer -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Integer -> m Exp
TH.lift (Rational -> Integer
Tx.denominator Rational
r))
      |]
  liftTyped :: forall (m :: * -> *). Quote m => Rational -> Code m Rational
liftTyped Rational
r =
    [||
    Integer -> Integer -> Rational
Tx.unsafeRatio
      $$(Integer -> Code m Integer
forall t (m :: * -> *). (Lift t, Quote m) => t -> Code m t
forall (m :: * -> *). Quote m => Integer -> Code m Integer
TH.liftTyped (Rational -> Integer
Tx.numerator Rational
r))
      $$(Integer -> Code m Integer
forall t (m :: * -> *). (Lift t, Quote m) => t -> Code m t
forall (m :: * -> *). Quote m => Integer -> Code m Integer
TH.liftTyped (Rational -> Integer
Tx.denominator Rational
r))
    ||]