{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- | Defines reusable abstractions for testing RoundTrip properties of plain encoders/decoders
module Test.Cardano.Ledger.Binary.Plain.RoundTrip (
  roundTripSpec,
  roundTripFailureExpectation,
  roundTripExpectation,
  roundTripCborExpectation,
  embedTripSpec,
  embedTripExpectation,
  RoundTripFailure (..),
  showMaybeDecoderError,
  showFailedTermsWithReSerialization,
  Trip (..),
  mkTrip,
  cborTrip,
  roundTrip,
  embedTrip,
  embedTripLabel,
) where

import Cardano.Ledger.Binary.Plain
import qualified Codec.CBOR.FlatTerm as CBOR
import qualified Data.ByteString.Lazy as BSL
import Data.Proxy
import qualified Data.Text as Text
import Data.Typeable
import qualified Formatting.Buildable as B (Buildable (..))
import Test.Cardano.Ledger.Binary.TreeDiff (
  CBORBytes (..),
  ansiExprString,
  diffExprString,
  showHexBytesGrouped,
 )
import Test.Hspec
import Test.Hspec.QuickCheck (prop)
import Test.QuickCheck hiding (label)

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

-- | Tests the roundtrip property using QuickCheck generators for all possible versions
-- starting with `shelleyProtVer`.
roundTripSpec ::
  forall t.
  (Show t, Eq t, Typeable t, Arbitrary t) =>
  Trip t t ->
  Spec
roundTripSpec :: forall t.
(Show t, Eq t, Typeable t, Arbitrary t) =>
Trip t t -> Spec
roundTripSpec Trip t t
trip =
  String -> (t -> Expectation) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop (TypeRep -> String
forall a. Show a => a -> String
show (Proxy t -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy t -> TypeRep) -> Proxy t -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @t)) ((t -> Expectation) -> Spec) -> (t -> Expectation) -> Spec
forall a b. (a -> b) -> a -> b
$ Trip t t -> t -> Expectation
forall t.
(Show t, Eq t, Typeable t, HasCallStack) =>
Trip t t -> t -> Expectation
roundTripExpectation Trip t t
trip

-- | Tests the embedtrip property using QuickCheck generators
embedTripSpec ::
  forall a b.
  (Eq b, Show a, Typeable a, Typeable b, Arbitrary a, HasCallStack) =>
  Trip a b ->
  (b -> a -> Expectation) ->
  Spec
embedTripSpec :: forall a b.
(Eq b, Show a, Typeable a, Typeable b, Arbitrary a,
 HasCallStack) =>
Trip a b -> (b -> a -> Expectation) -> Spec
embedTripSpec Trip a b
trip b -> a -> Expectation
f =
  String -> (a -> Expectation) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop (String
"From: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeRep -> String
forall a. Show a => a -> String
show (Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a -> TypeRep) -> Proxy a -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" To " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeRep -> String
forall a. Show a => a -> String
show (Proxy b -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy b -> TypeRep) -> Proxy b -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)) ((a -> Expectation) -> Spec) -> (a -> Expectation) -> Spec
forall a b. (a -> b) -> a -> b
$
    Trip a b -> (b -> a -> Expectation) -> a -> Expectation
forall a b.
(Typeable b, Eq b, HasCallStack) =>
Trip a b -> (b -> a -> Expectation) -> a -> Expectation
embedTripExpectation Trip a b
trip b -> a -> Expectation
f

-- Tests that a decoder error happens
roundTripFailureExpectation :: forall a. (Eq a, ToCBOR a, FromCBOR a) => a -> Expectation
roundTripFailureExpectation :: forall a. (Eq a, ToCBOR a, FromCBOR a) => a -> Expectation
roundTripFailureExpectation a
x =
  case Trip a a -> a -> Either RoundTripFailure a
forall t.
(Eq t, Typeable t) =>
Trip t t -> t -> Either RoundTripFailure t
roundTrip (forall a b. (ToCBOR a, FromCBOR b) => Trip a b
cborTrip @a) a
x of
    Left RoundTripFailure
_ -> () -> Expectation
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Right a
_ ->
      HasCallStack => String -> Expectation
String -> Expectation
expectationFailure (String -> Expectation) -> String -> Expectation
forall a b. (a -> b) -> a -> b
$
        String
"Should not have deserialized: "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> CBORBytes -> String
forall a. ToExpr a => a -> String
ansiExprString (ByteString -> CBORBytes
CBORBytes (a -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize' a
x))

-- | Verify that round triping through the binary form holds
roundTripExpectation ::
  (Show t, Eq t, Typeable t, HasCallStack) =>
  Trip t t ->
  t ->
  Expectation
