{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_HADDOCK not-home #-}

-- | Provides MemoBytes internals
--
-- = Warning
--
-- This module is considered __internal__.
--
-- The contents of this module may change __in any way whatsoever__
-- and __without any warning__ between minor versions of this package.
module Cardano.Ledger.MemoBytes.Internal (
  MemoBytes (.., Memo),
  Mem,
  MemoHashIndex,
  mkMemoBytes,
  mkMemoBytesStrict,
  getMemoBytesType,
  getMemoBytesHash,
  memoBytes,
  memoBytesEra,
  shorten,
  showMemo,
  printMemo,
  shortToLazy,
  contentsEq,
  decodeMemoBytes,

  -- * Memoized
  Memoized (RawType),
  mkMemoized,
  mkMemoizedEra,
  decodeMemoized,
  getMemoSafeHash,
  getMemoRawType,
  zipMemoRawType,
  eqRawType,
  getMemoRawBytes,
  lensMemoRawType,
  getterMemoRawType,

  -- * MemoBytes MemPack instance definitions
  byteCountMemoBytes,
  packMemoBytesM,
  unpackMemoBytesM,

  -- * Raw equality
  EqRaw (..),
) where

import Cardano.Crypto.Hash (HashAlgorithm (hashAlgorithmName))
import Cardano.Ledger.Binary (
  Annotated (..),
  Annotator (..),
  DecCBOR (decCBOR),
  Decoder,
  EncCBOR,
  Version,
  decodeAnnotated,
  decodeFullAnnotator,
  serialize,
  withSlice,
 )
import Cardano.Ledger.Binary.Coders (Encode, encode, runE)
import qualified Cardano.Ledger.Binary.Plain as Plain
import Cardano.Ledger.Core.Era (Era, eraProtVerLow)
import Cardano.Ledger.Hashes (HASH, SafeHash, SafeToHash (..))
import Control.DeepSeq (NFData (..))
import Data.ByteString (ByteString)
import Data.ByteString.Lazy (fromStrict, toStrict)
import qualified Data.ByteString.Lazy as BSL
import Data.ByteString.Short (ShortByteString, fromShort, toShort)
import qualified Data.ByteString.Short as SBS (length)
import Data.Coerce
import Data.MemPack
import Data.MemPack.Buffer (Buffer)
import qualified Data.Text as T
import Data.Typeable
import GHC.Base (Type)
import GHC.Generics (Generic)
import Lens.Micro
import NoThunks.Class (AllowThunksIn (..), NoThunks (..))
import Prelude hiding (span)

-- ========================================================================

-- | Pair together a type @t@ and its serialization. Used to encode a type
--   that is serialized over the network, and to remember the original bytes
--   that were used to transmit it. Important since hashes are computed
--   from the serialization of a type, and EncCBOR instances do not have unique
--   serializations.
data MemoBytes t = MemoBytes
  { forall t. MemoBytes t -> t
mbRawType :: !t
  , forall t. MemoBytes t -> ShortByteString
mbBytes :: ShortByteString
  , forall t. MemoBytes t -> SafeHash (MemoHashIndex t)
mbHash :: SafeHash (MemoHashIndex t)
  }
  deriving ((forall x. MemoBytes t -> Rep (MemoBytes t) x)
-> (forall x. Rep (MemoBytes t) x -> MemoBytes t)
-> Generic (MemoBytes t)
forall x. Rep (MemoBytes t) x -> MemoBytes t
forall x. MemoBytes t -> Rep (MemoBytes t) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall t x. Rep (MemoBytes t) x -> MemoBytes t
forall t x. MemoBytes t -> Rep (MemoBytes t) x
$cfrom :: forall t x. MemoBytes t -> Rep (MemoBytes t) x
from :: forall x. MemoBytes t -> Rep (MemoBytes t) x
$cto :: forall t x. Rep (MemoBytes t) x -> MemoBytes t
to :: forall x. Rep (MemoBytes t) x -> MemoBytes t
Generic)
  deriving (Context -> MemoBytes t -> IO (Maybe ThunkInfo)
Proxy (MemoBytes t) -> String
(Context -> MemoBytes t -> IO (Maybe ThunkInfo))
-> (Context -> MemoBytes t -> IO (Maybe ThunkInfo))
-> (Proxy (MemoBytes t) -> String)
-> NoThunks (MemoBytes t)
forall t.
(Typeable t, NoThunks t) =>
Context -> MemoBytes t -> IO (Maybe ThunkInfo)
forall t. (Typeable t, NoThunks t) => Proxy (MemoBytes t) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall t.
(Typeable t, NoThunks t) =>
Context -> MemoBytes t -> IO (Maybe ThunkInfo)
noThunks :: Context -> MemoBytes t -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall t.
(Typeable t, NoThunks t) =>
Context -> MemoBytes t -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> MemoBytes t -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall t. (Typeable t, NoThunks t) => Proxy (MemoBytes t) -> String
showTypeOf :: Proxy (MemoBytes t) -> String
NoThunks) via AllowThunksIn '["mbBytes", "mbHash"] (MemoBytes t)

pattern Memo :: t -> ShortByteString -> MemoBytes t
pattern $mMemo :: forall {r} {t}.
MemoBytes t -> (t -> ShortByteString -> r) -> ((# #) -> r) -> r
$bMemo :: forall t. t -> ShortByteString -> MemoBytes t
Memo memoType memoBytes <-
  MemoBytes memoType memoBytes _
  where
    Memo t
mt ShortByteString
mb = t -> ByteString -> MemoBytes t
forall t. t -> ByteString -> MemoBytes t
mkMemoBytes t
mt (ShortByteString -> ByteString
shortToLazy ShortByteString
mb)

{-# COMPLETE Memo #-}

byteCountMemoBytes :: MemoBytes t -> Int
byteCountMemoBytes :: forall t. MemoBytes t -> Int
byteCountMemoBytes = ShortByteString -> Int
forall a. MemPack a => a -> Int
packedByteCount (ShortByteString -> Int)
-> (MemoBytes t -> ShortByteString) -> MemoBytes t -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MemoBytes t -> ShortByteString
forall t. MemoBytes t -> ShortByteString
mbBytes

packMemoBytesM :: MemoBytes t -> Pack s ()
packMemoBytesM :: forall t s. MemoBytes t -> Pack s ()
packMemoBytesM = ShortByteString -> Pack s ()
forall s. ShortByteString -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM (ShortByteString -> Pack s ())
-> (MemoBytes t -> ShortByteString) -> MemoBytes t -> Pack s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MemoBytes t -> ShortByteString
forall t. MemoBytes t -> ShortByteString
mbBytes

unpackMemoBytesM ::
  ( DecCBOR (Annotator t)
  , Typeable t
  , Buffer b
  ) =>
  Version -> Unpack b (MemoBytes t)
unpackMemoBytesM :: forall t b.
(DecCBOR (Annotator t), Typeable t, Buffer b) =>
Version -> Unpack b (MemoBytes t)
unpackMemoBytesM Version
v = Unpack b ByteString
forall a b. (MemPack a, Buffer b) => Unpack b a
forall b. Buffer b => Unpack b ByteString
unpackM Unpack b ByteString
-> (ByteString -> Unpack b (MemoBytes t)) -> Unpack b (MemoBytes t)
forall a b. Unpack b a -> (a -> Unpack b b) -> Unpack b b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Version -> ByteString -> Unpack b (MemoBytes t)
forall t (m :: * -> *).
(Typeable t, DecCBOR (Annotator t), MonadFail m) =>
Version -> ByteString -> m (MemoBytes t)
decodeMemoBytes Version
v

decodeMemoBytes ::
  forall t m.
  ( Typeable t
  , DecCBOR (Annotator t)
  , MonadFail m
  ) =>
  Version -> ByteString -> m (MemoBytes t)
decodeMemoBytes :: forall t (m :: * -> *).
(Typeable t, DecCBOR (Annotator t), MonadFail m) =>
Version -> ByteString -> m (MemoBytes t)
decodeMemoBytes Version
v ByteString
bs =
  (DecoderError -> m (MemoBytes t))
-> (MemoBytes t -> m (MemoBytes t))
-> Either DecoderError (MemoBytes t)
-> m (MemoBytes t)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> m (MemoBytes t)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m (MemoBytes t))
-> (DecoderError -> String) -> DecoderError -> m (MemoBytes t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecoderError -> String
forall a. Show a => a -> String
show) MemoBytes t -> m (MemoBytes t)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either DecoderError (MemoBytes t) -> m (MemoBytes t))
-> Either DecoderError (MemoBytes t) -> m (MemoBytes t)
forall a b. (a -> b) -> a -> b
$
    Version
-> Text
-> (forall s. Decoder s (Annotator (MemoBytes t)))
-> ByteString
-> Either DecoderError (MemoBytes t)
forall a.
Version
-> Text
-> (forall s. Decoder s (Annotator a))
-> ByteString
-> Either DecoderError a
decodeFullAnnotator
      Version
v
      (String -> Text
T.pack (TypeRep -> String
forall a. Show a => a -> String
show (Proxy t -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @t))))
      Decoder s (Annotator (MemoBytes t))
forall s. Decoder s (Annotator (MemoBytes t))
forall a s. DecCBOR a => Decoder s a
decCBOR
      (ByteString -> ByteString
BSL.fromStrict ByteString
bs)

type family MemoHashIndex (t :: Type) :: Type

deriving instance NFData t => NFData (MemoBytes t)

instance Typeable t => Plain.ToCBOR (MemoBytes t) where
  toCBOR :: MemoBytes t -> Encoding
toCBOR (MemoBytes t
_ ShortByteString
bytes SafeHash (MemoHashIndex t)
_hash) = ByteString -> Encoding
Plain.encodePreEncoded (ShortByteString -> ByteString
fromShort ShortByteString
bytes)

instance DecCBOR t => DecCBOR (MemoBytes t) where
  decCBOR :: forall s. Decoder s (MemoBytes t)
decCBOR = Decoder s t -> Decoder s (MemoBytes t)
forall s t. Decoder s t -> Decoder s (MemoBytes t)
decodeMemoized Decoder s t
forall s. Decoder s t
forall a s. DecCBOR a => Decoder s a
decCBOR

instance
  (Typeable t, DecCBOR (Annotator t)) =>
  DecCBOR (Annotator (MemoBytes t))
  where
  decCBOR :: forall s. Decoder s (Annotator (MemoBytes t))
decCBOR = do
    (Annotator FullByteString -> t
getT, Annotator FullByteString -> ByteString
getBytes) <- Decoder s (Annotator t)
-> Decoder s (Annotator t, Annotator ByteString)
forall s a. Decoder s a -> Decoder s (a, Annotator ByteString)
withSlice Decoder s (Annotator t)
forall s. Decoder s (Annotator t)
forall a s. DecCBOR a => Decoder s a
decCBOR
    Annotator (MemoBytes t) -> Decoder s (Annotator (MemoBytes t))
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Annotator (MemoBytes t) -> Decoder s (Annotator (MemoBytes t)))
-> Annotator (MemoBytes t) -> Decoder s (Annotator (MemoBytes t))
forall a b. (a -> b) -> a -> b
$ (FullByteString -> MemoBytes t) -> Annotator (MemoBytes t)
forall a. (FullByteString -> a) -> Annotator a
Annotator (\FullByteString
fullbytes -> t -> ByteString -> MemoBytes t
forall t. t -> ByteString -> MemoBytes t
mkMemoBytes (FullByteString -> t
getT FullByteString
fullbytes) (FullByteString -> ByteString
getBytes FullByteString
fullbytes))

