{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Serialization primitives built on top of the @ToCBOR@ typeclass
module Cardano.Binary.Serialize (
  serialize,
  serialize',
  serializeBuilder,
  serializeEncoding,
  serializeEncoding',

  -- * CBOR in CBOR
  encodeNestedCbor,
  encodeNestedCborBytes,
  nestedCborSizeExpr,
  nestedCborBytesSizeExpr,
)
where

import Prelude hiding ((.))

import qualified Codec.CBOR.Write as CBOR.Write
import Control.Category ((.))
import qualified Data.ByteString as BS
import Data.ByteString.Builder (Builder)
import qualified Data.ByteString.Builder.Extra as Builder
import qualified Data.ByteString.Lazy as BSL

import Cardano.Binary.ToCBOR (
  Encoding,
  Size,
  ToCBOR (..),
  apMono,
  encodeTag,
  withWordSize,
 )

-- | Serialize a Haskell value with a 'ToCBOR' instance to an external binary
--   representation.
--
--   The output is represented as a lazy 'LByteString' and is constructed
--   incrementally.
serialize :: ToCBOR a => a -> BSL.ByteString
serialize :: forall a. ToCBOR a => a -> ByteString
serialize =
  AllocationStrategy -> ByteString -> Builder -> ByteString
Builder.toLazyByteStringWith AllocationStrategy
strategy ByteString
forall a. Monoid a => a
mempty (Builder -> ByteString) -> (a -> Builder) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Encoding -> Builder
CBOR.Write.toBuilder (Encoding -> Builder) -> (a -> Encoding) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
  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
Builder.safeStrategy Int
1024 Int
4096

-- | Serialize a Haskell value to an external binary representation.
--
--   The output is represented as a strict 'ByteString'.
serialize' :: ToCBOR a => a -> BS.ByteString
serialize' :: forall a. ToCBOR a => a -> ByteString
serialize' = ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize

-- | Serialize into a Builder. Useful if you want to throw other ByteStrings
--   around it.
serializeBuilder :: ToCBOR a => a -> Builder
serializeBuilder :: forall a. ToCBOR a => a -> Builder
serializeBuilder = Encoding -> Builder
CBOR.Write.toBuilder (Encoding -> Builder) -> (a -> Encoding) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR

-- | Serialize a Haskell value to an external binary representation using the
--   provided CBOR 'Encoding'
--
--   The output is represented as an 'LByteString' and is constructed
--   incrementally.
serializeEncoding :: Encoding -> BSL.ByteString
serializeEncoding :: Encoding -> ByteString
serializeEncoding = Encoding -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize
{-# DEPRECATED serializeEncoding "Use `serialize` instead, since `Encoding` has `ToCBOR` instance" #-}

-- | A strict version of 'serializeEncoding'
serializeEncoding' :: Encoding -> BS.ByteString
serializeEncoding' :: Encoding -> ByteString
serializeEncoding' = Encoding -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize'
{-# DEPRECATED serializeEncoding' "Use `serialize'` instead, since `Encoding` has `ToCBOR` instance" #-}

--------------------------------------------------------------------------------
-- 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 :: ToCBOR a => a -> Encoding
encodeNestedCbor :: forall a. ToCBOR a => a -> Encoding
encodeNestedCbor = ByteString -> Encoding
encodeNestedCborBytes (ByteString -> Encoding) -> (a -> ByteString) -> a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize

-- | 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 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ByteString
x

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

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