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

module Test.Cardano.Ledger.Binary.Plain.Golden (
  Enc (E, Ev, Em),
  DiffView (..),
  expectGoldenEncoding,
  expectGoldenToCBOR,
  expectGoldenEncBytes,
  expectGoldenEncLazyBytes,
  expectGoldenEncHexBytes,
) where

import Cardano.Ledger.Binary (EncCBOR (encCBOR), Version, toPlainEncoding)
import Cardano.Ledger.Binary.Plain
import qualified Data.ByteString as BS
import Data.ByteString.Base16 as BS16
import qualified Data.ByteString.Lazy as BSL
import Test.Cardano.Ledger.Binary.TreeDiff
import Test.Hspec

data Enc where
  E :: ToCBOR a => a -> Enc
  Ev :: EncCBOR a => Version -> a -> Enc
  Em :: [Enc] -> Enc
  (:<>:) :: Enc -> Enc -> Enc

instance ToCBOR Enc where
  toCBOR :: Enc -> Encoding
toCBOR (E a
s) = forall a. ToCBOR a => a -> Encoding
toCBOR a
s
  toCBOR (Ev Version
v a
s) = Version -> Encoding -> Encoding
toPlainEncoding Version
v forall a b. (a -> b) -> a -> b
$ forall a. EncCBOR a => a -> Encoding
encCBOR a
s
  toCBOR (Em [Enc]
m) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a. ToCBOR a => a -> Encoding
toCBOR [Enc]
m
  toCBOR (Enc
a :<>: Enc
b) = forall a. ToCBOR a => a -> Encoding
toCBOR Enc
a forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR Enc
b

instance Semigroup Enc where
  <> :: Enc -> Enc -> Enc
(<>) = Enc -> Enc -> Enc
(:<>:)

instance Monoid Enc where
  mempty :: Enc
mempty = forall a. ToCBOR a => a -> Enc
E (forall a. Monoid a => a
mempty :: Encoding)

-- | Indicator of the format in which the diff should be displayed.
data DiffView
  = -- | TreeDiff bytes as CBOR Terms
    DiffCBOR
  | -- | TreeDiff bytes as Base64 encoded strings
    DiffHex
  | -- | TreeDiff will be shown on raw bytes.
    DiffRaw
  | -- | Let hspec handle the diffing
    DiffAuto

expectGoldenEncoding ::
  HasCallStack => (a -> Encoding) -> (b -> Encoding) -> DiffView -> a -> b -> Expectation
expectGoldenEncoding :: forall a b.
HasCallStack =>
(a -> Encoding)
-> (b -> Encoding) -> DiffView -> a -> b -> Expectation
expectGoldenEncoding a -> Encoding
encActual b -> Encoding
encExpected DiffView
viewDiff a
actual b
expected =
  forall a.
(HasCallStack, ToCBOR a) =>
DiffView -> a -> ByteString -> Expectation
expectGoldenEncBytes DiffView
viewDiff (a -> Encoding
encActual a
actual) (forall a. ToCBOR a => a -> ByteString
serialize' (b -> Encoding
encExpected b
expected))

expectGoldenToCBOR ::
  (HasCallStack, ToCBOR a, ToCBOR b) => DiffView -> a -> b -> Expectation
expectGoldenToCBOR :: forall a b.
(HasCallStack, ToCBOR a, ToCBOR b) =>
DiffView -> a -> b -> Expectation
expectGoldenToCBOR = forall a b.
HasCallStack =>
(a -> Encoding)
-> (b -> Encoding) -> DiffView -> a -> b -> Expectation
expectGoldenEncoding forall a. ToCBOR a => a -> Encoding
toCBOR forall a. ToCBOR a => a -> Encoding
toCBOR

expectGoldenEncBytes ::
  (HasCallStack, ToCBOR a) => DiffView -> a -> BS.ByteString -> Expectation