-- | Both binary representation and Haskell types are compared.
instance Eq t => Eq (MemoBytes t) where
  MemoBytes t
x == :: MemoBytes t -> MemoBytes t -> Bool
== MemoBytes t
y = MemoBytes t -> ShortByteString
forall t. MemoBytes t -> ShortByteString
mbBytes MemoBytes t
x ShortByteString -> ShortByteString -> Bool
forall a. Eq a => a -> a -> Bool
== MemoBytes t -> ShortByteString
forall t. MemoBytes t -> ShortByteString
mbBytes MemoBytes t
y Bool -> Bool -> Bool
&& MemoBytes t -> t
forall t. MemoBytes t -> t
mbRawType MemoBytes t
x t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== MemoBytes t -> t
forall t. MemoBytes t -> t
mbRawType MemoBytes t
y

instance Show t => Show (MemoBytes t) where
  show :: MemoBytes t -> String
show (MemoBytes t
y ShortByteString
_ SafeHash (MemoHashIndex t)
h) =
    t -> String
forall a. Show a => a -> String
show t
y
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" ("
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Proxy HASH -> String
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> String
forall (proxy :: * -> *). proxy HASH -> String
hashAlgorithmName (Proxy HASH
forall {k} (t :: k). Proxy t
Proxy :: Proxy HASH)
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> SafeHash (MemoHashIndex t) -> String
forall a. Show a => a -> String
show SafeHash (MemoHashIndex t)
h
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"

