{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Shelley.Translation (
  FromByronTranslationContext (..),
  emptyFromByronTranslationContext,
  toFromByronTranslationContext,
) where

import Cardano.Ledger.BaseTypes (KeyValuePairs (..), ToKeyValuePairs (..))
import Cardano.Ledger.Binary (
  DecCBOR (..),
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
  shelleyProtVer,
  toPlainDecoder,
  toPlainEncoding,
 )
import Cardano.Ledger.Binary.Coders (Decode (..), Encode (..), decode, encode, (!>), (<!))
import Cardano.Ledger.Core (PParams, TranslationContext, emptyPParams)
import Cardano.Ledger.Keys
import Cardano.Ledger.Shelley.Era (ShelleyEra)
import Cardano.Ledger.Shelley.Genesis (ShelleyGenesis (..))
import Data.Aeson (FromJSON (..), ToJSON (..), withObject, (.:), (.=))
import Data.Map (Map)
import qualified Data.Map as Map
import GHC.Generics (Generic)
import GHC.Word (Word64)
import NoThunks.Class (NoThunks (..))

-- | Required data to translate a Byron ledger into a Shelley ledger.
data FromByronTranslationContext = FromByronTranslationContext
  { FromByronTranslationContext -> Map (KeyHash 'Genesis) GenDelegPair
fbtcGenDelegs :: !(Map (KeyHash 'Genesis) GenDelegPair)
  , FromByronTranslationContext -> PParams ShelleyEra
fbtcProtocolParams :: !(PParams ShelleyEra)
  , FromByronTranslationContext -> Word64
fbtcMaxLovelaceSupply :: !Word64
  }
  deriving (FromByronTranslationContext -> FromByronTranslationContext -> Bool
(FromByronTranslationContext
 -> FromByronTranslationContext -> Bool)
-> (FromByronTranslationContext
    -> FromByronTranslationContext -> Bool)
-> Eq FromByronTranslationContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FromByronTranslationContext -> FromByronTranslationContext -> Bool
== :: FromByronTranslationContext -> FromByronTranslationContext -> Bool
$c/= :: FromByronTranslationContext -> FromByronTranslationContext -> Bool
/= :: FromByronTranslationContext -> FromByronTranslationContext -> Bool
Eq, Int -> FromByronTranslationContext -> ShowS
[FromByronTranslationContext] -> ShowS
FromByronTranslationContext -> String
(Int -> FromByronTranslationContext -> ShowS)
-> (FromByronTranslationContext -> String)
-> ([FromByronTranslationContext] -> ShowS)
-> Show FromByronTranslationContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FromByronTranslationContext -> ShowS
showsPrec :: Int -> FromByronTranslationContext -> ShowS
$cshow :: FromByronTranslationContext -> String
show :: FromByronTranslationContext -> String
$cshowList :: [FromByronTranslationContext] -> ShowS
showList :: [FromByronTranslationContext] -> ShowS
Show, (forall x.
 FromByronTranslationContext -> Rep FromByronTranslationContext x)
-> (forall x.
    Rep FromByronTranslationContext x -> FromByronTranslationContext)
-> Generic FromByronTranslationContext
forall x.
Rep FromByronTranslationContext x -> FromByronTranslationContext
forall x.
FromByronTranslationContext -> Rep FromByronTranslationContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
FromByronTranslationContext -> Rep FromByronTranslationContext x
from :: forall x.
FromByronTranslationContext -> Rep FromByronTranslationContext x
$cto :: forall x.
Rep FromByronTranslationContext x -> FromByronTranslationContext
to :: forall x.
Rep FromByronTranslationContext x -> FromByronTranslationContext
Generic)
  deriving ([FromByronTranslationContext] -> Value
[FromByronTranslationContext] -> Encoding
FromByronTranslationContext -> Bool
FromByronTranslationContext -> Value
FromByronTranslationContext -> Encoding
(FromByronTranslationContext -> Value)
-> (FromByronTranslationContext -> Encoding)
-> ([FromByronTranslationContext] -> Value)
-> ([FromByronTranslationContext] -> Encoding)
-> (FromByronTranslationContext -> Bool)
-> ToJSON FromByronTranslationContext
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: FromByronTranslationContext -> Value
toJSON :: FromByronTranslationContext -> Value
$ctoEncoding :: FromByronTranslationContext -> Encoding
toEncoding :: FromByronTranslationContext -> Encoding
$ctoJSONList :: [FromByronTranslationContext] -> Value
toJSONList :: [FromByronTranslationContext] -> Value
$ctoEncodingList :: [FromByronTranslationContext] -> Encoding
toEncodingList :: [FromByronTranslationContext] -> Encoding
$comitField :: FromByronTranslationContext -> Bool
omitField :: FromByronTranslationContext -> Bool
ToJSON) via KeyValuePairs FromByronTranslationContext

instance ToCBOR FromByronTranslationContext where
  toCBOR :: FromByronTranslationContext -> Encoding
toCBOR x :: FromByronTranslationContext
x@(FromByronTranslationContext Map (KeyHash 'Genesis) GenDelegPair
_ PParams ShelleyEra
_ Word64
_) =
    let FromByronTranslationContext {Word64
Map (KeyHash 'Genesis) GenDelegPair
PParams ShelleyEra
fbtcGenDelegs :: FromByronTranslationContext -> Map (KeyHash 'Genesis) GenDelegPair
fbtcProtocolParams :: FromByronTranslationContext -> PParams ShelleyEra
fbtcMaxLovelaceSupply :: FromByronTranslationContext -> Word64
fbtcGenDelegs :: Map (KeyHash 'Genesis) GenDelegPair
fbtcProtocolParams :: PParams ShelleyEra
fbtcMaxLovelaceSupply :: Word64
..} = FromByronTranslationContext
x
     in Version -> Encoding -> Encoding
toPlainEncoding Version
shelleyProtVer (Encoding -> Encoding) -> Encoding -> Encoding
forall a b. (a -> b) -> a -> b
$
          Encode ('Closed 'Dense) FromByronTranslationContext -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) FromByronTranslationContext -> Encoding)
-> Encode ('Closed 'Dense) FromByronTranslationContext -> Encoding
forall a b. (a -> b) -> a -> b
$
            (Map (KeyHash 'Genesis) GenDelegPair
 -> PParams ShelleyEra -> Word64 -> FromByronTranslationContext)
-> Encode
     ('Closed 'Dense)
     (Map (KeyHash 'Genesis) GenDelegPair
      -> PParams ShelleyEra -> Word64 -> FromByronTranslationContext)
forall t. t -> Encode ('Closed 'Dense) t
Rec Map (KeyHash 'Genesis) GenDelegPair
-> PParams ShelleyEra -> Word64 -> FromByronTranslationContext
FromByronTranslationContext
              Encode
  ('Closed 'Dense)
  (Map (KeyHash 'Genesis) GenDelegPair
   -> PParams ShelleyEra -> Word64 -> FromByronTranslationContext)
-> Encode ('Closed 'Dense) (Map (KeyHash 'Genesis) GenDelegPair)
-> Encode
     ('Closed 'Dense)
     (PParams ShelleyEra -> Word64 -> FromByronTranslationContext)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Map (KeyHash 'Genesis) GenDelegPair
-> Encode ('Closed 'Dense) (Map (KeyHash 'Genesis) GenDelegPair)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Map (KeyHash 'Genesis) GenDelegPair
fbtcGenDelegs
              Encode
  ('Closed 'Dense)
  (PParams ShelleyEra -> Word64 -> FromByronTranslationContext)
-> Encode ('Closed 'Dense) (PParams ShelleyEra)
-> Encode ('Closed 'Dense) (Word64 -> FromByronTranslationContext)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> PParams ShelleyEra -> Encode ('Closed 'Dense) (PParams ShelleyEra)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To PParams ShelleyEra
fbtcProtocolParams
              Encode ('Closed 'Dense) (Word64 -> FromByronTranslationContext)
-> Encode ('Closed 'Dense) Word64
-> Encode ('Closed 'Dense) FromByronTranslationContext
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word64 -> Encode ('Closed 'Dense) Word64
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Word64
fbtcMaxLovelaceSupply

instance FromCBOR FromByronTranslationContext where
  fromCBOR :: forall s. Decoder s FromByronTranslationContext
fromCBOR =
    Maybe ByteString
-> Version
-> Decoder s FromByronTranslationContext
-> Decoder s FromByronTranslationContext
forall s a.
Maybe ByteString -> Version -> Decoder s a -> Decoder s a
toPlainDecoder Maybe ByteString
forall a. Maybe a
Nothing Version
shelleyProtVer (Decoder s FromByronTranslationContext
 -> Decoder s FromByronTranslationContext)
-> Decoder s FromByronTranslationContext
-> Decoder s FromByronTranslationContext
forall a b. (a -> b) -> a -> b
$
      Decode ('Closed 'Dense) FromByronTranslationContext
-> Decoder s FromByronTranslationContext
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) FromByronTranslationContext
 -> Decoder s FromByronTranslationContext)
-> Decode ('Closed 'Dense) FromByronTranslationContext
-> Decoder s FromByronTranslationContext
forall a b. (a -> b) -> a -> b
$
        (Map (KeyHash 'Genesis) GenDelegPair
 -> PParams ShelleyEra -> Word64 -> FromByronTranslationContext)
-> Decode
     ('Closed 'Dense)
     (Map (KeyHash 'Genesis) GenDelegPair
      -> PParams ShelleyEra -> Word64 -> FromByronTranslationContext)
forall t. t -> Decode ('Closed 'Dense) t
RecD Map (KeyHash 'Genesis) GenDelegPair
-> PParams ShelleyEra -> Word64 -> FromByronTranslationContext
FromByronTranslationContext
          Decode
  ('Closed 'Dense)
  (Map (KeyHash 'Genesis) GenDelegPair
   -> PParams ShelleyEra -> Word64 -> FromByronTranslationContext)
-> Decode ('Closed Any) (Map (KeyHash 'Genesis) GenDelegPair)
-> Decode
     ('Closed 'Dense)
     (PParams ShelleyEra -> Word64 -> FromByronTranslationContext)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Map (KeyHash 'Genesis) GenDelegPair)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
          Decode
  ('Closed 'Dense)
  (PParams ShelleyEra -> Word64 -> FromByronTranslationContext)
-> Decode ('Closed Any) (PParams ShelleyEra)
-> Decode ('Closed 'Dense) (Word64 -> FromByronTranslationContext)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (PParams ShelleyEra)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
          Decode ('Closed 'Dense) (Word64 -> FromByronTranslationContext)
-> Decode ('Closed Any) Word64
-> Decode ('Closed 'Dense) FromByronTranslationContext
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Word64
forall t (w :: Wrapped). DecCBOR t => Decode w t
From

instance EncCBOR FromByronTranslationContext

instance DecCBOR FromByronTranslationContext

instance FromJSON FromByronTranslationContext where
  parseJSON :: Value -> Parser FromByronTranslationContext
parseJSON = String
-> (Object -> Parser FromByronTranslationContext)
-> Value
-> Parser FromByronTranslationContext
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"FromByronTranslationContext" ((Object -> Parser FromByronTranslationContext)
 -> Value -> Parser FromByronTranslationContext)
-> (Object -> Parser FromByronTranslationContext)
-> Value
-> Parser FromByronTranslationContext
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Map (KeyHash 'Genesis) GenDelegPair
fbtcGenDelegs <- Object
o Object -> Key -> Parser (Map (KeyHash 'Genesis) GenDelegPair)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"genDelegs"
    PParams ShelleyEra
fbtcProtocolParams <- Object
o Object -> Key -> Parser (PParams ShelleyEra)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"protocolParams"
    Word64
fbtcMaxLovelaceSupply <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"maxLovelaceSupply"
    FromByronTranslationContext -> Parser FromByronTranslationContext
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FromByronTranslationContext {Word64
Map (KeyHash 'Genesis) GenDelegPair
PParams ShelleyEra
fbtcGenDelegs :: Map (KeyHash 'Genesis) GenDelegPair
fbtcProtocolParams :: PParams ShelleyEra
fbtcMaxLovelaceSupply :: Word64
fbtcGenDelegs :: Map (KeyHash 'Genesis) GenDelegPair
fbtcProtocolParams :: PParams ShelleyEra
fbtcMaxLovelaceSupply :: Word64
..}

instance ToKeyValuePairs FromByronTranslationContext where
  toKeyValuePairs :: forall e kv. KeyValue e kv => FromByronTranslationContext -> [kv]
toKeyValuePairs fbtc :: FromByronTranslationContext
fbtc@(FromByronTranslationContext Map (KeyHash 'Genesis) GenDelegPair
_ PParams ShelleyEra
_ Word64
_) =
    let FromByronTranslationContext {Word64
Map (KeyHash 'Genesis) GenDelegPair
PParams ShelleyEra
fbtcGenDelegs :: FromByronTranslationContext -> Map (KeyHash 'Genesis) GenDelegPair
fbtcProtocolParams :: FromByronTranslationContext -> PParams ShelleyEra
fbtcMaxLovelaceSupply :: FromByronTranslationContext -> Word64
fbtcGenDelegs :: Map (KeyHash 'Genesis) GenDelegPair
fbtcProtocolParams :: PParams ShelleyEra
fbtcMaxLovelaceSupply :: Word64
..} = FromByronTranslationContext
fbtc
     in [ Key
"genDelegs" Key -> Map (KeyHash 'Genesis) GenDelegPair -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (KeyHash 'Genesis) GenDelegPair
fbtcGenDelegs
        , Key
"protocolParams" Key -> PParams ShelleyEra -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PParams ShelleyEra
fbtcProtocolParams
        , Key
"maxLovelaceSupply" Key -> Word64 -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64
fbtcMaxLovelaceSupply
        ]

-- | Trivial FromByronTranslationContext value, for use in cases where we do not need
-- to translate from Byron to Shelley.
emptyFromByronTranslationContext :: FromByronTranslationContext
emptyFromByronTranslationContext :: FromByronTranslationContext
emptyFromByronTranslationContext =
  FromByronTranslationContext
    { fbtcGenDelegs :: Map (KeyHash 'Genesis) GenDelegPair
fbtcGenDelegs = Map (KeyHash 'Genesis) GenDelegPair
forall k a. Map k a
Map.empty
    , fbtcMaxLovelaceSupply :: Word64
fbtcMaxLovelaceSupply = Word64
0
    , fbtcProtocolParams :: PParams ShelleyEra
fbtcProtocolParams = PParams ShelleyEra
forall era. EraPParams era => PParams era
emptyPParams
    }

toFromByronTranslationContext ::
  ShelleyGenesis ->
  FromByronTranslationContext
toFromByronTranslationContext :: ShelleyGenesis -> FromByronTranslationContext
toFromByronTranslationContext ShelleyGenesis {Map (KeyHash 'Genesis) GenDelegPair
sgGenDelegs :: Map (KeyHash 'Genesis) GenDelegPair
sgGenDelegs :: ShelleyGenesis -> Map (KeyHash 'Genesis) GenDelegPair
sgGenDelegs, Word64
sgMaxLovelaceSupply :: Word64
sgMaxLovelaceSupply :: ShelleyGenesis -> Word64
sgMaxLovelaceSupply, PParams ShelleyEra
sgProtocolParams :: PParams ShelleyEra
sgProtocolParams :: ShelleyGenesis -> PParams ShelleyEra
sgProtocolParams} =
  FromByronTranslationContext
    { fbtcGenDelegs :: Map (KeyHash 'Genesis) GenDelegPair
fbtcGenDelegs = Map (KeyHash 'Genesis) GenDelegPair
sgGenDelegs
    , fbtcProtocolParams :: PParams ShelleyEra
fbtcProtocolParams = PParams ShelleyEra
sgProtocolParams
    , fbtcMaxLovelaceSupply :: Word64
fbtcMaxLovelaceSupply = Word64
sgMaxLovelaceSupply
    }

instance NoThunks FromByronTranslationContext

type instance TranslationContext ShelleyEra = FromByronTranslationContext