{-# 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
(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)

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

-- | 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