{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.CanonicalState.Namespace.GovPParams.V0 (
  GovPParamsIn (..),
  GovPParamsOut (..),
  CanonicalPrices (..),
  mkCanonicalPrices,
  fromCanonicalPrices,
) where

import Cardano.Ledger.BaseTypes (NonNegativeInterval)
import Cardano.Ledger.CanonicalState.BasicTypes ()
import Cardano.Ledger.CanonicalState.LedgerCBOR (LedgerCBOR (..))
import Cardano.Ledger.CanonicalState.Namespace (NamespaceEra)
import Cardano.Ledger.Core
import Cardano.Ledger.Plutus.CostModels (
  CostModels,
  flattenCostModels,
  mkCostModelsLenient,
 )
import Cardano.Ledger.Plutus.ExUnits (Prices (..))
import Cardano.Ledger.Plutus.Language (Language (..))
import Cardano.SCLS.CBOR.Canonical.Decoder (FromCanonicalCBOR (..))
import Cardano.SCLS.CBOR.Canonical.Encoder (ToCanonicalCBOR (..))
import Cardano.SCLS.Entry.IsKey (IsKey (..))
import Cardano.SCLS.NamespaceCodec (
  CanonicalCBOREntryDecoder (..),
  CanonicalCBOREntryEncoder (..),
  KnownNamespace (..),
  NamespaceKeySize,
  namespaceKeySize,
 )
import Cardano.SCLS.Versioned (Versioned (..))
import Data.ByteString (ByteString)
import Data.Map (Map)
import Data.MapExtras (boundedEnumMap, lookupMapFail)
import Data.MemPack (packByteStringM, unpackByteStringM)
import Data.Proxy (Proxy (..))
import GHC.Generics (Generic)

data GovPParamsIn
  = GovPParamsInPrev
  | GovPParamsInCurr
  | GovPParamsInPossibleFuture
  | GovPParamsInDefiniteFuture
  deriving (GovPParamsIn -> GovPParamsIn -> Bool
(GovPParamsIn -> GovPParamsIn -> Bool)
-> (GovPParamsIn -> GovPParamsIn -> Bool) -> Eq GovPParamsIn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GovPParamsIn -> GovPParamsIn -> Bool
== :: GovPParamsIn -> GovPParamsIn -> Bool
$c/= :: GovPParamsIn -> GovPParamsIn -> Bool
/= :: GovPParamsIn -> GovPParamsIn -> Bool
Eq, Eq GovPParamsIn
Eq GovPParamsIn =>
(GovPParamsIn -> GovPParamsIn -> Ordering)
-> (GovPParamsIn -> GovPParamsIn -> Bool)
-> (GovPParamsIn -> GovPParamsIn -> Bool)
-> (GovPParamsIn -> GovPParamsIn -> Bool)
-> (GovPParamsIn -> GovPParamsIn -> Bool)
-> (GovPParamsIn -> GovPParamsIn -> GovPParamsIn)
-> (GovPParamsIn -> GovPParamsIn -> GovPParamsIn)
-> Ord GovPParamsIn
GovPParamsIn -> GovPParamsIn -> Bool
GovPParamsIn -> GovPParamsIn -> Ordering
GovPParamsIn -> GovPParamsIn -> GovPParamsIn
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 :: GovPParamsIn -> GovPParamsIn -> Ordering
compare :: GovPParamsIn -> GovPParamsIn -> Ordering
$c< :: GovPParamsIn -> GovPParamsIn -> Bool
< :: GovPParamsIn -> GovPParamsIn -> Bool
$c<= :: GovPParamsIn -> GovPParamsIn -> Bool
<= :: GovPParamsIn -> GovPParamsIn -> Bool
$c> :: GovPParamsIn -> GovPParamsIn -> Bool
> :: GovPParamsIn -> GovPParamsIn -> Bool
$c>= :: GovPParamsIn -> GovPParamsIn -> Bool
>= :: GovPParamsIn -> GovPParamsIn -> Bool
$cmax :: GovPParamsIn -> GovPParamsIn -> GovPParamsIn
max :: GovPParamsIn -> GovPParamsIn -> GovPParamsIn
$cmin :: GovPParamsIn -> GovPParamsIn -> GovPParamsIn
min :: GovPParamsIn -> GovPParamsIn -> GovPParamsIn
Ord, Int -> GovPParamsIn -> ShowS
[GovPParamsIn] -> ShowS
GovPParamsIn -> String
(Int -> GovPParamsIn -> ShowS)
-> (GovPParamsIn -> String)
-> ([GovPParamsIn] -> ShowS)
-> Show GovPParamsIn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GovPParamsIn -> ShowS
showsPrec :: Int -> GovPParamsIn -> ShowS
$cshow :: GovPParamsIn -> String
show :: GovPParamsIn -> String
$cshowList :: [GovPParamsIn] -> ShowS
showList :: [GovPParamsIn] -> ShowS
Show, Int -> GovPParamsIn
GovPParamsIn -> Int
GovPParamsIn -> [GovPParamsIn]
GovPParamsIn -> GovPParamsIn
GovPParamsIn -> GovPParamsIn -> [GovPParamsIn]
GovPParamsIn -> GovPParamsIn -> GovPParamsIn -> [GovPParamsIn]
(GovPParamsIn -> GovPParamsIn)
-> (GovPParamsIn -> GovPParamsIn)
-> (Int -> GovPParamsIn)
-> (GovPParamsIn -> Int)
-> (GovPParamsIn -> [GovPParamsIn])
-> (GovPParamsIn -> GovPParamsIn -> [GovPParamsIn])
-> (GovPParamsIn -> GovPParamsIn -> [GovPParamsIn])
-> (GovPParamsIn -> GovPParamsIn -> GovPParamsIn -> [GovPParamsIn])
-> Enum GovPParamsIn
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 :: GovPParamsIn -> GovPParamsIn
succ :: GovPParamsIn -> GovPParamsIn
$cpred :: GovPParamsIn -> GovPParamsIn
pred :: GovPParamsIn -> GovPParamsIn
$ctoEnum :: Int -> GovPParamsIn
toEnum :: Int -> GovPParamsIn
$cfromEnum :: GovPParamsIn -> Int
fromEnum :: GovPParamsIn -> Int
$cenumFrom :: GovPParamsIn -> [GovPParamsIn]
enumFrom :: GovPParamsIn -> [GovPParamsIn]
$cenumFromThen :: GovPParamsIn -> GovPParamsIn -> [GovPParamsIn]
enumFromThen :: GovPParamsIn -> GovPParamsIn -> [GovPParamsIn]
$cenumFromTo :: GovPParamsIn -> GovPParamsIn -> [GovPParamsIn]
enumFromTo :: GovPParamsIn -> GovPParamsIn -> [GovPParamsIn]
$cenumFromThenTo :: GovPParamsIn -> GovPParamsIn -> GovPParamsIn -> [GovPParamsIn]
enumFromThenTo :: GovPParamsIn -> GovPParamsIn -> GovPParamsIn -> [GovPParamsIn]
Enum, GovPParamsIn
GovPParamsIn -> GovPParamsIn -> Bounded GovPParamsIn
forall a. a -> a -> Bounded a
$cminBound :: GovPParamsIn
minBound :: GovPParamsIn
$cmaxBound :: GovPParamsIn
maxBound :: GovPParamsIn
Bounded, (forall x. GovPParamsIn -> Rep GovPParamsIn x)
-> (forall x. Rep GovPParamsIn x -> GovPParamsIn)
-> Generic GovPParamsIn
forall x. Rep GovPParamsIn x -> GovPParamsIn
forall x. GovPParamsIn -> Rep GovPParamsIn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GovPParamsIn -> Rep GovPParamsIn x
from :: forall x. GovPParamsIn -> Rep GovPParamsIn x
$cto :: forall x. Rep GovPParamsIn x -> GovPParamsIn
to :: forall x. Rep GovPParamsIn x -> GovPParamsIn
Generic)

keyGovPParamsIn :: GovPParamsIn -> ByteString
keyGovPParamsIn :: GovPParamsIn -> ByteString
keyGovPParamsIn = \case
  GovPParamsIn
GovPParamsInPrev -> ByteString
"prev"
  GovPParamsIn
GovPParamsInCurr -> ByteString
"curr"
  GovPParamsIn
GovPParamsInPossibleFuture -> ByteString
"pfut"
  GovPParamsIn
GovPParamsInDefiniteFuture -> ByteString
"dfut"

mapGovPParamsIn :: Map ByteString GovPParamsIn
mapGovPParamsIn :: Map ByteString GovPParamsIn
mapGovPParamsIn = (GovPParamsIn -> ByteString) -> Map ByteString GovPParamsIn
forall k a. (Ord k, Bounded a, Enum a) => (a -> k) -> Map k a
boundedEnumMap GovPParamsIn -> ByteString
keyGovPParamsIn

instance IsKey GovPParamsIn where
  keySize :: Int
keySize = forall (ns :: Symbol). KnownNat (NamespaceKeySize ns) => Int
namespaceKeySize @"gov/pparams/v0"
  packKeyM :: forall b. GovPParamsIn -> Pack b ()
packKeyM = ByteString -> Pack b ()
forall s. ByteString -> Pack s ()
packByteStringM (ByteString -> Pack b ())
-> (GovPParamsIn -> ByteString) -> GovPParamsIn -> Pack b ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovPParamsIn -> ByteString
keyGovPParamsIn
  unpackKeyM :: forall b s. Buffer b => Unpack' s b GovPParamsIn
unpackKeyM = do
    tag :: ByteString <- Int -> Unpack s b ByteString
forall b s. Buffer b => Int -> Unpack s b ByteString
unpackByteStringM Int
4
    lookupMapFail "GovPParamsIn tag" mapGovPParamsIn tag

instance ToCanonicalCBOR v CostModels where
  toCanonicalCBOR :: forall (proxy :: Symbol -> *).
proxy v -> CostModels -> CanonicalEncoding
toCanonicalCBOR proxy v
v = proxy v -> Map Word8 [Int64] -> CanonicalEncoding
forall (v :: Symbol) a (proxy :: Symbol -> *).
ToCanonicalCBOR v a =>
proxy v -> a -> CanonicalEncoding
forall (proxy :: Symbol -> *).
proxy v -> Map Word8 [Int64] -> CanonicalEncoding
toCanonicalCBOR proxy v
v (Map Word8 [Int64] -> CanonicalEncoding)
-> (CostModels -> Map Word8 [Int64])
-> CostModels
-> CanonicalEncoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CostModels -> Map Word8 [Int64]
flattenCostModels

instance FromCanonicalCBOR v CostModels where
  fromCanonicalCBOR :: forall s. CanonicalDecoder s (Versioned v CostModels)
fromCanonicalCBOR = do
    Versioned flattened <- CanonicalDecoder s (Versioned (ZonkAny 0) (Map Word8 [Int64]))
forall s.
CanonicalDecoder s (Versioned (ZonkAny 0) (Map Word8 [Int64]))
forall (v :: Symbol) a s.
FromCanonicalCBOR v a =>
CanonicalDecoder s (Versioned v a)
fromCanonicalCBOR
    Versioned <$> mkCostModelsLenient flattened

data CanonicalPrices = CanonicalPrices
  { CanonicalPrices -> NonNegativeInterval
prMem :: !NonNegativeInterval
  , CanonicalPrices -> NonNegativeInterval
prSteps :: !NonNegativeInterval
  }
  deriving (CanonicalPrices -> CanonicalPrices -> Bool
(CanonicalPrices -> CanonicalPrices -> Bool)
-> (CanonicalPrices -> CanonicalPrices -> Bool)
-> Eq CanonicalPrices
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CanonicalPrices -> CanonicalPrices -> Bool
== :: CanonicalPrices -> CanonicalPrices -> Bool
$c/= :: CanonicalPrices -> CanonicalPrices -> Bool
/= :: CanonicalPrices -> CanonicalPrices -> Bool
Eq, Int -> CanonicalPrices -> ShowS
[CanonicalPrices] -> ShowS
CanonicalPrices -> String
(Int -> CanonicalPrices -> ShowS)
-> (CanonicalPrices -> String)
-> ([CanonicalPrices] -> ShowS)
-> Show CanonicalPrices
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CanonicalPrices -> ShowS
showsPrec :: Int -> CanonicalPrices -> ShowS
$cshow :: CanonicalPrices -> String
show :: CanonicalPrices -> String
$cshowList :: [CanonicalPrices] -> ShowS
showList :: [CanonicalPrices] -> ShowS
Show, (forall x. CanonicalPrices -> Rep CanonicalPrices x)
-> (forall x. Rep CanonicalPrices x -> CanonicalPrices)
-> Generic CanonicalPrices
forall x. Rep CanonicalPrices x -> CanonicalPrices
forall x. CanonicalPrices -> Rep CanonicalPrices x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CanonicalPrices -> Rep CanonicalPrices x
from :: forall x. CanonicalPrices -> Rep CanonicalPrices x
$cto :: forall x. Rep CanonicalPrices x -> CanonicalPrices
to :: forall x. Rep CanonicalPrices x -> CanonicalPrices
Generic)

mkCanonicalPrices :: Prices -> CanonicalPrices
mkCanonicalPrices :: Prices -> CanonicalPrices
mkCanonicalPrices Prices {NonNegativeInterval
prMem :: NonNegativeInterval
prSteps :: NonNegativeInterval
prSteps :: Prices -> NonNegativeInterval
prMem :: Prices -> NonNegativeInterval
..} = CanonicalPrices {NonNegativeInterval
prMem :: NonNegativeInterval
prSteps :: NonNegativeInterval
prMem :: NonNegativeInterval
prSteps :: NonNegativeInterval
..}

fromCanonicalPrices :: CanonicalPrices -> Prices
fromCanonicalPrices :: CanonicalPrices -> Prices
fromCanonicalPrices CanonicalPrices {NonNegativeInterval
prMem :: CanonicalPrices -> NonNegativeInterval
prSteps :: CanonicalPrices -> NonNegativeInterval
prMem :: NonNegativeInterval
prSteps :: NonNegativeInterval
..} = Prices {NonNegativeInterval
prSteps :: NonNegativeInterval
prMem :: NonNegativeInterval
prMem :: NonNegativeInterval
prSteps :: NonNegativeInterval
..}

instance (NamespaceEra v ~ era, Era era) => ToCanonicalCBOR v CanonicalPrices where
  toCanonicalCBOR :: forall (proxy :: Symbol -> *).
proxy v -> CanonicalPrices -> CanonicalEncoding
toCanonicalCBOR proxy v
v CanonicalPrices {NonNegativeInterval
prMem :: CanonicalPrices -> NonNegativeInterval
prSteps :: CanonicalPrices -> NonNegativeInterval
prMem :: NonNegativeInterval
prSteps :: NonNegativeInterval
..} = proxy v
-> (NonNegativeInterval, NonNegativeInterval) -> CanonicalEncoding
forall (v :: Symbol) a (proxy :: Symbol -> *).
ToCanonicalCBOR v a =>
proxy v -> a -> CanonicalEncoding
forall (proxy :: Symbol -> *).
proxy v
-> (NonNegativeInterval, NonNegativeInterval) -> CanonicalEncoding
toCanonicalCBOR proxy v
v (NonNegativeInterval
prMem, NonNegativeInterval
prSteps)

instance (NamespaceEra v ~ era, Era era) => FromCanonicalCBOR v CanonicalPrices where
  fromCanonicalCBOR :: forall s. CanonicalDecoder s (Versioned v CanonicalPrices)
fromCanonicalCBOR = do
    Versioned (prMem, prSteps) <- forall (v :: Symbol) a s.
FromCanonicalCBOR v a =>
CanonicalDecoder s (Versioned v a)
fromCanonicalCBOR @v
    return $ Versioned CanonicalPrices {..}

deriving via
  LedgerCBOR v Language
  instance
    (Era era, NamespaceEra v ~ era) => FromCanonicalCBOR v Language

deriving via
  LedgerCBOR v Language
  instance
    (Era era, NamespaceEra v ~ era) => ToCanonicalCBOR v Language

newtype GovPParamsOut era = GovPParamsOut (PParams era)
  deriving ((forall x. GovPParamsOut era -> Rep (GovPParamsOut era) x)
-> (forall x. Rep (GovPParamsOut era) x -> GovPParamsOut era)
-> Generic (GovPParamsOut era)
forall x. Rep (GovPParamsOut era) x -> GovPParamsOut era
forall x. GovPParamsOut era -> Rep (GovPParamsOut era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (GovPParamsOut era) x -> GovPParamsOut era
forall era x. GovPParamsOut era -> Rep (GovPParamsOut era) x
$cfrom :: forall era x. GovPParamsOut era -> Rep (GovPParamsOut era) x
from :: forall x. GovPParamsOut era -> Rep (GovPParamsOut era) x
$cto :: forall era x. Rep (GovPParamsOut era) x -> GovPParamsOut era
to :: forall x. Rep (GovPParamsOut era) x -> GovPParamsOut era
Generic)

deriving instance Eq (PParams era) => Eq (GovPParamsOut era)

deriving instance Show (PParams era) => Show (GovPParamsOut era)

deriving newtype instance
  ToCanonicalCBOR "gov/pparams/v0" (PParams era) =>
  ToCanonicalCBOR "gov/pparams/v0" (GovPParamsOut era)

deriving newtype instance
  FromCanonicalCBOR "gov/pparams/v0" (PParams era) =>
  FromCanonicalCBOR "gov/pparams/v0" (GovPParamsOut era)

type instance NamespaceKeySize "gov/pparams/v0" = 4

instance
  ( NamespaceEra "gov/pparams/v0" ~ era
  , Era era
  , FromCanonicalCBOR "gov/pparams/v0" (PParams era)
  , ToCanonicalCBOR "gov/pparams/v0" (PParams era)
  ) =>
  KnownNamespace "gov/pparams/v0"
  where
  type NamespaceKey "gov/pparams/v0" = GovPParamsIn
  type NamespaceEntry "gov/pparams/v0" = GovPParamsOut (NamespaceEra "gov/pparams/v0")

instance
  (NamespaceEra "gov/pparams/v0" ~ era, Era era, ToCanonicalCBOR "gov/pparams/v0" (PParams era)) =>
  CanonicalCBOREntryEncoder "gov/pparams/v0" (GovPParamsOut era)
  where
  encodeEntry :: GovPParamsOut era -> CanonicalEncoding
encodeEntry (GovPParamsOut PParams era
n) = Proxy "gov/pparams/v0" -> PParams era -> CanonicalEncoding
forall (v :: Symbol) a (proxy :: Symbol -> *).
ToCanonicalCBOR v a =>
proxy v -> a -> CanonicalEncoding
forall (proxy :: Symbol -> *).
proxy "gov/pparams/v0" -> PParams era -> CanonicalEncoding
toCanonicalCBOR (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @"gov/pparams/v0") PParams era
n

instance
  (NamespaceEra "gov/pparams/v0" ~ era, Era era, FromCanonicalCBOR "gov/pparams/v0" (PParams era)) =>
  CanonicalCBOREntryDecoder "gov/pparams/v0" (GovPParamsOut era)
  where
  decodeEntry :: forall s.
CanonicalDecoder s (Versioned "gov/pparams/v0" (GovPParamsOut era))
decodeEntry = (PParams era -> GovPParamsOut era)
-> Versioned "gov/pparams/v0" (PParams era)
-> Versioned "gov/pparams/v0" (GovPParamsOut era)
forall a b.
(a -> b)
-> Versioned "gov/pparams/v0" a -> Versioned "gov/pparams/v0" b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PParams era -> GovPParamsOut era
forall era. PParams era -> GovPParamsOut era
GovPParamsOut (Versioned "gov/pparams/v0" (PParams era)
 -> Versioned "gov/pparams/v0" (GovPParamsOut era))
-> CanonicalDecoder s (Versioned "gov/pparams/v0" (PParams era))
-> CanonicalDecoder
     s (Versioned "gov/pparams/v0" (GovPParamsOut era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CanonicalDecoder s (Versioned "gov/pparams/v0" (PParams era))
forall s.
CanonicalDecoder s (Versioned "gov/pparams/v0" (PParams era))
forall (v :: Symbol) a s.
FromCanonicalCBOR v a =>
CanonicalDecoder s (Versioned v a)
fromCanonicalCBOR