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

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

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.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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FromByronTranslationContext -> FromByronTranslationContext -> Bool
$c/= :: FromByronTranslationContext -> FromByronTranslationContext -> Bool
== :: FromByronTranslationContext -> FromByronTranslationContext -> Bool
$c== :: FromByronTranslationContext -> FromByronTranslationContext -> Bool
Eq, Int -> FromByronTranslationContext -> ShowS
[FromByronTranslationContext] -> ShowS
FromByronTranslationContext -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FromByronTranslationContext] -> ShowS
$cshowList :: [FromByronTranslationContext] -> ShowS
show :: FromByronTranslationContext -> String
$cshow :: FromByronTranslationContext -> String
showsPrec :: Int -> FromByronTranslationContext -> ShowS
$cshowsPrec :: Int -> FromByronTranslationContext -> ShowS
Show, 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
$cto :: forall x.
Rep FromByronTranslationContext x -> FromByronTranslationContext
$cfrom :: forall x.
FromByronTranslationContext -> Rep FromByronTranslationContext x
Generic)

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
fbtcMaxLovelaceSupply :: Word64
fbtcProtocolParams :: PParams ShelleyEra
fbtcGenDelegs :: Map (KeyHash 'Genesis) GenDelegPair
fbtcMaxLovelaceSupply :: FromByronTranslationContext -> Word64
fbtcProtocolParams :: FromByronTranslationContext -> PParams ShelleyEra
fbtcGenDelegs :: FromByronTranslationContext -> Map (KeyHash 'Genesis) GenDelegPair
..} = FromByronTranslationContext
x
     in Version -> Encoding -> Encoding
toPlainEncoding Version
shelleyProtVer forall a b. (a -> b) -> a -> b
$
          forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall a b. (a -> b) -> a -> b
$
            forall t. t -> Encode ('Closed 'Dense) t
Rec Map (KeyHash 'Genesis) GenDelegPair
-> PParams ShelleyEra -> Word64 -> FromByronTranslationContext
FromByronTranslationContext
              forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Map (KeyHash 'Genesis) GenDelegPair
fbtcGenDelegs
              forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To PParams ShelleyEra
fbtcProtocolParams
              forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Word64
fbtcMaxLovelaceSupply

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

instance EncCBOR FromByronTranslationContext

instance DecCBOR FromByronTranslationContext

-- | 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 = forall k a. Map k a
Map.empty
    , fbtcMaxLovelaceSupply :: Word64
fbtcMaxLovelaceSupply = Word64
0
    , fbtcProtocolParams :: PParams ShelleyEra
fbtcProtocolParams = forall era. EraPParams era => PParams era
emptyPParams
    }

toFromByronTranslationContext ::
  ShelleyGenesis ->
  FromByronTranslationContext
toFromByronTranslationContext :: ShelleyGenesis -> FromByronTranslationContext
toFromByronTranslationContext ShelleyGenesis {Map (KeyHash 'Genesis) GenDelegPair
sgGenDelegs :: ShelleyGenesis -> Map (KeyHash 'Genesis) GenDelegPair
sgGenDelegs :: Map (KeyHash 'Genesis) GenDelegPair
sgGenDelegs, Word64
sgMaxLovelaceSupply :: ShelleyGenesis -> Word64
sgMaxLovelaceSupply :: Word64
sgMaxLovelaceSupply, PParams ShelleyEra
sgProtocolParams :: ShelleyGenesis -> PParams ShelleyEra
sgProtocolParams :: 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