{-# 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 Cardano.Prelude

import qualified Codec.CBOR.Write as CBOR.Write
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 -> LByteString
serialize :: a -> LByteString
serialize = Encoding -> LByteString
serializeEncoding (Encoding -> LByteString) -> (a -> Encoding) -> a -> LByteString
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.
--
--   The output is represented as a strict 'ByteString'.
serialize' :: ToCBOR a => a -> ByteString
serialize' :: a -> ByteString
serialize' = LByteString -> ByteString
BSL.toStrict (LByteString -> ByteString)
-> (a -> LByteString) -> a -> ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> LByteString
forall a. ToCBOR a => a -> LByteString
serialize

-- | Serialize into a Builder. Useful if you want to throw other ByteStrings
--   around it.
serializeBuilder :: ToCBOR a => a -> Builder
serializeBuilder :: a -> Builder
serializeBuilder = Encoding -> Builder
CBOR.Write.toBuilder (Encoding -> Builder) -> (a -> Encoding) -> a -> Builder
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 -> LByteString
serializeEncoding :: Encoding -> LByteString
serializeEncoding =
  AllocationStrategy -> LByteString -> Builder -> LByteString
Builder.toLazyByteStringWith AllocationStrategy
strategy LByteString
forall a. Monoid a => a
mempty (Builder -> LByteString)
-> (Encoding -> Builder) -> Encoding -> LByteString
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
  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

-- | A strict version of 'serializeEncoding'
serializeEncoding' :: Encoding -> ByteString
serializeEncoding' :: Encoding -> ByteString
serializeEncoding' = LByteString -> ByteString
BSL.toStrict (LByteString -> ByteString)
-> (Encoding -> LByteString) -> Encoding -> ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Encoding -> LByteString
serializeEncoding


--------------------------------------------------------------------------------
-- 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 :: a -> Encoding
encodeNestedCbor = LByteString -> Encoding
encodeNestedCborBytes (LByteString -> Encoding) -> (a -> LByteString) -> a -> Encoding
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> LByteString
forall a. ToCBOR a => a -> LByteString
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 :: LByteString -> Encoding
encodeNestedCborBytes :: LByteString -> Encoding
encodeNestedCborBytes LByteString
x = Word -> Encoding
encodeTag Word
24 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> LByteString -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR LByteString
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