{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Defines reusable abstractions for testing Roundtrip properties of CBOR instances
module Data.Roundtrip
  ( roundTrip,
    roundTrip',
    embedTrip,
    embedTrip',
    roundTripAnn,
    embedTripAnn,
    RoundTripResult,
  )
where

import Cardano.Binary
  ( Annotator (..),
    FromCBOR (fromCBOR),
    FullByteString (Full),
    ToCBOR (toCBOR),
  )
import Codec.CBOR.Decoding (Decoder)
import Codec.CBOR.Encoding (Encoding)
import Codec.CBOR.Read (DeserialiseFailure, deserialiseFromBytes)
import Codec.CBOR.Write (toLazyByteString)
import qualified Data.ByteString.Lazy as Lazy

-- =====================================================================

type RoundTripResult t = Either Codec.CBOR.Read.DeserialiseFailure (Lazy.ByteString, t)

roundTrip :: (ToCBOR t, FromCBOR t) => t -> RoundTripResult t
roundTrip :: t -> RoundTripResult t
roundTrip t
s = (forall s. Decoder s t) -> ByteString -> RoundTripResult t
forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
deserialiseFromBytes forall s. Decoder s t
forall a s. FromCBOR a => Decoder s a
fromCBOR (Encoding -> ByteString
toLazyByteString (t -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR t
s))

roundTrip' :: (t -> Encoding) -> (forall s. Decoder s t) -> t -> RoundTripResult t
roundTrip' :: (t -> Encoding)
-> (forall s. Decoder s t) -> t -> RoundTripResult t
roundTrip' t -> Encoding
enc forall s. Decoder s t
dec t
t = (forall s. Decoder s t) -> ByteString -> RoundTripResult t
forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
deserialiseFromBytes forall s. Decoder s t
dec (Encoding -> ByteString
toLazyByteString (t -> Encoding
enc t
t))

roundTripAnn :: (ToCBOR t, FromCBOR (Annotator t)) => t -> RoundTripResult t
roundTripAnn :: t -> RoundTripResult t
roundTripAnn t
s =
  let bytes :: ByteString
bytes = Encoding -> ByteString
toLazyByteString (t -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR t
s)
   in case (forall s. Decoder s (Annotator t))
-> ByteString
-> Either DeserialiseFailure (ByteString, Annotator t)
forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
deserialiseFromBytes forall s. Decoder s (Annotator t)
forall a s. FromCBOR a => Decoder s a
fromCBOR ByteString
bytes of
        Left DeserialiseFailure
err -> DeserialiseFailure -> RoundTripResult t
forall a b. a -> Either a b
Left DeserialiseFailure
err
        Right (ByteString
leftover, Annotator FullByteString -> t
f) -> (ByteString, t) -> RoundTripResult t
forall a b. b -> Either a b
Right (ByteString
leftover, FullByteString -> t
f (ByteString -> FullByteString
Full ByteString
bytes))

-- | Can we serialise a type, and then deserialise it as something else?
embedTrip :: (ToCBOR t, FromCBOR s) => t -> RoundTripResult s
embedTrip :: t -> RoundTripResult s
embedTrip t
s = (forall s. Decoder s s) -> ByteString -> RoundTripResult s
forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
deserialiseFromBytes forall s. Decoder s s
forall a s. FromCBOR a => Decoder s a
fromCBOR (Encoding -> ByteString
toLazyByteString (t -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR t
s))

embedTrip' :: (s -> Encoding) -> (forall x. Decoder x t) -> s -> RoundTripResult t
embedTrip' :: (s -> Encoding)
-> (forall x. Decoder x t) -> s -> RoundTripResult t
embedTrip' s -> Encoding
enc forall x. Decoder x t
dec s
s = (forall x. Decoder x t) -> ByteString -> RoundTripResult t
forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
deserialiseFromBytes forall x. Decoder x t
dec (Encoding -> ByteString
toLazyByteString (s -> Encoding
enc s
s))

embedTripAnn :: forall s t. (ToCBOR t, FromCBOR (Annotator s)) => t -> RoundTripResult s
embedTripAnn :: t -> RoundTripResult s
embedTripAnn t
s =
  let bytes :: ByteString
bytes = Encoding -> ByteString
toLazyByteString (t -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR t
s)
   in case (forall s. Decoder s (Annotator s))
-> ByteString
-> Either DeserialiseFailure (ByteString, Annotator s)
forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
deserialiseFromBytes forall s. Decoder s (Annotator s)
forall a s. FromCBOR a => Decoder s a
fromCBOR ByteString
bytes of
        Left DeserialiseFailure
err -> DeserialiseFailure -> RoundTripResult s
forall a b. a -> Either a b
Left DeserialiseFailure
err
        Right (ByteString
leftover, Annotator FullByteString -> s
f) -> (ByteString, s) -> RoundTripResult s
forall a b. b -> Either a b
Right (ByteString
leftover, FullByteString -> s
f (ByteString -> FullByteString
Full ByteString
bytes))