{-# 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,

  -- * Tools
  runByteBuilder,
  encodeMemPack,
) 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 Codec.CBOR.ByteArray.Sliced (fromByteArray)
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
import qualified Data.MemPack as MP

-- | 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 -> LazyByteString
serialize Version
version =
  AllocationStrategy -> LazyByteString -> Builder -> LazyByteString
toLazyByteStringWith AllocationStrategy
strategy LazyByteString
forall a. Monoid a => a
mempty (Builder -> LazyByteString)
-> (a -> Builder) -> a -> LazyByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Encoding -> Builder
toBuilder Version
version (Encoding -> Builder) -> (a -> Encoding) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Encoding
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 = LazyByteString -> ByteString
BSL.toStrict (LazyByteString -> ByteString)
-> (a -> LazyByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> a -> LazyByteString
forall a. EncCBOR a => Version -> a -> LazyByteString
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 (Encoding -> Builder) -> (a -> Encoding) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Encoding
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 = (a -> ByteString) -> a -> Hash h a
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
C.hashWith (Version -> Encoding -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize' Version
version (Encoding -> ByteString) -> (a -> Encoding) -> a -> ByteString
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 = Version -> (a -> Encoding) -> a -> Hash h a
forall h a.
HashAlgorithm h =>
Version -> (a -> Encoding) -> a -> Hash h a
hashWithEncoder Version
version a -> Encoding
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 surround 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
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (Version -> Encoding) -> Encoding
withCurrentEncodingVersion (\Version
version -> LazyByteString -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Version -> a -> LazyByteString
forall a. EncCBOR a => Version -> a -> LazyByteString
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 :: LazyByteString -> Encoding
encodeNestedCborBytes LazyByteString
x = Word -> Encoding
encodeTag Word
24 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> LazyByteString -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR LazyByteString
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 =
  LazyByteString -> ByteString
BSL.toStrict (LazyByteString -> ByteString)
-> (Builder -> LazyByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AllocationStrategy -> LazyByteString -> Builder -> LazyByteString
toLazyByteStringWith (Int -> Int -> AllocationStrategy
safeStrategy Int
sizeHint (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sizeHint)) LazyByteString
forall a. Monoid a => a
mempty
{-# NOINLINE runByteBuilder #-}

-- | Encode as bytes using `MP.MemPack` and then encode those bytes as CBOR
encodeMemPack :: MP.MemPack a => a -> Encoding
encodeMemPack :: forall a. MemPack a => a -> Encoding
encodeMemPack = SlicedByteArray -> Encoding
encodeByteArray (SlicedByteArray -> Encoding)
-> (a -> SlicedByteArray) -> a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteArray -> SlicedByteArray
fromByteArray (ByteArray -> SlicedByteArray)
-> (a -> ByteArray) -> a -> SlicedByteArray
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteArray
forall a. (MemPack a, HasCallStack) => a -> ByteArray
MP.pack