{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.Binary.Golden (
  decodeEnc,
  expectDecoderSuccessAnn,
  expectDecoderSuccessAnnWith,
  expectDecoderFailureAnn,
  expectDecoderResultOn,
  toPackageGolden,
  goldenForToCBOR,
  goldenForEncCBOR,
  cborGoldenSpec,
  cborAnnGoldenSpec,
) where

import Cardano.Ledger.Binary (
  Annotator,
  DecCBOR (..),
  DecoderError,
  EncCBOR (..),
  ToCBOR (..),
  Version,
  decodeFullAnnotator,
  serialize,
  toLazyByteString,
 )
import qualified Cardano.Ledger.Binary as Binary
import qualified Cardano.Ledger.Binary.Plain as Plain
import qualified Data.ByteString.Lazy as BSL
import Data.TreeDiff (ToExpr (..))
import Data.Typeable (Proxy (..), typeOf)
import Test.Cardano.Ledger.Binary.Plain.Golden (Enc)
import Test.Cardano.Ledger.Binary.RoundTrip (
  embedTripAnnExpectation,
  roundTripAnnRangeExpectation,
  roundTripCborRangeExpectation,
 )
import Test.Cardano.Ledger.Binary.TreeDiff (CBORBytes (..))
import Test.Hspec
import qualified Test.Hspec.Golden as Golden (Golden (..))

decodeEnc :: forall a. DecCBOR (Annotator a) => Version -> Enc -> Either DecoderError a
decodeEnc :: forall a.
DecCBOR (Annotator a) =>
Version -> Enc -> Either DecoderError a
decodeEnc Version
version Enc
enc = forall a.
Version
-> Text
-> (forall s. Decoder s (Annotator a))
-> ByteString
-> Either DecoderError a
decodeFullAnnotator @a Version
version (Proxy (Annotator a) -> Text
forall a. DecCBOR a => Proxy a -> Text
Binary.label (Proxy (Annotator a) -> Text) -> Proxy (Annotator a) -> Text
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Annotator a)) Decoder s (Annotator a)
forall s. Decoder s (Annotator a)
forall a s. DecCBOR a => Decoder s a
decCBOR ByteString
bytes
  where
    bytes :: ByteString
