{-# 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
forall a. Eq a => Sized a -> Sized a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sized a -> Sized a -> Bool
$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
Eq, Int -> Sized a -> ShowS
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
showList :: [Sized a] -> ShowS
$cshowList :: forall a. Show a => [Sized a] -> ShowS
show :: Sized a -> String
$cshow :: forall a. Show a => Sized a -> String
showsPrec :: Int -> Sized a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Sized a -> ShowS
Show, 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
$cto :: forall a x. Rep (Sized a) x -> Sized a
$cfrom :: forall a x. Sized a -> Rep (Sized a) x
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 forall a b. NFData a => a -> b -> b
`deepseq` Int64
sz seq :: 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 (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) <- forall s a. Decoder s a -> Decoder s (Annotated a ByteSpan)
annotatedDecoder Decoder s a
decoder
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall a. a -> Int64 -> Sized a
Sized a
v forall a b. (a -> b) -> a -> b
$! Int64
end 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 = forall s a. Decoder s a -> Decoder s (Sized a)
decodeSized 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
_) = 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 =
  forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\Sized s
sv -> forall a. Sized a -> a
sizedValue Sized s
sv forall s a. s -> Getting a s a -> a
^. Lens' s a
l) (\Sized s
sv a
a -> forall a. EncCBOR a => Version -> a -> Sized a
mkSized Version
version (forall a. Sized a -> a
sizedValue Sized s
sv forall a b. a -> (a -> b) -> b
& Lens' s a
l forall s t a b. ASetter s t a b -> b -> s -> t
.~ a
a))
{-# INLINEABLE toSizedL #-}