{-# LANGUAGE LambdaCase #-}

-- | Conversion of the node's hard-fork era summary to the UTxO RPC
-- 'U5c.EraSummaries' message.
module Cardano.Rpc.Server.Internal.UtxoRpc.Type.EraSummary
  ( eraSummariesToProto
  )
where

import Cardano.Api (AnyCardanoEra (..), SystemStart, docToText, pretty, unEpochNo, unSlotNo)
import Cardano.Api.Consensus qualified as Consensus
import Cardano.Rpc.Proto.Api.UtxoRpc.Query qualified as U5c
import Cardano.Rpc.Server.Internal.UtxoRpc.Type.ChainPoint (utcTimeToMs)

import Cardano.Slotting.Time (fromRelativeTime)
import Ouroboros.Consensus.Cardano.Block (CardanoEras)
import Ouroboros.Consensus.HardFork.History qualified as History

import RIO

import Data.ProtoLens (defMessage)
import Data.SOP.NonEmpty (nonEmptyToList)
import Data.Text qualified as Text
import Network.GRPC.Spec

-- | Convert the node's hard-fork era summary to the UTxO RPC
-- 'U5c.EraSummaries' message.
--
-- Every era except the last gets its 'U5c.maybe''end' populated from the
-- confirmed era transition. The last era's end is always left unset, even
-- when consensus already supplies a bound for it: consensus cannot
-- distinguish a confirmed transition from the safe-zone forecast horizon, so
-- the spec's "if the era has a well-defined ending" only ever holds for
-- non-final eras here. 'History.EraUnbounded' likewise maps to unset.
--
-- 'U5c.protocolParams' is left unset for every era: the node does not keep
-- historical per-era protocol parameters. Use @ReadParams@ for the current
-- era's parameters.
eraSummariesToProto
  :: SystemStart
  -> History.Summary (CardanoEras Consensus.StandardCrypto)
  -> Proto U5c.EraSummaries
eraSummariesToProto :: SystemStart
-> Summary (CardanoEras StandardCrypto) -> Proto EraSummaries
eraSummariesToProto SystemStart
systemStart Summary (CardanoEras StandardCrypto)
summary =
  Proto EraSummaries
forall msg. Message msg => msg
defMessage Proto EraSummaries
-> (Proto EraSummaries -> Proto EraSummaries) -> Proto EraSummaries
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto EraSummaries) [Proto EraSummary]
forall (f :: * -> *) s a.
(Functor f, HasField s "summaries" a) =>
LensLike' f s a
U5c.summaries LensLike' Identity (Proto EraSummaries) [Proto EraSummary]
-> [Proto EraSummary] -> Proto EraSummaries -> Proto EraSummaries
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Text -> Bool -> EraSummary -> Proto EraSummary)
-> [Text] -> [Bool] -> [EraSummary] -> [Proto EraSummary]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Text -> Bool -> EraSummary -> Proto EraSummary
mkEraSummary [Text]
eraNames [Bool]
isLastEra [EraSummary]
eraEntries
 where
  -- All eras in chronological order, i.e. the same order as the summary's
  -- entries: 'History.Summary' has no era name field, an entry's era is its
  -- position, so the names are zipped in positionally.
  eraNames :: [Text]
  eraNames :: [Text]
eraNames =
    [ Text -> Text
Text.toLower (Text -> Text) -> (Doc AnsiStyle -> Text) -> Doc AnsiStyle -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc AnsiStyle -> Text
docToText (Doc AnsiStyle -> Text) -> Doc AnsiStyle -> Text
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
forall ann. CardanoEra era -> Doc ann
pretty CardanoEra era
era
    | AnyCardanoEra CardanoEra era
era <- [AnyCardanoEra
forall a. Bounded a => a
minBound .. AnyCardanoEra
forall a. Bounded a => a
maxBound]
    ]

  eraEntries :: [History.EraSummary]
  eraEntries :: [EraSummary]
eraEntries = NonEmpty (CardanoEras StandardCrypto) EraSummary -> [EraSummary]
forall (xs :: [*]) a. NonEmpty xs a -> [a]
nonEmptyToList (Summary (CardanoEras StandardCrypto)
-> NonEmpty (CardanoEras StandardCrypto) EraSummary
forall (xs :: [*]). Summary xs -> NonEmpty xs EraSummary
History.getSummary Summary (CardanoEras StandardCrypto)
summary)

  -- 'eraEntries' is always non-empty ('Summary' wraps a non-empty list), so
  -- this always ends in exactly one 'True'.
  isLastEra :: [Bool]
  isLastEra :: [Bool]