instance SafeToHash (MemoBytes t) where
  originalBytes :: MemoBytes t -> ByteString
originalBytes = ShortByteString -> ByteString
fromShort (ShortByteString -> ByteString)
-> (MemoBytes t -> ShortByteString) -> MemoBytes t -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MemoBytes t -> ShortByteString
forall t. MemoBytes t -> ShortByteString
mbBytes
  originalBytesSize :: MemoBytes t -> Int
originalBytesSize = ShortByteString -> Int
SBS.length (ShortByteString -> Int)
-> (MemoBytes t -> ShortByteString) -> MemoBytes t -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MemoBytes t -> ShortByteString
forall t. MemoBytes t -> ShortByteString
mbBytes

-- | Turn a lazy bytestring into a short bytestring.
shorten :: BSL.ByteString -> ShortByteString
shorten :: ByteString -> ShortByteString
shorten ByteString
x = ByteString -> ShortByteString
toShort (ByteString -> ByteString
toStrict ByteString
x)
{-# DEPRECATED shorten "As unused. Use `toShort` `.` `toStrict` instead" #-}

-- | Useful when deriving DecCBOR(Annotator T)
-- deriving via (Mem T) instance DecCBOR (Annotator T)
type Mem t = Annotator (MemoBytes t)

-- | Constructor that takes the underlying type and the original bytes as lazy
-- `BSL.ByteString`.
--
-- /Warning/ - This is a dangerous constructor because it allows one to construct a `MemoBytes` type
-- with wrong bytes.
mkMemoBytes :: t -> BSL.ByteString -> MemoBytes t
mkMemoBytes :: forall t. t -> ByteString -> MemoBytes t
mkMemoBytes t
t = t -> ByteString -> MemoBytes t
forall t. t -> ByteString -> MemoBytes t
mkMemoBytesStrict t
t (ByteString -> MemoBytes t)
-> (ByteString -> ByteString) -> ByteString -> MemoBytes t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict

-- | Same as `mkMemoBytes`, but with strict bytes
mkMemoBytesStrict :: forall t. t -> ByteString -> MemoBytes t
mkMemoBytesStrict :: forall t. t -> ByteString -> MemoBytes t
mkMemoBytesStrict t
t ByteString
bs =
  t -> ShortByteString -> SafeHash (MemoHashIndex t) -> MemoBytes t
forall t.
t -> ShortByteString -> SafeHash (MemoHashIndex t) -> MemoBytes t
MemoBytes t
t (ByteString -> ShortByteString
toShort ByteString
bs) (SafeHash (MemoHashIndex t) -> MemoBytes t)
-> SafeHash (MemoHashIndex t) -> MemoBytes t
forall a b. (a -> b) -> a -> b
$
    Proxy (MemoHashIndex t) -> ByteString -> SafeHash (MemoHashIndex t)
forall i. Proxy i -> ByteString -> SafeHash i
forall t i. SafeToHash t => Proxy i -> t -> SafeHash i
makeHashWithExplicitProxys (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(MemoHashIndex t)) ByteString
bs

-- | Turn a MemoBytes into a string, showing both its internal structure and its original bytes.
--   Useful since the Show instance of MemoBytes does not display the original bytes.
showMemo :: Show t => MemoBytes t -> String
showMemo :: forall t. Show t => MemoBytes t -> String
showMemo (MemoBytes t
t ShortByteString
b SafeHash (MemoHashIndex t)
_) = String
"(Memo " String -> ShowS
forall a. [a] -> [a] -> [a]
++ t -> String
forall a. Show a => a -> String
show t
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShortByteString -> String
forall a. Show a => a -> String
show ShortByteString
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
{-# DEPRECATED showMemo "As unused. Show instance will show the hash, which is enough most of the time" #-}

printMemo :: Show t => MemoBytes t -> IO ()
printMemo :: forall t. Show t => MemoBytes t -> IO ()
printMemo MemoBytes t
x = String -> IO ()
putStrLn (MemoBytes t -> String
forall t. Show t => MemoBytes t -> String
showMemo MemoBytes t
x)
{-# DEPRECATED printMemo "As unused. Show instance will show the hash, which is enough most of the time" #-}

-- | Create MemoBytes from its CBOR encoding
--
-- /Warning/ - This is a dangerous constructor because it allows one to construct a `MemoBytes` type
-- from the wrong encoding. Use `mkMemoized` instead when possible.
memoBytes :: Version -> Encode w t -> MemoBytes t
memoBytes :: forall (w :: Wrapped) t. Version -> Encode w t -> MemoBytes t
memoBytes Version
v Encode w t
t = t -> ByteString -> MemoBytes t
forall t. t -> ByteString -> MemoBytes t
mkMemoBytes (Encode w t -> t
forall (w :: Wrapped) t. Encode w t -> t
runE Encode w t
t) (Version -> Encoding -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize Version
v (Encode w t -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode Encode w t
t))

-- | Same as `memoBytes`, but derives `Version` from the era.
--
-- /Warning/ - This is a dangerous constructor because it allows one to construct a `MemoBytes` type
-- from the wrong encoding. Use `mkMemoizedEra` instead when possible.
memoBytesEra :: forall era w t. Era era => Encode w t -> MemoBytes t
memoBytesEra :: forall era (w :: Wrapped) t. Era era => Encode w t -> MemoBytes t
memoBytesEra = Version -> Encode w t -> MemoBytes t
forall (w :: Wrapped) t. Version -> Encode w t -> MemoBytes t
memoBytes (forall era. Era era => Version
eraProtVerLow @era)

-- | Helper function. Converts a short bytestring to a lazy bytestring.
shortToLazy :: ShortByteString -> BSL.ByteString
shortToLazy :: ShortByteString -> ByteString
shortToLazy = ByteString -> ByteString
fromStrict (ByteString -> ByteString)
-> (ShortByteString -> ByteString) -> ShortByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
fromShort
{-# INLINE shortToLazy #-}

-- | Returns true if the contents of the MemoBytes are equal
contentsEq :: Eq t => MemoBytes t -> MemoBytes t -> Bool
contentsEq :: forall t. Eq t => MemoBytes t -> MemoBytes t -> Bool
contentsEq MemoBytes t
x MemoBytes t
y = MemoBytes t -> t
forall t. MemoBytes t -> t
mbRawType MemoBytes t
x t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== MemoBytes t -> t
forall t. MemoBytes t -> t
mbRawType MemoBytes t
y

-- | Extract the inner type of the MemoBytes
getMemoBytesType :: MemoBytes t -> t
getMemoBytesType :: forall t. MemoBytes t -> t
getMemoBytesType = MemoBytes t -> t
forall t. MemoBytes t -> t
mbRawType

-- | Extract the hash value of the binary representation of the MemoBytes
getMemoBytesHash :: MemoBytes t -> SafeHash (MemoHashIndex t)
getMemoBytesHash :: forall t. MemoBytes t -> SafeHash (MemoHashIndex t)
getMemoBytesHash = MemoBytes t -> SafeHash (MemoHashIndex t)
forall t. MemoBytes t -> SafeHash (MemoHashIndex t)
mbHash

-- | Class that relates the actual type with its raw and byte representations
class Memoized t where
  type RawType t = (r :: Type) | r -> t

  -- | This is a coercion from the memoized type to the MemoBytes. This implementation
  -- cannot be changed since `getMemoBytes` is not exported, therefore it will only work
  -- on newtypes around `MemoBytes`
  getMemoBytes :: t -> MemoBytes (RawType t)
  default getMemoBytes ::
    Coercible t (MemoBytes (RawType t)) =>
    t ->
    MemoBytes (RawType t)
  getMemoBytes = t -> MemoBytes (RawType t)
forall a b. Coercible a b => a -> b
coerce

  -- | This is a coercion from the MemoBytes to the memoized type. This implementation
  -- cannot be changed since `warpMemoBytes` is not exported, therefore it will only work
  -- on newtypes around `MemoBytes`
  wrapMemoBytes :: MemoBytes (RawType t) -> t
  default wrapMemoBytes ::
    Coercible (MemoBytes (RawType t)) t =>
    MemoBytes (RawType t) ->
    t
  wrapMemoBytes = MemoBytes (RawType t) -> t
forall a b. Coercible a b => a -> b
coerce

-- | Construct memoized type from the raw type using its EncCBOR instance
mkMemoized :: forall t. (EncCBOR (RawType t), Memoized t) => Version -> RawType t -> t
mkMemoized :: forall t.
(EncCBOR (RawType t), Memoized t) =>
Version -> RawType t -> t
mkMemoized Version
v RawType t
rawType = MemoBytes (RawType t) -> t
forall t. Memoized t => MemoBytes (RawType t) -> t
wrapMemoBytes (RawType t -> ByteString -> MemoBytes (RawType t)
forall t. t -> ByteString -> MemoBytes t
mkMemoBytes RawType t
rawType (Version -> RawType t -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize Version
v RawType t
rawType))

mkMemoizedEra :: forall era t. (Era era, EncCBOR (RawType t), Memoized t) => RawType t -> t
mkMemoizedEra :: forall era t.
(Era era, EncCBOR (RawType t), Memoized t) =>
RawType t -> t
mkMemoizedEra = Version -> RawType t -> t
forall t.
(EncCBOR (RawType t), Memoized t) =>
Version -> RawType t -> t
mkMemoized (forall era. Era era => Version
eraProtVerLow @era)

decodeMemoized :: Decoder s t -> Decoder s (MemoBytes t)
decodeMemoized :: forall s t. Decoder s t -> Decoder s (MemoBytes t)
decodeMemoized Decoder s t
rawTypeDecoder = do
  Annotated t
rawType ByteString
lazyBytes <- Decoder s t -> Decoder s (Annotated t ByteString)
forall s a. Decoder s a -> Decoder s (Annotated a ByteString)
decodeAnnotated Decoder s t
rawTypeDecoder
  MemoBytes t -> Decoder s (MemoBytes t)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MemoBytes t -> Decoder s (MemoBytes t))
-> MemoBytes t -> Decoder s (MemoBytes t)
forall a b. (a -> b) -> a -> b
$ t -> ByteString -> MemoBytes t
forall t. t -> ByteString -> MemoBytes t
mkMemoBytes t
rawType ByteString
lazyBytes

-- | Extract memoized SafeHash
getMemoSafeHash :: Memoized t => t -> SafeHash (MemoHashIndex (RawType t))
getMemoSafeHash :: forall t. Memoized t => t -> SafeHash (MemoHashIndex (RawType t))
getMemoSafeHash t
t = MemoBytes (RawType t) -> SafeHash (MemoHashIndex (RawType t))
forall t. MemoBytes t -> SafeHash (MemoHashIndex t)
mbHash (t -> MemoBytes (RawType t)
forall t. Memoized t => t -> MemoBytes (RawType t)
getMemoBytes t
t)

-- | Extract the raw type from the memoized version
getMemoRawType :: Memoized t => t -> RawType t
getMemoRawType :: forall t. Memoized t => t -> RawType t
getMemoRawType t
t = MemoBytes (RawType t) -> RawType t
forall t. MemoBytes t -> t
mbRawType (t -> MemoBytes (RawType t)
forall t. Memoized t => t -> MemoBytes (RawType t)
getMemoBytes t
t)

-- | Extract the raw bytes from the memoized version
getMemoRawBytes :: Memoized t => t -> ShortByteString
getMemoRawBytes :: forall t. Memoized t => t -> ShortByteString
getMemoRawBytes t
t = MemoBytes (RawType t) -> ShortByteString
forall t. MemoBytes t -> ShortByteString
mbBytes (t -> MemoBytes (RawType t)
forall t. Memoized t => t -> MemoBytes (RawType t)
getMemoBytes t
t)

-- | This is a helper function that operates on raw types of two memoized types.
zipMemoRawType ::
  (Memoized t1, Memoized t2) =>
  (RawType t1 -> RawType t2 -> a) ->
  t1 ->
  t2 ->
  a
zipMemoRawType :: forall t1 t2 a.
(Memoized t1, Memoized t2) =>
(RawType t1 -> RawType t2 -> a) -> t1 -> t2 -> a
zipMemoRawType RawType t1 -> RawType t2 -> a
f t1
x t2
y = RawType t1 -> RawType t2 -> a
f (t1 -> RawType t1
forall t. Memoized t => t -> RawType t
getMemoRawType t1
x) (t2 -> RawType t2
forall t. Memoized t => t -> RawType t
getMemoRawType t2
y)

eqRawType ::
  forall t.
  (Memoized t, Eq (RawType t)) =>
  t ->
  t ->
  Bool
eqRawType :: forall t. (Memoized t, Eq (RawType t)) => t -> t -> Bool
eqRawType = forall t1 t2 a.
(Memoized t1, Memoized t2) =>
(RawType t1 -> RawType t2 -> a) -> t1 -> t2 -> a
zipMemoRawType @t RawType t -> RawType t -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- | This is a helper Lens creator for any Memoized type.
lensMemoRawType ::
  forall era t a b.
  (Era era, EncCBOR (RawType t), Memoized t) =>
  (RawType t -> a) ->
  (RawType t -> b -> RawType t) ->
  Lens t t a b
lensMemoRawType :: forall era t a b.
(Era era, EncCBOR (RawType t), Memoized t) =>
(RawType t -> a) -> (RawType t -> b -> RawType t) -> Lens t t a b
lensMemoRawType RawType t -> a
getter RawType t -> b -> RawType t
setter =
  (t -> a) -> (t -> b -> t) -> Lens t t a b
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (RawType t -> a
getter (RawType t -> a) -> (t -> RawType t) -> t -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> RawType t
forall t. Memoized t => t -> RawType t
getMemoRawType) (\t
t b
b -> forall era t.
(Era era, EncCBOR (RawType t), Memoized t) =>
RawType t -> t
mkMemoizedEra @era (RawType t -> t) -> RawType t -> t
forall a b. (a -> b) -> a -> b
$ RawType t -> b -> RawType t
setter (t -> RawType t
forall t. Memoized t => t -> RawType t
getMemoRawType t
t) b
b)
{-# INLINEABLE lensMemoRawType #-}

-- | This is a helper SimpleGetter creator for any Memoized type
getterMemoRawType ::
  Memoized t =>
  (RawType t -> a) ->
  SimpleGetter t a
getterMemoRawType :: forall t a. Memoized t => (RawType t -> a) -> SimpleGetter t a
getterMemoRawType RawType t -> a
getter =
  (t -> a) -> SimpleGetter t a
forall s a. (s -> a) -> SimpleGetter s a
to (RawType t -> a
getter (RawType t -> a) -> (t -> RawType t) -> t -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> RawType t
forall t. Memoized t => t -> RawType t
getMemoRawType)
{-# INLINEABLE getterMemoRawType #-}

-- | Type class that implements equality on the Haskell type, ignoring any of the
-- potentially memoized binary representation of the type.
class EqRaw a where
  eqRaw :: a -> a -> Bool
  default eqRaw :: (a ~ t, Memoized t, Eq (RawType t)) => a -> a -> Bool
  eqRaw = a -> a -> Bool
forall t. (Memoized t, Eq (RawType t)) => t -> t -> Bool
eqRawType