roundTripExpectation :: forall t.
(Show t, Eq t, Typeable t, HasCallStack) =>
Trip t t -> t -> Expectation
roundTripExpectation Trip t t
trip t
t =
  case Trip t t -> t -> Either RoundTripFailure t
forall t.
(Eq t, Typeable t) =>
Trip t t -> t -> Either RoundTripFailure t
roundTrip Trip t t
trip t
t of
    Left RoundTripFailure
err -> HasCallStack => String -> Expectation
String -> Expectation
expectationFailure (String -> Expectation) -> String -> Expectation
forall a b. (a -> b) -> a -> b
$ String
"Failed to deserialize encoded:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ RoundTripFailure -> String
forall a. Show a => a -> String
show RoundTripFailure
err
    Right t
tDecoded -> t
tDecoded t -> t -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` t
t

roundTripCborExpectation ::
  forall t.
  (Show t, Eq t, FromCBOR t, ToCBOR t, HasCallStack) =>
  t ->
  Expectation
roundTripCborExpectation :: forall t.
(Show t, Eq t, FromCBOR t, ToCBOR t, HasCallStack) =>
t -> Expectation
roundTripCborExpectation = Trip t t -> t -> Expectation
forall t.
(Show t, Eq t, Typeable t, HasCallStack) =>
Trip t t -> t -> Expectation
roundTripExpectation (forall a b. (ToCBOR a, FromCBOR b) => Trip a b
cborTrip @t)

embedTripExpectation ::
  forall a b.
  (Typeable b, Eq b, HasCallStack) =>
  Trip a b ->
  (b -> a -> Expectation) ->
  a ->
  Expectation
embedTripExpectation :: forall a b.
(Typeable b, Eq b, HasCallStack) =>
Trip a b -> (b -> a -> Expectation) -> a -> Expectation
embedTripExpectation Trip a b
trip b -> a -> Expectation
f a
t =
  case Trip a b -> a -> Either RoundTripFailure b
forall a b.
(Eq b, Typeable b) =>
Trip a b -> a -> Either RoundTripFailure b
embedTrip Trip a b
trip a
t of
    Left RoundTripFailure
err -> HasCallStack => String -> Expectation
String -> Expectation
expectationFailure (String -> Expectation) -> String -> Expectation
forall a b. (a -> b) -> a -> b
$ String
"Failed to deserialize encoded:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ RoundTripFailure -> String
forall a. Show a => a -> String
show RoundTripFailure
err
    Right b
tDecoded -> b -> a -> Expectation
f b
tDecoded a
t

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

data RoundTripFailure = RoundTripFailure
  { RoundTripFailure -> Encoding
rtfEncoding :: Encoding
  -- ^ Produced plain encoding
  , RoundTripFailure -> ByteString
rtfEncodedBytes :: BSL.ByteString
  -- ^ Serialized encoding
  , RoundTripFailure -> Maybe ByteString
rtfReEncodedBytes :: Maybe BSL.ByteString
  -- ^ Re-serialized bytes, if there was a mismatch between the binary form and the
  -- reserialization of the data type.
  , RoundTripFailure -> Maybe String
rtfFlatTermError :: Maybe String
  -- ^ Roundtripping through FlatTerm
  , RoundTripFailure -> Maybe DecoderError
rtfDecoderError :: Maybe DecoderError
  -- ^ Error received while decoding the produced bytes.
  }

instance Show RoundTripFailure where
  show :: RoundTripFailure -> String
show RoundTripFailure {Maybe String
Maybe ByteString
Maybe DecoderError
ByteString
Encoding
rtfEncoding :: RoundTripFailure -> Encoding
rtfEncodedBytes :: RoundTripFailure -> ByteString
rtfReEncodedBytes :: RoundTripFailure -> Maybe ByteString
rtfFlatTermError :: RoundTripFailure -> Maybe String
rtfDecoderError :: RoundTripFailure -> Maybe DecoderError
rtfEncoding :: Encoding
rtfEncodedBytes :: ByteString
rtfReEncodedBytes :: Maybe ByteString
rtfFlatTermError :: Maybe String
rtfDecoderError :: Maybe DecoderError
..} =
    [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
      [ String -> Maybe DecoderError -> String
forall b. Buildable b => String -> Maybe b -> String
showMaybeDecoderError String
"Decoder" Maybe DecoderError
rtfDecoderError
      , String -> Maybe String -> String
forall b. Buildable b => String -> Maybe b -> String
showMaybeDecoderError String
"FlatTerm" Maybe String
rtfFlatTermError
      ]
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"Original did not match the reserialization (see below)."
           | Just ByteString
_ <- Maybe ByteString -> [Maybe ByteString]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByteString
rtfReEncodedBytes
           ]
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ByteString -> Maybe ByteString -> [String]
showFailedTermsWithReSerialization ByteString
rtfEncodedBytes Maybe ByteString
rtfReEncodedBytes

showMaybeDecoderError :: B.Buildable b => String -> Maybe b -> String
showMaybeDecoderError :: forall b. Buildable b => String -> Maybe b -> String
showMaybeDecoderError String
name = \case
  Maybe b
Nothing -> String
"No " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" error"
  Just b
err -> String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ b -> String
forall e. Buildable e => e -> String
showDecoderError b
err

showFailedTermsWithReSerialization ::
  BSL.ByteString ->
  Maybe BSL.ByteString ->
  [String]
showFailedTermsWithReSerialization :: ByteString -> Maybe ByteString -> [String]
showFailedTermsWithReSerialization ByteString
encodedBytes Maybe ByteString
mReEncodedBytes =
  case Maybe ByteString
mReEncodedBytes of
    Maybe ByteString
Nothing ->
      -- This is the usual case where re-serialization is successful
      let (Either String Term
_, [String]
origHex, [String]
origStr) = String -> ByteString -> (Either String Term, [String], [String])
termWithHex String
"Original" ByteString
encodedBytes
       in [String]
origStr [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"OriginalHex:"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
origHex
    Just ByteString
reBytes ->
      -- On a rare occasion when re-serialization does not match we try to show the
      -- diff of Hex as well as Terms
      case (String -> ByteString -> (Either String Term, [String], [String])
termWithHex String
"Original" ByteString
encodedBytes, String -> ByteString -> (Either String Term, [String], [String])
termWithHex String
"Reserialization" ByteString
reBytes) of
        ((Right Term
origTerm, [String]
origHex, [String]
_), (Right Term
reTerm, [String]
reHex, [String]
_)) ->
          [(Term, [String]) -> (Term, [String]) -> String
forall a. ToExpr a => a -> a -> String
diffExprString (Term
origTerm, [String]
origHex) (Term
reTerm, [String]
reHex)]
        ((Either String Term
_, [String]
origHex, [String]
origStr), (Either String Term
_, [String]
reHex, [String]
reStr)) ->
          [String] -> [String] -> String
forall a. ToExpr a => a -> a -> String
diffExprString [String]
origHex [String]
reHex String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
origStr [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
reStr
  where
    termWithHex :: String -> ByteString -> (Either String Term, [String], [String])
termWithHex String
name ByteString
lazyBytes =
      let bytes :: ByteString
bytes = ByteString -> ByteString
BSL.toStrict ByteString
lazyBytes
          decTerm :: Either String Term
decTerm = case Text
-> (forall s. Decoder s Term)
-> ByteString
-> Either DecoderError Term
forall a.
Text
-> (forall s. Decoder s a) -> ByteString -> Either DecoderError a
decodeFullDecoder' Text
"Term" Decoder s Term
forall s. Decoder s Term
decodeTerm ByteString
bytes of
            Left DecoderError
err -> String -> Either String Term
forall a b. a -> Either a b
Left (String -> Either String Term) -> String -> Either String Term
forall a b. (a -> b) -> a -> b
$ String
"Could not decode as Term: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> DecoderError -> String
forall a. Show a => a -> String
show DecoderError
err
            Right Term
term -> Term -> Either String Term
forall a b. b -> Either a b
Right Term
term
          hexLines :: [String]
hexLines = Int -> ByteString -> [String]
showHexBytesGrouped Int
128 ByteString
bytes
       in (Either String Term
decTerm, [String]
hexLines, [String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
":", (String -> String)
-> (Term -> String) -> Either String Term -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> String
forall a. a -> a
id Term -> String
forall a. ToExpr a => a -> String
ansiExprString Either String Term
decTerm])

-- | A definition of a CBOR trip through binary representation of one type to
-- another. In this module this is called an embed. When a source and target type is the
-- exact same one then it would be a dual and is expected to round trip.
data Trip a b = Trip
  { forall a b. Trip a b -> a -> Encoding
tripEncoder :: a -> Encoding
  , forall a b. Trip a b -> forall s. Decoder s b
tripDecoder :: forall s. Decoder s b
  }

cborTrip :: forall a b. (ToCBOR a, FromCBOR b) => Trip a b
cborTrip :: forall a b. (ToCBOR a, FromCBOR b) => Trip a b
cborTrip = (a -> Encoding) -> (forall s. Decoder s b) -> Trip a b
forall a b. (a -> Encoding) -> (forall s. Decoder s b) -> Trip a b
Trip a -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Decoder s b
forall s. Decoder s b
forall a s. FromCBOR a => Decoder s a
fromCBOR

-- | Construct a `Trip` using encoder and decoder, with dropper set to the decoder which
-- drops the value
mkTrip :: forall a b. (a -> Encoding) -> (forall s. Decoder s b) -> Trip a b
mkTrip :: forall a b. (a -> Encoding) -> (forall s. Decoder s b) -> Trip a b
mkTrip = (a -> Encoding) -> (forall s. Decoder s b) -> Trip a b
forall a b. (a -> Encoding) -> (forall s. Decoder s b) -> Trip a b
Trip

roundTrip :: forall t. (Eq t, Typeable t) => Trip t t -> t -> Either RoundTripFailure t
roundTrip :: forall t.
(Eq t, Typeable t) =>
Trip t t -> t -> Either RoundTripFailure t
roundTrip Trip t t
trip t
val = do
  (t
val', Encoding
encoding, ByteString
encodedBytes) <- Text
-> Trip t t
-> t
-> Either RoundTripFailure (t, Encoding, ByteString)
forall a b.
Eq b =>
Text
-> Trip a b
-> a
-> Either RoundTripFailure (b, Encoding, ByteString)
embedTripLabelExtra (forall t. Typeable t => Text
typeLabel @t) Trip t t
trip t
val
  let reserialized :: ByteString
reserialized = Encoding -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize (Trip t t -> t -> Encoding
forall a b. Trip a b -> a -> Encoding
tripEncoder Trip t t
trip t
val')
  if ByteString
reserialized ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
encodedBytes
    then
      RoundTripFailure -> Either RoundTripFailure t
forall a b. a -> Either a b
Left (RoundTripFailure -> Either RoundTripFailure t)
-> RoundTripFailure -> Either RoundTripFailure t
forall a b. (a -> b) -> a -> b
$
        Encoding
-> ByteString
-> Maybe ByteString
-> Maybe String
-> Maybe DecoderError
-> RoundTripFailure
RoundTripFailure Encoding
encoding ByteString
encodedBytes (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
reserialized) Maybe String
forall a. Maybe a
Nothing Maybe DecoderError
forall a. Maybe a
Nothing
    else t -> Either RoundTripFailure t
forall a b. b -> Either a b
Right t
val'

embedTripLabel ::
  forall a b.
  Eq b =>
  Text.Text ->
  Trip a b ->
  a ->
  Either RoundTripFailure b
embedTripLabel :: forall a b.
Eq b =>
Text -> Trip a b -> a -> Either RoundTripFailure b
embedTripLabel Text
lbl Trip a b
trip a
s =
  (\(b
val, Encoding
_, ByteString
_) -> b
val) ((b, Encoding, ByteString) -> b)
-> Either RoundTripFailure (b, Encoding, ByteString)
-> Either RoundTripFailure b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> Trip a b
-> a
-> Either RoundTripFailure (b, Encoding, ByteString)
forall a b.
Eq b =>
Text
-> Trip a b
-> a
-> Either RoundTripFailure (b, Encoding, ByteString)
embedTripLabelExtra Text
lbl Trip a b
trip a
s

embedTripLabelExtra ::
  forall a b.
  Eq b =>
  Text.Text ->
  Trip a b ->
  a ->
  Either RoundTripFailure (b, Encoding, BSL.ByteString)
embedTripLabelExtra :: forall a b.
Eq b =>
Text
-> Trip a b
-> a
-> Either RoundTripFailure (b, Encoding, ByteString)
embedTripLabelExtra Text
lbl (Trip a -> Encoding
encoder forall s. Decoder s b
decoder) a
s =
  case Text
-> (forall s. Decoder s b) -> ByteString -> Either DecoderError b
forall a.
Text
-> (forall s. Decoder s a) -> ByteString -> Either DecoderError a
decodeFullDecoder Text
lbl Decoder s b
forall s. Decoder s b
decoder ByteString
encodedBytes of
    Right b
val ->
      let flatTerm :: FlatTerm
flatTerm = Encoding -> FlatTerm
CBOR.toFlatTerm Encoding
encoding
       in case (forall s. Decoder s b) -> FlatTerm -> Either String b
forall a. (forall s. Decoder s a) -> FlatTerm -> Either String a
CBOR.fromFlatTerm Decoder s b
forall s. Decoder s b
decoder FlatTerm
flatTerm of
            Left String
err -> RoundTripFailure
-> Either RoundTripFailure (b, Encoding, ByteString)
forall a b. a -> Either a b
Left (RoundTripFailure
 -> Either RoundTripFailure (b, Encoding, ByteString))
-> RoundTripFailure
-> Either RoundTripFailure (b, Encoding, ByteString)
forall a b. (a -> b) -> a -> b
$ Maybe ByteString
-> Maybe String -> Maybe DecoderError -> RoundTripFailure
mkFailure Maybe ByteString
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
err) Maybe DecoderError
forall a. Maybe a
Nothing
            Right b
valFromFlatTerm
              | b
val b -> b -> Bool
forall a. Eq a => a -> a -> Bool
/= b
valFromFlatTerm ->
                  let errMsg :: String
errMsg =
                        String
"Deserializoing through FlatTerm produced a different "
                          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"value then the regular deserializer did"
                   in RoundTripFailure
-> Either RoundTripFailure (b, Encoding, ByteString)
forall a b. a -> Either a b
Left (RoundTripFailure
 -> Either RoundTripFailure (b, Encoding, ByteString))
-> RoundTripFailure
-> Either RoundTripFailure (b, Encoding, ByteString)
forall a b. (a -> b) -> a -> b
$ Maybe ByteString
-> Maybe String -> Maybe DecoderError -> RoundTripFailure
mkFailure Maybe ByteString
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
errMsg) Maybe DecoderError
forall a. Maybe a
Nothing
              | Bool -> Bool
not (FlatTerm -> Bool
CBOR.validFlatTerm FlatTerm
flatTerm) ->
                  let errMsg :: String
errMsg =
                        String
"Despite successful deserialization the produced "
                          String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"FlatTerm for the type is not valid"
                   in RoundTripFailure
-> Either RoundTripFailure (b, Encoding, ByteString)
forall a b. a -> Either a b
Left (RoundTripFailure
 -> Either RoundTripFailure (b, Encoding, ByteString))
-> RoundTripFailure
-> Either RoundTripFailure (b, Encoding, ByteString)
forall a b. (a -> b) -> a -> b
$ Maybe ByteString
-> Maybe String -> Maybe DecoderError -> RoundTripFailure
mkFailure Maybe ByteString
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
errMsg) Maybe DecoderError
forall a. Maybe a
Nothing
              | Bool
otherwise -> (b, Encoding, ByteString)
-> Either RoundTripFailure (b, Encoding, ByteString)
forall a b. b -> Either a b
Right (b
val, Encoding
encoding, ByteString
encodedBytes)
    Left DecoderError
err ->
      RoundTripFailure
-> Either RoundTripFailure (b, Encoding, ByteString)
forall a b. a -> Either a b
Left (RoundTripFailure
 -> Either RoundTripFailure (b, Encoding, ByteString))
-> RoundTripFailure
-> Either RoundTripFailure (b, Encoding, ByteString)
forall a b. (a -> b) -> a -> b
$ Maybe ByteString
-> Maybe String -> Maybe DecoderError -> RoundTripFailure
mkFailure Maybe ByteString
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing (DecoderError -> Maybe DecoderError
forall a. a -> Maybe a
Just DecoderError
err)
  where
    mkFailure :: Maybe ByteString
-> Maybe String -> Maybe DecoderError -> RoundTripFailure
mkFailure = Encoding
-> ByteString
-> Maybe ByteString
-> Maybe String
-> Maybe DecoderError
-> RoundTripFailure
RoundTripFailure Encoding
encoding ByteString
encodedBytes
    encoding :: Encoding
encoding = a -> Encoding
encoder a
s
    encodedBytes :: ByteString
encodedBytes = Encoding -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize Encoding
encoding

-- | Can we serialise a type, and then deserialise it as something else?
embedTrip ::
  forall a b.
  (Eq b, Typeable b) =>
  Trip a b ->
  a ->
  Either RoundTripFailure b
embedTrip :: forall a b.
(Eq b, Typeable b) =>
Trip a b -> a -> Either RoundTripFailure b
embedTrip = Text -> Trip a b -> a -> Either RoundTripFailure b
forall a b.
Eq b =>
Text -> Trip a b -> a -> Either RoundTripFailure b
embedTripLabel (String -> Text
Text.pack (TypeRep -> String
forall a. Show a => a -> String
show (Proxy b -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy b -> TypeRep) -> Proxy b -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)))

typeLabel :: forall t. Typeable t => Text.Text
typeLabel :: forall t. Typeable t => Text
typeLabel = String -> Text
Text.pack (TypeRep -> String
forall a. Show a => a -> String
show (Proxy t -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy t -> TypeRep) -> Proxy t -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @t))