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

module Test.Cardano.Ledger.Binary (
  decoderEquivalenceSpec,
  decoderEquivalenceExpectation,
  decoderEquivalenceProp,
) where

import Cardano.Ledger.Binary
import Control.Monad (forM_)
import qualified Data.ByteString.Lazy as BSL
import Data.Proxy
import qualified Data.Text as T
import Data.Typeable
import Test.Cardano.Ledger.Binary.RoundTrip (embedTripAnnExpectation)
import Test.Hspec
import Test.Hspec.QuickCheck (prop)
import Test.QuickCheck hiding (label)

-- | Generates arbitrary values, encodes them, and verifies that
-- decoding with `DecCBOR (Annotator)` produces the same result as decoding with `DecCBOR`.
decoderEquivalenceSpec ::
  forall t.
  ( Eq t
  , ToCBOR t
  , DecCBOR (Annotator t)
  , Arbitrary t
  , Show t
  ) =>
  Version ->
  Version ->
  Spec
decoderEquivalenceSpec :: forall t.
(Eq t, ToCBOR t, DecCBOR (Annotator t), Arbitrary t, Show t) =>
Version -> Version -> Spec
decoderEquivalenceSpec Version
fromVersion Version
toVersion =
  let lbl :: String
lbl = forall a. Show a => a -> String
show (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @t)
   in forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
lbl (forall t.
(Eq t, ToCBOR t, DecCBOR (Annotator t), Show t) =>
Version -> Version -> t -> Property
decoderEquivalenceProp @t Version
fromVersion Version
toVersion)

decoderEquivalenceProp ::
  forall t.
  ( Eq t
  , ToCBOR t
  , DecCBOR (Annotator t)
  , Show t
  ) =>
  Version ->
  Version ->
  t ->
  Property
decoderEquivalenceProp :: forall t.
(Eq t, ToCBOR t, DecCBOR (Annotator t), Show t) =>
Version -> Version -> t -> Property
decoderEquivalenceProp Version
fromVersion Version
toVersion t
t =
  forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Version
fromVersion .. Version
toVersion] forall a b. (a -> b) -> a -> b
$ \Version
version ->
      forall a b.
(ToCBOR a, DecCBOR (Annotator b), HasCallStack) =>
Version -> Version -> (b -> a -> IO ()) -> a -> IO ()
embedTripAnnExpectation Version
version Version
version forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
shouldBe t
t

decoderEquivalenceExpectation ::
  forall t.
  ( Eq t
  , DecCBOR t
  , DecCBOR (Annotator t)
  , Show t
  ) =>
  Version ->
  BSL.ByteString ->
  Expectation
decoderEquivalenceExpectation :: forall t.
(Eq t, DecCBOR t, DecCBOR (Annotator t), Show t) =>
Version -> ByteString -> IO ()
decoderEquivalenceExpectation Version
version ByteString
bs = do
  let decAnn :: Either DecoderError t
decAnn = forall a.
Version
-> Text
-> (forall s. Decoder s (Annotator a))
-> ByteString
-> Either DecoderError a
decodeFullAnnotator @t Version
version (String -> Text
T.pack (forall a. Show a => a -> String
show (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @t))) forall a s. DecCBOR a => Decoder s a
decCBOR ByteString
bs
      dec :: Either DecoderError t
dec = forall a.
DecCBOR a =>
Version -> ByteString -> Either DecoderError a
decodeFull @t Version
version ByteString
bs
  case (Either DecoderError t
decAnn, Either DecoderError t
dec) of
    -- we only check in case of successful deserialisation,
    -- because some arbitrary instances generate data that fails serialisation for some protocols
    -- (for example, TxDats in Conway)
    (Right t
_, Right t
_) -> Either DecoderError t
decAnn forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Either DecoderError t
dec
    (Left DecoderError
_, Left DecoderError
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    (Either DecoderError t, Either DecoderError t)
_ ->
      HasCallStack => String -> IO ()
expectationFailure forall a b. (a -> b) -> a -> b
$
        String
"Decoding result: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Either DecoderError t
dec forall a. [a] -> [a] -> [a]
++ String
" did not match the one via Annotator: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Either DecoderError t
decAnn