bytes = Encoding -> ByteString
toLazyByteString (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$ Enc -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Enc
enc

expectDecoderSuccessAnnWith ::
  forall a.
  ( DecCBOR (Annotator a)
  , HasCallStack
  , Show a
  , Eq a
  ) =>
  (a -> a -> Bool) ->
  Version ->
  Enc ->
  a ->
  Expectation
expectDecoderSuccessAnnWith :: forall a.
(DecCBOR (Annotator a), HasCallStack, Show a, Eq a) =>
(a -> a -> Bool) -> Version -> Enc -> a -> Expectation
expectDecoderSuccessAnnWith a -> a -> Bool
equals Version
version Enc
enc a
expected =
  case forall a.
DecCBOR (Annotator a) =>
Version -> Enc -> Either DecoderError a
decodeEnc @a Version
version Enc
enc of
    Left DecoderError
err -> HasCallStack => String -> Expectation
String -> Expectation
expectationFailure (String -> Expectation) -> String -> Expectation
forall a b. (a -> b) -> a -> b
$ String
"Unexpected decoder failure: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> DecoderError -> String
forall a. Show a => a -> String
show DecoderError
err
    Right a
x | a
x a -> a -> Bool
`equals` a
expected -> () -> Expectation
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Right a
result -> a
result a -> a -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` a
expected

expectDecoderSuccessAnn ::
  ( DecCBOR (Annotator a)
  , Eq a
  , HasCallStack
  , Show a
  ) =>
  Version -> Enc -> a -> Expectation
expectDecoderSuccessAnn :: forall a.
(DecCBOR (Annotator a), Eq a, HasCallStack, Show a) =>
Version -> Enc -> a -> Expectation
expectDecoderSuccessAnn = (a -> a -> Bool) -> Version -> Enc -> a -> Expectation
forall a.
(DecCBOR (Annotator a), HasCallStack, Show a, Eq a) =>
(a -> a -> Bool) -> Version -> Enc -> a -> Expectation
expectDecoderSuccessAnnWith a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

expectDecoderFailureAnn ::
  forall a.
  (ToExpr a, DecCBOR (Annotator a), HasCallStack) =>
  Version ->
  Enc ->
  DecoderError ->
  Expectation
expectDecoderFailureAnn :: forall a.
(ToExpr a, DecCBOR (Annotator a), HasCallStack) =>
Version -> Enc -> DecoderError -> Expectation
expectDecoderFailureAnn Version
version Enc
enc DecoderError
expectedErr =
  case forall a.
DecCBOR (Annotator a) =>
Version -> Enc -> Either DecoderError a
decodeEnc @a Version
version Enc
enc of
    Left DecoderError
err -> DecoderError
err DecoderError -> DecoderError -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` DecoderError
expectedErr
    Right a
x ->
      HasCallStack => String -> Expectation
String -> Expectation
expectationFailure (String -> Expectation) -> String -> Expectation
forall a b. (a -> b) -> a -> b
$
        String
"Expected a failure, but decoder succeeded:\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Expr -> String
forall a. Show a => a -> String
show (a -> Expr
forall a. ToExpr a => a -> Expr
toExpr a
x)

expectDecoderResultOn ::
  forall a b.
  ( DecCBOR (Annotator a)
  , Eq b
  , HasCallStack
  , Show b
  ) =>
  Version -> Enc -> a -> (a -> b) -> Expectation
expectDecoderResultOn :: forall a b.
(DecCBOR (Annotator a), Eq b, HasCallStack, Show b) =>
Version -> Enc -> a -> (a -> b) -> Expectation
expectDecoderResultOn Version
version Enc
enc a
expected a -> b
f =
  Version
-> Version -> (a -> Enc -> Expectation) -> Enc -> Expectation
forall a b.
(ToCBOR a, DecCBOR (Annotator b), HasCallStack) =>
Version -> Version -> (b -> a -> Expectation) -> a -> Expectation
embedTripAnnExpectation
    Version
version
    Version
version
    (\a
x Enc
_ -> a -> b
f a
x b -> b -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` a -> b
f a
expected)
    Enc
enc

toPackageGolden :: (FilePath -> IO FilePath) -> Golden.Golden g -> IO (Golden.Golden g)
toPackageGolden :: forall g. (String -> IO String) -> Golden g -> IO (Golden g)
toPackageGolden String -> IO String
mkFullPath Golden g
g = do
  fullPathGoldenFile <- String -> IO String
mkFullPath (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ Golden g -> String
forall str. Golden str -> String
Golden.goldenFile Golden g
g
  fullPathActualFile <- mapM mkFullPath $ Golden.actualFile g
  pure $
    g
      { Golden.goldenFile = fullPathGoldenFile
      , Golden.actualFile = fullPathActualFile
      }

-- | `Golden` specification for `ToCBOR`
goldenForToCBOR ::
  ToCBOR a =>
  -- | Path to the golden file relative to the root of the package
  FilePath ->
  -- | Value, which in an encoded form will be expected to produce the same contents as in the
  -- golden file.
  a ->
  Golden.Golden BSL.ByteString
goldenForToCBOR :: forall a. ToCBOR a => String -> a -> Golden ByteString
goldenForToCBOR String
goldenFileName a
t =
  Golden.Golden
    { output :: ByteString
Golden.output = a -> ByteString
forall a. ToCBOR a => a -> ByteString
Plain.serialize a
t
    , encodePretty :: ByteString -> String
Golden.encodePretty = CBORBytes -> String
forall a. Show a => a -> String
show (CBORBytes -> String)
-> (ByteString -> CBORBytes) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> CBORBytes
CBORBytes (ByteString -> CBORBytes)
-> (ByteString -> ByteString) -> ByteString -> CBORBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict
    , writeToFile :: String -> ByteString -> Expectation
Golden.writeToFile = String -> ByteString -> Expectation
BSL.writeFile
    , readFromFile :: String -> IO ByteString
Golden.readFromFile = String -> IO ByteString
BSL.readFile
    , goldenFile :: String
Golden.goldenFile = String
goldenFileName
    , actualFile :: Maybe String
Golden.actualFile = Maybe String
forall a. Maybe a
Nothing
    , failFirstTime :: Bool
Golden.failFirstTime = Bool
False
    }

-- | `Golden` specification for `EncCBOR`
goldenForEncCBOR ::
  EncCBOR a =>
  -- | Path to the golden file relative to the package
  FilePath ->
  -- | Protocol version to be used for encoding
  Version ->
  -- | Value, which in an encoded form will be expected to produce the same contents as in the
  -- golden file.
  a ->
  Golden.Golden BSL.ByteString
goldenForEncCBOR :: forall a. EncCBOR a => String -> Version -> a -> Golden ByteString
goldenForEncCBOR String
goldenFileName Version
version a
t =
  Golden.Golden
    { output :: ByteString
Golden.output = Version -> a -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize Version
version a
t
    , encodePretty :: ByteString -> String
Golden.encodePretty = CBORBytes -> String
forall a. Show a => a -> String
show (CBORBytes -> String)
-> (ByteString -> CBORBytes) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> CBORBytes
CBORBytes (ByteString -> CBORBytes)
-> (ByteString -> ByteString) -> ByteString -> CBORBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict
    , writeToFile :: String -> ByteString -> Expectation
Golden.writeToFile = String -> ByteString -> Expectation
BSL.writeFile
    , readFromFile :: String -> IO ByteString
Golden.readFromFile = String -> IO ByteString
BSL.readFile
    , goldenFile :: String
Golden.goldenFile = String
goldenFileName
    , actualFile :: Maybe String
Golden.actualFile = Maybe String
forall a. Maybe a
Nothing
    , failFirstTime :: Bool
Golden.failFirstTime = Bool
False
    }

-- | Check `EncCBOR` golden spec as well as roundtripping of the golden example with `DecCBOR`
cborGoldenSpec ::
  forall a.
  ( Eq a
  , Show a
  , EncCBOR a
  , DecCBOR a
  , HasCallStack
  ) =>
  -- | Action to get the full path, usually will be @Paths_<package_name>.getDataFileName@
  (FilePath -> IO FilePath) ->
  -- | File path to the golden file relative to the root of the package
  FilePath ->
  -- | Protocol version to be used for encoding
  Version ->
  -- | Value, which in an encoded form will be expected to produce the same contents as in the
  -- golden file.
  a ->
  Spec
cborGoldenSpec :: forall a.
(Eq a, Show a, EncCBOR a, DecCBOR a, HasCallStack) =>
(String -> IO String) -> String -> Version -> a -> Spec
cborGoldenSpec String -> IO String
mkFullPath String
goldenFileName Version
version a
a = do
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (TypeRep -> String
forall a. Show a => a -> String
show (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
a)) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String
-> IO (Golden ByteString)
-> SpecWith (Arg (IO (Golden ByteString)))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Golden" (IO (Golden ByteString) -> SpecWith (Arg (IO (Golden ByteString))))
-> IO (Golden ByteString)
-> SpecWith (Arg (IO (Golden ByteString)))
forall a b. (a -> b) -> a -> b
$ (String -> IO String)
-> Golden ByteString -> IO (Golden ByteString)
forall g. (String -> IO String) -> Golden g -> IO (Golden g)
toPackageGolden String -> IO String
mkFullPath (Golden ByteString -> IO (Golden ByteString))
-> Golden ByteString -> IO (Golden ByteString)
forall a b. (a -> b) -> a -> b
$ String -> Version -> a -> Golden ByteString
forall a. EncCBOR a => String -> Version -> a -> Golden ByteString
goldenForEncCBOR String
goldenFileName Version
version a
a
    String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"RoundTrip Golden Example" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$ Version -> Version -> a -> Expectation
forall t.
(Show t, Eq t, EncCBOR t, DecCBOR t, HasCallStack) =>
Version -> Version -> t -> Expectation
roundTripCborRangeExpectation Version
version Version
version a
a

-- | Check `ToCBOR` golden spec as well as roundtripping of the golden example with `DecCBOR` for
-- its `Annotator` version.
cborAnnGoldenSpec ::
  forall a.
  ( Eq a
  , Show a
  , ToCBOR a
  , DecCBOR (Annotator a)
  , HasCallStack
  ) =>
  -- | Action to get the full path, usually will be @Paths_<package_name>.getDataFileName@
  (FilePath -> IO FilePath) ->
  -- | File path to the golden file relative to the root of the package
  FilePath ->
  -- | Protocol version to be used for decoding
  Version ->
  -- | Value, which in an encoded form will be expected to produce the same contents as in the
  -- golden file.
  a ->
  Spec
cborAnnGoldenSpec :: forall a.
(Eq a, Show a, ToCBOR a, DecCBOR (Annotator a), HasCallStack) =>
(String -> IO String) -> String -> Version -> a -> Spec
cborAnnGoldenSpec String -> IO String
mkFullPath String
goldenFileName Version
version a
a = do
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (TypeRep -> String
forall a. Show a => a -> String
show (a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
a)) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String
-> IO (Golden ByteString)
-> SpecWith (Arg (IO (Golden ByteString)))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Golden" (IO (Golden ByteString) -> SpecWith (Arg (IO (Golden ByteString))))
-> IO (Golden ByteString)
-> SpecWith (Arg (IO (Golden ByteString)))
forall a b. (a -> b) -> a -> b
$ (String -> IO String)
-> Golden ByteString -> IO (Golden ByteString)
forall g. (String -> IO String) -> Golden g -> IO (Golden g)
toPackageGolden String -> IO String
mkFullPath (Golden ByteString -> IO (Golden ByteString))
-> Golden ByteString -> IO (Golden ByteString)
forall a b. (a -> b) -> a -> b
$ String -> a -> Golden ByteString
forall a. ToCBOR a => String -> a -> Golden ByteString
goldenForToCBOR String
goldenFileName a
a
    String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"RoundTrip Golden Example" (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$ Version -> Version -> a -> Expectation
forall t.
(Show t, Eq t, ToCBOR t, DecCBOR (Annotator t), HasCallStack) =>
Version -> Version -> t -> Expectation
roundTripAnnRangeExpectation Version
version Version
version a
a