{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RankNTypes #-}

module Cardano.Ledger.Binary.Decoding.Sized (
  Sized (..),
  mkSized,
  decodeSized,
  toSizedL,
) where

import Cardano.Ledger.Binary.Decoding.Annotated (Annotated (..), ByteSpan (..), annotatedDecoder)
import Cardano.Ledger.Binary.Decoding.DecCBOR (DecCBOR (decCBOR))
import Cardano.Ledger.Binary.Decoding.Decoder (Decoder)
import Cardano.Ledger.Binary.Encoding (serialize)
import Cardano.Ledger.Binary.Encoding.EncCBOR (EncCBOR (encCBOR))
import Cardano.Ledger.Binary.Version (Version)
import Control.DeepSeq (NFData (..), deepseq)
import qualified Data.ByteString.Lazy as BSL
import Data.Int (Int64)
import GHC.Generics (Generic)
import Lens.Micro (Lens', lens, (&), (.~), (^.))
import NoThunks.Class (NoThunks)

-- | A CBOR deserialized value together with its size. When deserializing use
-- either `decodeSized` or its `DecCBOR` instance.
--
-- Use `mkSized` to construct such value.
data Sized a = Sized
  { forall a. Sized a -> a
sizedValue :: !a
  , forall a. Sized a -> Int64
sizedSize :: Int64
  -- ^ Overhead in bytes. The field is lazy on purpose, because it might not
  -- be needed, but it can be expensive to compute.
  }
  deriving (Sized a -> Sized a -> Bool
(Sized a -> Sized a -> Bool)
-> (Sized a -> Sized a -> Bool) -> Eq (Sized a)
forall a. Eq a => Sized a -> Sized a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Sized a -> Sized a -> Bool
== :: Sized a -> Sized a -> Bool
$c/= :: forall a. Eq a => Sized a -> Sized a -> Bool
/= :: Sized a -> Sized a -> Bool
Eq, Int -> Sized a -> ShowS
[Sized a] -> ShowS
Sized a -> String
(Int -> Sized a -> ShowS)
-> (Sized a -> String) -> ([Sized a] -> ShowS) -> Show (Sized a)
forall a. Show a => Int -> Sized a -> ShowS
forall a. Show a => [Sized a] -> ShowS
forall a. Show a => Sized a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Sized a -> ShowS
showsPrec :: Int -> Sized a -> ShowS
$cshow :: forall a. Show a => Sized a -> String
show :: Sized a -> String
$cshowList :: forall a. Show a => [Sized a] -> ShowS
showList :: [Sized a] -> ShowS
Show, (forall x. Sized a -> Rep (Sized a) x)
-> (forall x. Rep (Sized a) x -> Sized a) -> Generic (Sized a)
forall x. Rep (Sized a) x -> Sized a
forall x. Sized a -> Rep (Sized a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Sized a) x -> Sized a
forall a x. Sized a -> Rep (Sized a) x
$cfrom :: forall a x. Sized a -> Rep (Sized a) x
from :: forall x. Sized a -> Rep (Sized a) x
$cto :: forall a x. Rep (Sized a) x -> Sized a
to :: forall x. Rep (Sized a) x -> Sized a
Generic)

instance NoThunks a => NoThunks (Sized a)

instance NFData a => NFData (Sized a) where
  rnf :: Sized a -> ()
rnf (Sized a
val Int64
sz) = a
val a -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` Int64
sz Int64 -> () -> ()
forall a b. a -> b -> b
`seq` ()

-- | Construct a `Sized` value by serializing it first and recording the amount
-- of bytes it requires. Note, however, CBOR serialization is not canonical,
-- therefore it is *NOT* a requirement that this property holds:
--
-- > sizedSize (mkSized a) === sizedSize (unsafeDeserialize (serialize a) :: a)
mkSized :: EncCBOR a => Version -> a -> Sized a
mkSized :: forall a. EncCBOR a => Version -> a -> Sized a
mkSized Version
version a
a =
  Sized
    { sizedValue :: a
sizedValue = a
a
    , sizedSize :: Int64
sizedSize = ByteString -> Int64
BSL.length (Version -> a -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize Version
version a
a)
    }

decodeSized :: Decoder s a -> Decoder s (Sized a)
decodeSized :: forall s a. Decoder s a -> Decoder s (Sized a)
decodeSized Decoder s a
decoder = do
  Annotated a
v (ByteSpan Int64
start Int64
end) <- Decoder s a -> Decoder s (Annotated a ByteSpan)
forall s a. Decoder s a -> Decoder s (Annotated a ByteSpan)
annotatedDecoder Decoder s a
decoder
  Sized a -> Decoder s (Sized a)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sized a -> Decoder s (Sized a)) -> Sized a -> Decoder s (Sized a)
forall a b. (a -> b) -> a -> b
$! a -> Int64 -> Sized a
forall a. a -> Int64 -> Sized a
Sized a
v (Int64 -> Sized a) -> Int64 -> Sized a
forall a b. (a -> b) -> a -> b
$! Int64
end Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
start
{-# INLINE decodeSized #-}

instance DecCBOR a => DecCBOR (Sized a) where
  decCBOR :: forall s. Decoder s (Sized a)
decCBOR = Decoder s a -> Decoder s (Sized a)
forall s a. Decoder s a -> Decoder s (Sized a)
decodeSized Decoder s a
forall s. Decoder s a
forall a s. DecCBOR a => Decoder s a
decCBOR
  {-# INLINE decCBOR #-}

-- | Discards the size.
instance EncCBOR a => EncCBOR (Sized a) where
  -- Size is an auxiliary value and should not be transmitted over the wire,
  -- therefore it is ignored.
  encCBOR :: Sized a -> Encoding
encCBOR (Sized a
v Int64
_) = a -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR a
v

-- | Take a lens that operates on a particular type and convert it into a lens
-- that operates on the `Sized` version of the type.
toSizedL :: EncCBOR s => Version -> Lens' s a -> Lens' (Sized s) a
toSizedL :: forall s a. EncCBOR s => Version -> Lens' s a -> Lens' (Sized s) a
toSizedL Version
version Lens' s a
l =
  (Sized s -> a)
-> (Sized s -> a -> Sized s) -> Lens (Sized s) (Sized s) a a
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\Sized s
sv -> Sized s -> s
forall a. Sized a -> a
sizedValue Sized s
sv s -> Getting a s a -> a
forall s a. s -> Getting a s a -> a
^. Getting a s a
Lens' s a
l) (\Sized s
sv a
a -> Version -> s -> Sized s
forall a. EncCBOR a => Version -> a -> Sized a
mkSized Version
version (Sized s -> s
forall a. Sized a -> a
sizedValue Sized s
sv s -> (s -> s) -> s
forall a b. a -> (a -> b) -> b
& (a -> Identity a) -> s -> Identity s
Lens' s a
l ((a -> Identity a) -> s -> Identity s) -> a -> s -> s
forall s t a b. ASetter s t a b -> b -> s -> t
.~ a
a))
{-# INLINEABLE toSizedL #-}