isLastEra = Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate ([EraSummary] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [EraSummary]
eraEntries Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Bool
False [Bool] -> [Bool] -> [Bool]
forall a. Semigroup a => a -> a -> a
<> [Bool
True]

  mkEraSummary :: Text -> Bool -> History.EraSummary -> Proto U5c.EraSummary
  mkEraSummary :: Text -> Bool -> EraSummary -> Proto EraSummary
mkEraSummary Text
name Bool
isLast EraSummary
entry =
    Proto EraSummary
forall msg. Message msg => msg
defMessage
      Proto EraSummary
-> (Proto EraSummary -> Proto EraSummary) -> Proto EraSummary
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto EraSummary) Text
forall (f :: * -> *) s a.
(Functor f, HasField s "name" a) =>
LensLike' f s a
U5c.name LensLike' Identity (Proto EraSummary) Text
-> Text -> Proto EraSummary -> Proto EraSummary
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
name
      Proto EraSummary
-> (Proto EraSummary -> Proto EraSummary) -> Proto EraSummary
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto EraSummary) (Proto EraBoundary)
forall (f :: * -> *) s a.
(Functor f, HasField s "start" a) =>
LensLike' f s a
U5c.start LensLike' Identity (Proto EraSummary) (Proto EraBoundary)
-> Proto EraBoundary -> Proto EraSummary -> Proto EraSummary
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bound -> Proto EraBoundary
boundToProto (EraSummary -> Bound
History.eraStart EraSummary
entry)
      Proto EraSummary
-> (Proto EraSummary -> Proto EraSummary) -> Proto EraSummary
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto EraSummary) (Maybe (Proto EraBoundary))
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'end" a) =>
LensLike' f s a
U5c.maybe'end LensLike' Identity (Proto EraSummary) (Maybe (Proto EraBoundary))
-> Maybe (Proto EraBoundary)
-> Proto EraSummary
-> Proto EraSummary
forall s t a b. ASetter s t a b -> b -> s -> t
.~ if Bool
isLast then Maybe (Proto EraBoundary)
forall a. Maybe a
Nothing else EraEnd -> Maybe (Proto EraBoundary)
endToProto (EraSummary -> EraEnd
History.eraEnd EraSummary
entry)

  endToProto :: History.EraEnd -> Maybe (Proto U5c.EraBoundary)
  endToProto :: EraEnd -> Maybe (Proto EraBoundary)
endToProto = \case
    History.EraEnd Bound
bound -> Proto EraBoundary -> Maybe (Proto EraBoundary)
forall a. a -> Maybe a
Just (Bound -> Proto EraBoundary
boundToProto Bound
bound)
    EraEnd
History.EraUnbounded -> Maybe (Proto EraBoundary)
forall a. Maybe a
Nothing

  boundToProto :: History.Bound -> Proto U5c.EraBoundary
  boundToProto :: Bound -> Proto EraBoundary
boundToProto Bound
bound =
    Proto EraBoundary
forall msg. Message msg => msg
defMessage
      Proto EraBoundary
-> (Proto EraBoundary -> Proto EraBoundary) -> Proto EraBoundary
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto EraBoundary) Word64
forall (f :: * -> *) s a.
(Functor f, HasField s "time" a) =>
LensLike' f s a
U5c.time LensLike' Identity (Proto EraBoundary) Word64
-> Word64 -> Proto EraBoundary -> Proto EraBoundary
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bound -> Word64
boundTimeMs Bound
bound
      Proto EraBoundary
-> (Proto EraBoundary -> Proto EraBoundary) -> Proto EraBoundary
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto EraBoundary) Word64
forall (f :: * -> *) s a.
(Functor f, HasField s "slot" a) =>
LensLike' f s a
U5c.slot LensLike' Identity (Proto EraBoundary) Word64
-> Word64 -> Proto EraBoundary -> Proto EraBoundary
forall s t a b. ASetter s t a b -> b -> s -> t
.~ SlotNo -> Word64
unSlotNo (Bound -> SlotNo
History.boundSlot Bound
bound)
      Proto EraBoundary
-> (Proto EraBoundary -> Proto EraBoundary) -> Proto EraBoundary
forall a b. a -> (a -> b) -> b
& LensLike' Identity (Proto EraBoundary) Word64
forall (f :: * -> *) s a.
(Functor f, HasField s "epoch" a) =>
LensLike' f s a
U5c.epoch LensLike' Identity (Proto EraBoundary) Word64
-> Word64 -> Proto EraBoundary -> Proto EraBoundary
forall s t a b. ASetter s t a b -> b -> s -> t
.~ EpochNo -> Word64
unEpochNo (Bound -> EpochNo
History.boundEpoch Bound
bound)

  -- Reuses 'utcTimeToMs', the same millisecond conversion 'mkChainPointMsg'
  -- and 'mkTipBlockRef' use for their proto timestamps, for consistency
  -- across the API. 'fromRelativeTime' adds the boundary's 'RelativeTime' to
  -- the system start with 'Pico'-precision arithmetic throughout.
  boundTimeMs :: History.Bound -> Word64
  boundTimeMs :: Bound -> Word64
boundTimeMs Bound
bound = UTCTime -> Word64
utcTimeToMs (SystemStart -> RelativeTime -> UTCTime
fromRelativeTime SystemStart
systemStart (Bound -> RelativeTime
History.boundTime Bound
bound))