{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE RankNTypes                 #-}

module Ouroboros.Network.BlockFetch.ConsensusInterface
  ( PraosFetchMode (..)
  , FetchMode (..)
  , BlockFetchConsensusInterface (..)
  , ChainSelStarvation (..)
  , ChainComparison (..)
  , mkReadFetchMode
    -- * Utilities
  , WithFingerprint (..)
  , Fingerprint (..)
  , initialWithFingerprint
  ) where

import Control.Monad.Class.MonadSTM
import Control.Monad.Class.MonadTime (UTCTime)
import Control.Monad.Class.MonadTime.SI (Time)
import Data.Functor ((<&>))

import Data.Map.Strict (Map)
import Data.Word (Word64)
import GHC.Generics (Generic)
import GHC.Stack (HasCallStack)
import NoThunks.Class (NoThunks)

import Cardano.Network.ConsensusMode (ConsensusMode (..))
import Cardano.Network.Types (LedgerStateJudgement (..))
import Ouroboros.Network.AnchoredFragment (AnchoredFragment)
import Ouroboros.Network.Block
import Ouroboros.Network.SizeInBytes (SizeInBytes)

data PraosFetchMode =
       -- | Use this mode when we are catching up on the chain but are stil
       -- well behind. In this mode the fetch logic will optimise for
       -- throughput rather than latency.
       --
       FetchModeBulkSync

       -- | Use this mode for block-producing nodes that have a known deadline
       -- to produce a block and need to get the best chain before that. In
       -- this mode the fetch logic will optimise for picking the best chain
       -- within the given deadline.
     | FetchModeDeadline

       -- TODO: add an additional mode for in-between: when we are a core node
       -- following the chain but do not have an imminent deadline, or are a
       -- relay forwarding chains within the network.
       --
       -- This is a mixed mode because we have to combine the distribution of
       -- time to next block under praos, with the distribution of latency of
       -- our peers, and also the consensus preference.

  deriving (PraosFetchMode -> PraosFetchMode -> Bool
(PraosFetchMode -> PraosFetchMode -> Bool)
-> (PraosFetchMode -> PraosFetchMode -> Bool) -> Eq PraosFetchMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PraosFetchMode -> PraosFetchMode -> Bool
== :: PraosFetchMode -> PraosFetchMode -> Bool
$c/= :: PraosFetchMode -> PraosFetchMode -> Bool
/= :: PraosFetchMode -> PraosFetchMode -> Bool
Eq, Int -> PraosFetchMode -> ShowS
[PraosFetchMode] -> ShowS
PraosFetchMode -> String
(Int -> PraosFetchMode -> ShowS)
-> (PraosFetchMode -> String)
-> ([PraosFetchMode] -> ShowS)
-> Show PraosFetchMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PraosFetchMode -> ShowS
showsPrec :: Int -> PraosFetchMode -> ShowS
$cshow :: PraosFetchMode -> String
show :: PraosFetchMode -> String
$cshowList :: [PraosFetchMode] -> ShowS
showList :: [PraosFetchMode] -> ShowS
Show)

-- | The fetch mode that the block fetch logic should use.
data FetchMode = FetchModeGenesis | PraosFetchMode PraosFetchMode
  deriving (FetchMode -> FetchMode -> Bool
(FetchMode -> FetchMode -> Bool)
-> (FetchMode -> FetchMode -> Bool) -> Eq FetchMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FetchMode -> FetchMode -> Bool
== :: FetchMode -> FetchMode -> Bool
$c/= :: FetchMode -> FetchMode -> Bool
/= :: FetchMode -> FetchMode -> Bool
Eq, Int -> FetchMode -> ShowS
[FetchMode] -> ShowS
FetchMode -> String
(Int -> FetchMode -> ShowS)
-> (FetchMode -> String)
-> ([FetchMode] -> ShowS)
-> Show FetchMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FetchMode -> ShowS
showsPrec :: Int -> FetchMode -> ShowS
$cshow :: FetchMode -> String
show :: FetchMode -> String
$cshowList :: [FetchMode] -> ShowS
showList :: [FetchMode] -> ShowS
Show)

-- | Construct 'readFetchMode' for 'BlockFetchConsensusInterface' by branching
-- on the 'ConsensusMode'.
mkReadFetchMode
  :: Functor m
  => ConsensusMode
  -> m LedgerStateJudgement
     -- ^ Used for 'GenesisMode'.
  -> m PraosFetchMode
     -- ^ Used for 'PraosMode' for backwards compatibility.
  -> m FetchMode
mkReadFetchMode :: forall (m :: * -> *).
Functor m =>
ConsensusMode
-> m LedgerStateJudgement -> m PraosFetchMode -> m FetchMode
mkReadFetchMode ConsensusMode
consensusMode m LedgerStateJudgement
getLedgerStateJudgement m PraosFetchMode
getFetchMode =
    case ConsensusMode
consensusMode of
      ConsensusMode
GenesisMode -> m LedgerStateJudgement
getLedgerStateJudgement m LedgerStateJudgement
-> (LedgerStateJudgement -> FetchMode) -> m FetchMode
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
        LedgerStateJudgement
YoungEnough -> PraosFetchMode -> FetchMode
PraosFetchMode PraosFetchMode
FetchModeDeadline
        LedgerStateJudgement
TooOld      -> FetchMode
FetchModeGenesis
      ConsensusMode
PraosMode   -> PraosFetchMode -> FetchMode
PraosFetchMode (PraosFetchMode -> FetchMode) -> m PraosFetchMode -> m FetchMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m PraosFetchMode
getFetchMode

-- | The consensus layer functionality that the block fetch logic requires.
--
-- These are provided as input to the block fetch by the consensus layer.
--
data BlockFetchConsensusInterface peer header block m =
     BlockFetchConsensusInterface {

       -- | Read the K-suffixes of the candidate chains.
       --
       -- Assumptions:
       -- * Their headers must be already validated.
       -- * They may contain /fewer/ than @K@ blocks.
       -- * Their anchor does not have to intersect with the current chain.
       forall peer header block (m :: * -> *).
BlockFetchConsensusInterface peer header block m
-> STM m (Map peer (AnchoredFragment header))
readCandidateChains    :: STM m (Map peer (AnchoredFragment header)),

       -- | Read the K-suffix of the current chain.
       --
       -- This must contain info on the last @K@ blocks (unless we're near
       -- the chain genesis of course).
       --
       forall peer header block (m :: * -> *).
BlockFetchConsensusInterface peer header block m
-> STM m (AnchoredFragment header)
readCurrentChain       :: STM m (AnchoredFragment header),

       -- | Read the current fetch mode that the block fetch logic should use.
       --
       -- The fetch mode is a dynamic part of the block fetch policy. In
       -- 'FetchModeBulkSync' it follows a policy that optimises for expected
       -- bandwidth over latency to fetch any particular block, whereas in
       -- 'FetchModeDeadline' it follows a policy optimises for the latency
       -- to fetch blocks, at the expense of wasting bandwidth.
       --
       -- 'FetchModeGenesis' should be used when the genesis node is syncing to
       -- ensure it isn't leashed.
       --
       -- This mode should be set so that when the node's current chain is near
       -- to \"now\" it uses the deadline mode, and when it is far away it uses
       -- the bulk sync mode.
       --
       forall peer header block (m :: * -> *).
BlockFetchConsensusInterface peer header block m -> STM m FetchMode
readFetchMode          :: STM m FetchMode,

       -- | Recent, only within last K
       forall peer header block (m :: * -> *).
BlockFetchConsensusInterface peer header block m
-> STM m (Point block -> Bool)
readFetchedBlocks      :: STM m (Point block -> Bool),

       -- | This method allocates an @addFetchedBlock@ function per client.
       -- That function and 'readFetchedBlocks' are required to be linked. Upon
       -- successful completion of @addFetchedBlock@ it must be the case that
       -- 'readFetchedBlocks' reports the block.
       forall peer header block (m :: * -> *).
BlockFetchConsensusInterface peer header block m
-> STM m (Point block -> block -> m ())
mkAddFetchedBlock      :: STM m (Point block -> block -> m ()),

       -- | The highest stored/downloaded slot number.
       --
       -- This is used to optimise the filtering of fragments in the block
       -- fetch logic: when removing already downloaded blocks from a
       -- fragment, the filtering (with a linear cost) is stopped as soon as a
       -- block has a slot number higher than this slot number, as it cannot
       -- have been downloaded anyway.
       forall peer header block (m :: * -> *).
BlockFetchConsensusInterface peer header block m -> STM m MaxSlotNo
readFetchedMaxSlotNo    :: STM m MaxSlotNo,

       -- | Compare chain fragments. This might involve further state, such as
       -- Peras certificates (which give certain blocks additional weight).
       forall peer header block (m :: * -> *).
BlockFetchConsensusInterface peer header block m
-> STM m (WithFingerprint (ChainComparison header))
readChainComparison     :: STM m (WithFingerprint (ChainComparison header)),

       -- | Much of the logic for deciding which blocks to download from which
       -- peer depends on making estimates based on recent performance metrics.
       -- These estimates of course depend on the amount of data we will be
       -- downloading.
       --
       forall peer header block (m :: * -> *).
BlockFetchConsensusInterface peer header block m
-> header -> SizeInBytes
blockFetchSize          :: header -> SizeInBytes,

       -- | Given a block header, validate the supposed corresponding block
       -- body.
       --
       forall peer header block (m :: * -> *).
BlockFetchConsensusInterface peer header block m
-> header -> block -> Bool
blockMatchesHeader      :: header -> block -> Bool,

       -- | Calculate when a header's block was forged.
       forall peer header block (m :: * -> *).
BlockFetchConsensusInterface peer header block m
-> header -> UTCTime
headerForgeUTCTime      :: header -> UTCTime,

       -- | Information on the ChainSel starvation status; whether it is ongoing
       -- or has ended recently. Needed by the bulk sync decision logic.
       forall peer header block (m :: * -> *).
BlockFetchConsensusInterface peer header block m
-> STM m ChainSelStarvation
readChainSelStarvation :: STM m ChainSelStarvation,

       -- | Action to inform CSJ (ChainSync Jumping) that the given peer has not
       -- been performing adequately with respect to BlockFetch, and that it
       -- should be demoted from the dynamo role. Can be set to @const (pure
       -- ())@ in all other scenarios.
       forall peer header block (m :: * -> *).
BlockFetchConsensusInterface peer header block m -> peer -> m ()
demoteChainSyncJumpingDynamo :: peer -> m ()
     }


-- | Whether ChainSel is starved or has been recently.
--
-- The bulk sync fetch decision logic needs to decide whether the current
-- focused peer has starved ChainSel recently. This datatype is used to
-- represent this piece of information.
data ChainSelStarvation
  = ChainSelStarvationOngoing
  | ChainSelStarvationEndedAt Time
  deriving (ChainSelStarvation -> ChainSelStarvation -> Bool
(ChainSelStarvation -> ChainSelStarvation -> Bool)
-> (ChainSelStarvation -> ChainSelStarvation -> Bool)
-> Eq ChainSelStarvation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChainSelStarvation -> ChainSelStarvation -> Bool
== :: ChainSelStarvation -> ChainSelStarvation -> Bool
$c/= :: ChainSelStarvation -> ChainSelStarvation -> Bool
/= :: ChainSelStarvation -> ChainSelStarvation -> Bool
Eq, Int -> ChainSelStarvation -> ShowS
[ChainSelStarvation] -> ShowS
ChainSelStarvation -> String
(Int -> ChainSelStarvation -> ShowS)
-> (ChainSelStarvation -> String)
-> ([ChainSelStarvation] -> ShowS)
-> Show ChainSelStarvation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChainSelStarvation -> ShowS
showsPrec :: Int -> ChainSelStarvation -> ShowS
$cshow :: ChainSelStarvation -> String
show :: ChainSelStarvation -> String
$cshowList :: [ChainSelStarvation] -> ShowS
showList :: [ChainSelStarvation] -> ShowS
Show, Context -> ChainSelStarvation -> IO (Maybe ThunkInfo)
Proxy ChainSelStarvation -> String
(Context -> ChainSelStarvation -> IO (Maybe ThunkInfo))
-> (Context -> ChainSelStarvation -> IO (Maybe ThunkInfo))
-> (Proxy ChainSelStarvation -> String)
-> NoThunks ChainSelStarvation
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> ChainSelStarvation -> IO (Maybe ThunkInfo)
noThunks :: Context -> ChainSelStarvation -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ChainSelStarvation -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> ChainSelStarvation -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy ChainSelStarvation -> String
showTypeOf :: Proxy ChainSelStarvation -> String
NoThunks, (forall x. ChainSelStarvation -> Rep ChainSelStarvation x)
-> (forall x. Rep ChainSelStarvation x -> ChainSelStarvation)
-> Generic ChainSelStarvation
forall x. Rep ChainSelStarvation x -> ChainSelStarvation
forall x. ChainSelStarvation -> Rep ChainSelStarvation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ChainSelStarvation -> Rep ChainSelStarvation x
from :: forall x. ChainSelStarvation -> Rep ChainSelStarvation x
$cto :: forall x. Rep ChainSelStarvation x -> ChainSelStarvation
to :: forall x. Rep ChainSelStarvation x -> ChainSelStarvation
Generic)


data ChainComparison header =
     ChainComparison {
       -- | Given the current chain, is the given chain plausible as a candidate
       -- chain. Classically for Ouroboros this would simply check if the
       -- candidate is strictly longer, but it can also involve further
       -- criteria:
       --
       --  * Tiebreakers (e.g. based on the opcert numbers and VRFs) for chains
       --    of equal length.
       --
       --  * Weight in the context of Ouroboros Peras, due to a boost from a
       --    Peras certificate.
       --
       forall header.
ChainComparison header
-> HasCallStack =>
   AnchoredFragment header -> AnchoredFragment header -> Bool
plausibleCandidateChain :: HasCallStack
                               => AnchoredFragment header
                               -> AnchoredFragment header
                               -> Bool,

       -- | Compare two candidate chains and return a preference ordering.
       -- This is used as part of selecting which chains to prioritise for
       -- downloading block bodies.
       --
       -- PRECONDITION: The two fragments must intersect.
       --
       forall header.
ChainComparison header
-> HasCallStack =>
   AnchoredFragment header -> AnchoredFragment header -> Ordering
compareCandidateChains  :: HasCallStack
                               => AnchoredFragment header
                               -> AnchoredFragment header
                               -> Ordering
     }

{-------------------------------------------------------------------------------
  Utilities
-------------------------------------------------------------------------------}

-- | Simple type that can be used to indicate some value (without/only with an
-- expensive 'Eq' instance) changed.
newtype Fingerprint = Fingerprint Word64
  deriving stock (Int -> Fingerprint -> ShowS
[Fingerprint] -> ShowS
Fingerprint -> String
(Int -> Fingerprint -> ShowS)
-> (Fingerprint -> String)
-> ([Fingerprint] -> ShowS)
-> Show Fingerprint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Fingerprint -> ShowS
showsPrec :: Int -> Fingerprint -> ShowS
$cshow :: Fingerprint -> String
show :: Fingerprint -> String
$cshowList :: [Fingerprint] -> ShowS
showList :: [Fingerprint] -> ShowS
Show, Fingerprint -> Fingerprint -> Bool
(Fingerprint -> Fingerprint -> Bool)
-> (Fingerprint -> Fingerprint -> Bool) -> Eq Fingerprint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Fingerprint -> Fingerprint -> Bool
== :: Fingerprint -> Fingerprint -> Bool
$c/= :: Fingerprint -> Fingerprint -> Bool
/= :: Fingerprint -> Fingerprint -> Bool
Eq, (forall x. Fingerprint -> Rep Fingerprint x)
-> (forall x. Rep Fingerprint x -> Fingerprint)
-> Generic Fingerprint
forall x. Rep Fingerprint x -> Fingerprint
forall x. Fingerprint -> Rep Fingerprint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Fingerprint -> Rep Fingerprint x
from :: forall x. Fingerprint -> Rep Fingerprint x
$cto :: forall x. Rep Fingerprint x -> Fingerprint
to :: forall x. Rep Fingerprint x -> Fingerprint
Generic)
  deriving newtype (Int -> Fingerprint
Fingerprint -> Int
Fingerprint -> [Fingerprint]
Fingerprint -> Fingerprint
Fingerprint -> Fingerprint -> [Fingerprint]
Fingerprint -> Fingerprint -> Fingerprint -> [Fingerprint]
(Fingerprint -> Fingerprint)
-> (Fingerprint -> Fingerprint)
-> (Int -> Fingerprint)
-> (Fingerprint -> Int)
-> (Fingerprint -> [Fingerprint])
-> (Fingerprint -> Fingerprint -> [Fingerprint])
-> (Fingerprint -> Fingerprint -> [Fingerprint])
-> (Fingerprint -> Fingerprint -> Fingerprint -> [Fingerprint])
-> Enum Fingerprint
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 :: Fingerprint -> Fingerprint
succ :: Fingerprint -> Fingerprint
$cpred :: Fingerprint -> Fingerprint
pred :: Fingerprint -> Fingerprint
$ctoEnum :: Int -> Fingerprint
toEnum :: Int -> Fingerprint
$cfromEnum :: Fingerprint -> Int
fromEnum :: Fingerprint -> Int
$cenumFrom :: Fingerprint -> [Fingerprint]
enumFrom :: Fingerprint -> [Fingerprint]
$cenumFromThen :: Fingerprint -> Fingerprint -> [Fingerprint]
enumFromThen :: Fingerprint -> Fingerprint -> [Fingerprint]
$cenumFromTo :: Fingerprint -> Fingerprint -> [Fingerprint]
enumFromTo :: Fingerprint -> Fingerprint -> [Fingerprint]
$cenumFromThenTo :: Fingerprint -> Fingerprint -> Fingerprint -> [Fingerprint]
enumFromThenTo :: Fingerprint -> Fingerprint -> Fingerprint -> [Fingerprint]
Enum)
  deriving anyclass (Context -> Fingerprint -> IO (Maybe ThunkInfo)
Proxy Fingerprint -> String
(Context -> Fingerprint -> IO (Maybe ThunkInfo))
-> (Context -> Fingerprint -> IO (Maybe ThunkInfo))
-> (Proxy Fingerprint -> String)
-> NoThunks Fingerprint
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> Fingerprint -> IO (Maybe ThunkInfo)
noThunks :: Context -> Fingerprint -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Fingerprint -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Fingerprint -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy Fingerprint -> String
showTypeOf :: Proxy Fingerprint -> String
NoThunks)

-- | Store a value together with its 'Fingerprint'.
data WithFingerprint a = WithFingerprint
  { forall a. WithFingerprint a -> a
forgetFingerprint :: !a
  , forall a. WithFingerprint a -> Fingerprint
getFingerprint    :: !Fingerprint
  }
  deriving stock (Int -> WithFingerprint a -> ShowS
[WithFingerprint a] -> ShowS
WithFingerprint a -> String
(Int -> WithFingerprint a -> ShowS)
-> (WithFingerprint a -> String)
-> ([WithFingerprint a] -> ShowS)
-> Show (WithFingerprint a)
forall a. Show a => Int -> WithFingerprint a -> ShowS
forall a. Show a => [WithFingerprint a] -> ShowS
forall a. Show a => WithFingerprint a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> WithFingerprint a -> ShowS
showsPrec :: Int -> WithFingerprint a -> ShowS
$cshow :: forall a. Show a => WithFingerprint a -> String
show :: WithFingerprint a -> String
$cshowList :: forall a. Show a => [WithFingerprint a] -> ShowS
showList :: [WithFingerprint a] -> ShowS
Show, (forall a b. (a -> b) -> WithFingerprint a -> WithFingerprint b)
-> (forall a b. a -> WithFingerprint b -> WithFingerprint a)
-> Functor WithFingerprint
forall a b. a -> WithFingerprint b -> WithFingerprint a
forall a b. (a -> b) -> WithFingerprint a -> WithFingerprint b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> WithFingerprint a -> WithFingerprint b
fmap :: forall a b. (a -> b) -> WithFingerprint a -> WithFingerprint b
$c<$ :: forall a b. a -> WithFingerprint b -> WithFingerprint a
<$ :: forall a b. a -> WithFingerprint b -> WithFingerprint a
Functor, (forall x. WithFingerprint a -> Rep (WithFingerprint a) x)
-> (forall x. Rep (WithFingerprint a) x -> WithFingerprint a)
-> Generic (WithFingerprint a)
forall x. Rep (WithFingerprint a) x -> WithFingerprint a
forall x. WithFingerprint a -> Rep (WithFingerprint a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (WithFingerprint a) x -> WithFingerprint a
forall a x. WithFingerprint a -> Rep (WithFingerprint a) x
$cfrom :: forall a x. WithFingerprint a -> Rep (WithFingerprint a) x
from :: forall x. WithFingerprint a -> Rep (WithFingerprint a) x
$cto :: forall a x. Rep (WithFingerprint a) x -> WithFingerprint a
to :: forall x. Rep (WithFingerprint a) x -> WithFingerprint a
Generic)
  deriving anyclass (Context -> WithFingerprint a -> IO (Maybe ThunkInfo)
Proxy (WithFingerprint a) -> String
(Context -> WithFingerprint a -> IO (Maybe ThunkInfo))
-> (Context -> WithFingerprint a -> IO (Maybe ThunkInfo))
-> (Proxy (WithFingerprint a) -> String)
-> NoThunks (WithFingerprint a)
forall a.
NoThunks a =>
Context -> WithFingerprint a -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Proxy (WithFingerprint a) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall a.
NoThunks a =>
Context -> WithFingerprint a -> IO (Maybe ThunkInfo)
noThunks :: Context -> WithFingerprint a -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall a.
NoThunks a =>
Context -> WithFingerprint a -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> WithFingerprint a -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall a. NoThunks a => Proxy (WithFingerprint a) -> String
showTypeOf :: Proxy (WithFingerprint a) -> String
NoThunks)

-- | Attach @'Fingerprint' 0@ to the given value. When the underlying @a@ is
-- changed, the 'Fingerprint' must be updated to a new unique value (e.g. via
-- 'succ').
initialWithFingerprint :: a -> WithFingerprint a
initialWithFingerprint :: forall a. a -> WithFingerprint a
initialWithFingerprint a
a = a -> Fingerprint -> WithFingerprint a
forall a. a -> Fingerprint -> WithFingerprint a
WithFingerprint a
a (Word64 -> Fingerprint
Fingerprint Word64
0)