expectGoldenEncBytes :: forall a.
(HasCallStack, ToCBOR a) =>
DiffView -> a -> ByteString -> Expectation
expectGoldenEncBytes DiffView
viewDiff a
actual ByteString
expectedBytes = do
  HasCallStack =>
(forall t. (HasCallStack, Eq t, ToExpr t) => t -> t -> Expectation)
-> Expectation
diffAs forall a b. (a -> b) -> a -> b
$ forall a.
(ToExpr a, Eq a, HasCallStack) =>
[Char] -> a -> a -> Expectation
expectExprEqualWithMessage [Char]
"Encoding did not match expectation"
  -- ensure that it is also valid CBOR
  case forall a. FromCBOR a => ByteString -> Either DecoderError a
decodeFull' ByteString
actualBytes of
    Left DecoderError
err -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Type was encoded sucessfully, but as invalid CBOR: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show DecoderError
err
    Right (Term
_ :: Term) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  where
    actualBytes :: ByteString
actualBytes = forall a. ToCBOR a => a -> ByteString
serialize' (forall a. ToCBOR a => a -> Encoding
toCBOR a
actual)
    diffAs ::
      HasCallStack =>
      (forall t. (HasCallStack, Eq t, ToExpr t) => t -> t -> Expectation) ->
      Expectation
    diffAs :: HasCallStack =>
(forall t. (HasCallStack, Eq t, ToExpr t) => t -> t -> Expectation)
-> Expectation
diffAs forall t. (HasCallStack, Eq t, ToExpr t) => t -> t -> Expectation
f =
      case DiffView
viewDiff of
        DiffView
DiffCBOR ->
          forall t. (HasCallStack, Eq t, ToExpr t) => t -> t -> Expectation
f (ByteString -> CBORBytes
CBORBytes ByteString
actualBytes) (ByteString -> CBORBytes
CBORBytes ByteString
expectedBytes)
        DiffView
DiffHex ->
          forall t. (HasCallStack, Eq t, ToExpr t) => t -> t -> Expectation
f (ByteString -> HexBytes
HexBytes ByteString
actualBytes) (ByteString -> HexBytes
HexBytes ByteString
expectedBytes)
        DiffView
DiffRaw -> forall t. (HasCallStack, Eq t, ToExpr t) => t -> t -> Expectation
f ByteString
actualBytes ByteString
expectedBytes
        DiffView
DiffAuto -> ByteString
actualBytes forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` ByteString
expectedBytes

expectGoldenEncLazyBytes ::
  (HasCallStack, ToCBOR a) => DiffView -> a -> BSL.ByteString -> Expectation
expectGoldenEncLazyBytes :: forall a.
(HasCallStack, ToCBOR a) =>
DiffView -> a -> ByteString -> Expectation
expectGoldenEncLazyBytes DiffView
viewDiff a
actual = forall a.
(HasCallStack, ToCBOR a) =>
DiffView -> a -> ByteString -> Expectation
expectGoldenEncBytes DiffView
viewDiff a
actual forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict

expectGoldenEncHexBytes ::
  (HasCallStack, ToCBOR a) => DiffView -> a -> BS.ByteString -> Expectation
expectGoldenEncHexBytes :: forall a.
(HasCallStack, ToCBOR a) =>
DiffView -> a -> ByteString -> Expectation
expectGoldenEncHexBytes DiffView
viewDiff a
actual ByteString
hexBytes = do
  case ByteString -> Either [Char] ByteString
BS16.decode ByteString
hexBytes of
    Left [Char]
err -> HasCallStack => [Char] -> Expectation
expectationFailure forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected failure during Base16 decoding: " forall a. [a] -> [a] -> [a]
++ [Char]
err
    Right ByteString
expectedBytes ->
      forall a.
(HasCallStack, ToCBOR a) =>
DiffView -> a -> ByteString -> Expectation
expectGoldenEncBytes DiffView
viewDiff a
actual ByteString
expectedBytes