{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Cardano.Ledger.Binary.Encoding (
  -- * Running decoders
  serialize,
  serialize',
  serializeBuilder,

  -- ** Hash
  hashWithEncoder,
  hashEncCBOR,
  module Cardano.Ledger.Binary.Version,
  module Cardano.Ledger.Binary.Encoding.Encoder,
  module Cardano.Ledger.Binary.Encoding.EncCBOR,

  -- * Nested CBOR-in-CBOR
  encodeNestedCbor,
  encodeNestedCborBytes,
  nestedCborSizeExpr,
  nestedCborBytesSizeExpr,

  -- * Tools
  runByteBuilder,
)
where

import qualified Cardano.Crypto.Hash.Class as C
import Cardano.Ledger.Binary.Encoding.EncCBOR
import Cardano.Ledger.Binary.Encoding.Encoder
import Cardano.Ledger.Binary.Version
import qualified Data.ByteString as BS
import Data.ByteString.Builder (Builder)
import Data.ByteString.Builder.Extra (safeStrategy, toLazyByteStringWith)
import qualified Data.ByteString.Lazy as BSL

-- | Serialize a Haskell value with a 'EncCBOR' instance to an external binary
--   representation.
--
--   The output is represented as a lazy 'BSL.ByteString' and is constructed
--   incrementally.
serialize :: EncCBOR a => Version -> a -> BSL.ByteString
serialize :: forall a. EncCBOR a => Version -> a -> ByteString
serialize Version
version =
  AllocationStrategy -> ByteString -> Builder -> ByteString
toLazyByteStringWith AllocationStrategy
strategy forall a. Monoid a => a
mempty forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Encoding -> Builder
toBuilder Version
version forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. EncCBOR a => a -> Encoding
encCBOR
  where
    -- 1024 is the size of the first buffer, 4096 is the size of subsequent
    -- buffers. Chosen because they seem to give good performance. They are not
    -- sacred.
    strategy :: AllocationStrategy
strategy = Int -> Int -> AllocationStrategy
safeStrategy Int
1024 Int
4096

-- | Serialize a Haskell value to an external binary representation.
--
--   The output is represented as a strict 'ByteString'.
serialize' :: EncCBOR a => Version -> a -> BS.ByteString
serialize' :: forall a. EncCBOR a => Version -> a -> ByteString
serialize' Version
version = ByteString -> ByteString
BSL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. EncCBOR a => Version -> a -> ByteString
serialize Version
version

-- | Serialize into a Builder. Useful if you want to throw other ByteStrings
--   around it.
serializeBuilder :: EncCBOR a => Version -> a -> Builder
serializeBuilder :: forall a. EncCBOR a => Version -> a -> Builder
serializeBuilder Version
version = Version -> Encoding -> Builder
toBuilder Version
version forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. EncCBOR a => a -> Encoding
encCBOR

--------------------------------------------------------------------------------
-- Hashing
--------------------------------------------------------------------------------

hashWithEncoder :: forall h a. C.HashAlgorithm h => Version -> (a -> Encoding) -> a -> C.Hash h a
hashWithEncoder :: forall h a.
HashAlgorithm h =>
Version -> (a -> Encoding) -> a -> Hash h a
hashWithEncoder Version
version a -> Encoding
toEnc = forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
C.hashWith (forall a. EncCBOR a => Version -> a -> ByteString
serialize' Version
version forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Encoding
toEnc)

hashEncCBOR :: forall h a. (C.HashAlgorithm h, EncCBOR a) => Version -> a -> C.Hash h a
hashEncCBOR :: forall h a.
(HashAlgorithm h, EncCBOR a) =>
Version -> a -> Hash h a
hashEncCBOR Version
version = forall h a.
HashAlgorithm h =>
Version -> (a -> Encoding) -> a -> Hash h a
hashWithEncoder Version
version forall a. EncCBOR a => a -> Encoding
encCBOR

--------------------------------------------------------------------------------
-- Nested CBOR-in-CBOR
-- https://tools.ietf.org/html/rfc7049#section-2.4.4.1
--------------------------------------------------------------------------------

-- | Encode and serialise the given `a` and sorround it with the semantic tag 24
--   In CBOR diagnostic notation:
--   >>> 24(h'DEADBEEF')
encodeNestedCbor :: EncCBOR a => a -> Encoding
encodeNestedCbor :: forall a. EncCBOR a => a -> Encoding
encodeNestedCbor a
value =
  Word -> Encoding
encodeTag Word
24
    forall a. Semigroup a => a -> a -> a
<> (Version -> Encoding) -> Encoding
withCurrentEncodingVersion (\Version
version -> forall a. EncCBOR a => a -> Encoding
encCBOR (forall a. EncCBOR a => Version -> a -> ByteString
serialize Version
version a
value))

-- | Like `encodeNestedCbor`, but assumes nothing about the shape of
--   input object, so that it must be passed as a binary `ByteString` blob. It's
--   the caller responsibility to ensure the input `ByteString` correspond
--   indeed to valid, previously-serialised CBOR data.
encodeNestedCborBytes :: BSL.ByteString -> Encoding
encodeNestedCborBytes :: ByteString -> Encoding
encodeNestedCborBytes ByteString
x = Word -> Encoding
encodeTag Word
24 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR ByteString
x

nestedCborSizeExpr :: Size -> Size
nestedCborSizeExpr :: Size -> Size
nestedCborSizeExpr Size
x = Size
2 forall a. Num a => a -> a -> a
+ Text -> (Natural -> Natural) -> Size -> Size
apMono Text
"withWordSize" forall s a. (Integral s, Integral a) => s -> a
withWordSize Size
x forall a. Num a => a -> a -> a
+ Size
x

nestedCborBytesSizeExpr :: Size -> Size
nestedCborBytesSizeExpr :: Size -> Size
nestedCborBytesSizeExpr Size
x = Size
2 forall a. Num a => a -> a -> a
+ Text -> (Natural -> Natural) -> Size -> Size
apMono Text
"withWordSize" forall s a. (Integral s, Integral a) => s -> a
withWordSize Size
x forall a. Num a => a -> a -> a
+ Size
x

--------------------------------------------------------------------------------
-- Tools
--------------------------------------------------------------------------------

-- | Run a ByteString 'Builder' using a strategy aimed at making smaller
-- things efficiently.
--
-- It takes a size hint and produces a strict 'ByteString'. This will be fast
-- when the size hint is the same or slightly bigger than the true size.
runByteBuilder :: Int -> Builder -> BS.ByteString
runByteBuilder :: Int -> Builder -> ByteString
runByteBuilder !Int
sizeHint =
  ByteString -> ByteString
BSL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. AllocationStrategy -> ByteString -> Builder -> ByteString
toLazyByteStringWith (Int -> Int -> AllocationStrategy
safeStrategy Int
sizeHint (Int
2 forall a. Num a => a -> a -> a
* Int
sizeHint)) forall a. Monoid a => a
mempty
{-# NOINLINE runByteBuilder #-}