{-# 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 = Encoding -> ByteString
serializeEncoding forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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 -> BS.ByteString
serialize' :: forall a. ToCBOR a => a -> ByteString
serialize' = ByteString -> ByteString
BSL.toStrict forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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 =
  AllocationStrategy -> ByteString -> Builder -> ByteString
Builder.toLazyByteStringWith AllocationStrategy
strategy forall a. Monoid a => a
mempty 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 -> BS.ByteString
serializeEncoding' :: Encoding -> ByteString
serializeEncoding' = ByteString -> ByteString
BSL.toStrict forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Encoding -> ByteString
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 :: forall a. ToCBOR a => a -> Encoding
encodeNestedCbor = ByteString -> Encoding
encodeNestedCborBytes forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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 forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR 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