{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- | Test suite utilities for the implementor
module Test.Cardano.Ledger.CanonicalState.Testlib (
  testAllNS,

  -- * Hspec helpers
  testNS,
  validateType,

  -- * properties
  propNamespaceEntryConformsToSpec,
  propNamespaceEntryIsCanonical,
  propTypeIsCanonical,
  propNamespaceEntryRoundTrip,
  propTypeConformsToSpec,

  -- * Debug tools
  debugValidateType,
  debugEncodeType,
) where

import Cardano.Ledger.CanonicalState.CDDL.Validate (validateBytesAgainst)
import Cardano.SCLS.CBOR.Canonical (getRawDecoder, getRawEncoding)
import Cardano.SCLS.CBOR.Canonical.Encoder
import Cardano.SCLS.NamespaceCodec
import Cardano.SCLS.Versioned
import Codec.CBOR.Cuddle.CBOR.Validator.Trace (Evidenced, ValidationTrace)
import qualified Codec.CBOR.Cuddle.CBOR.Validator.Trace as VT
import Codec.CBOR.FlatTerm (fromFlatTerm, toFlatTerm)
import Codec.CBOR.Term (decodeTerm)
import Codec.CBOR.Write (toStrictByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Base16 as Base16
import Data.Either (isRight)
import Data.Proxy
import qualified Data.Text as T
import Data.Typeable
import GHC.TypeLits
import Test.Hspec
import Test.Hspec.Expectations.Contrib (annotate)
import Test.Hspec.QuickCheck
import Test.QuickCheck

type ConstrNS a =
  (KnownNamespace a, Arbitrary (NamespaceEntry a), Eq (NamespaceEntry a), Show (NamespaceEntry a))

-- | Test all supported NS for conformance with SCLS.
testAllNS ::
  ( ConstrNS "blocks/v0"
  , ConstrNS "utxo/v0"
  , ConstrNS "entities/accounts/v0"
  , ConstrNS "entities/committee/v0"
  , ConstrNS "entities/dreps/v0"
  , ConstrNS "entities/stake_pools/v0"
  , ConstrNS "entities/stake_pools/vrf_key_hashes/v0"
  , ConstrNS "gov/committee/v0"
  , ConstrNS "gov/constitution/v0"
  , ConstrNS "gov/pparams/v0"
  , ConstrNS "gov/proposals/v0"
  , ConstrNS "gov/proposals/roots/v0"
  ) =>
  Spec
testAllNS :: (ConstrNS "blocks/v0", ConstrNS "utxo/v0",
 ConstrNS "entities/accounts/v0", ConstrNS "entities/committee/v0",
 ConstrNS "entities/dreps/v0", ConstrNS "entities/stake_pools/v0",
 ConstrNS "entities/stake_pools/vrf_key_hashes/v0",
 ConstrNS "gov/committee/v0", ConstrNS "gov/constitution/v0",
 ConstrNS "gov/pparams/v0", ConstrNS "gov/proposals/v0",
 ConstrNS "gov/proposals/roots/v0") =>
Spec
testAllNS = String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"scls/conformance" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
  forall (ns :: Symbol).
(KnownSymbol ns, KnownNamespace ns, Arbitrary (NamespaceEntry ns),
 Eq (NamespaceEntry ns), Show (NamespaceEntry ns)) =>
Spec
testNS @"blocks/v0"
  forall (ns :: Symbol).
(KnownSymbol ns, KnownNamespace ns, Arbitrary (NamespaceEntry ns),
 Eq (NamespaceEntry ns), Show (NamespaceEntry ns)) =>
Spec
testNS @"utxo/v0"
  forall (ns :: Symbol).
(KnownSymbol ns, KnownNamespace ns, Arbitrary (NamespaceEntry ns),
 Eq (NamespaceEntry ns), Show (NamespaceEntry ns)) =>
Spec
testNS @"entities/accounts/v0"
  forall (ns :: Symbol).
(KnownSymbol ns, KnownNamespace ns, Arbitrary (NamespaceEntry ns),
 Eq (NamespaceEntry ns), Show (NamespaceEntry ns)) =>
Spec
testNS @"entities/committee/v0"
  forall (ns :: Symbol).
(KnownSymbol ns, KnownNamespace ns, Arbitrary (NamespaceEntry ns),
 Eq (NamespaceEntry ns), Show (NamespaceEntry ns)) =>
Spec
testNS @"entities/dreps/v0"
  forall (ns :: Symbol).
(KnownSymbol ns, KnownNamespace ns, Arbitrary (NamespaceEntry ns),
 Eq (NamespaceEntry ns), Show (NamespaceEntry ns)) =>
Spec
testNS @"entities/stake_pools/v0"
  forall (ns :: Symbol).
(KnownSymbol ns, KnownNamespace ns, Arbitrary (NamespaceEntry ns),
 Eq (NamespaceEntry ns), Show (NamespaceEntry ns)) =>
Spec
testNS @"entities/stake_pools/vrf_key_hashes/v0"
  forall (ns :: Symbol).
(KnownSymbol ns, KnownNamespace ns, Arbitrary (NamespaceEntry ns),
 Eq (NamespaceEntry ns), Show (NamespaceEntry ns)) =>
Spec
testNS @"gov/committee/v0"
  forall (ns :: Symbol).
(KnownSymbol ns, KnownNamespace ns, Arbitrary (NamespaceEntry ns),
 Eq (NamespaceEntry ns), Show (NamespaceEntry ns)) =>
Spec
testNS @"gov/constitution/v0"
  forall (ns :: Symbol).
(KnownSymbol ns, KnownNamespace ns, Arbitrary (NamespaceEntry ns),
 Eq (NamespaceEntry ns), Show (NamespaceEntry ns)) =>
Spec
testNS @"gov/pparams/v0"
  forall (ns :: Symbol).
(KnownSymbol ns, KnownNamespace ns, Arbitrary (NamespaceEntry ns),
 Eq (NamespaceEntry ns), Show (NamespaceEntry ns)) =>
Spec
testNS @"gov/proposals/v0"
  forall (ns :: Symbol).
(KnownSymbol ns, KnownNamespace ns, Arbitrary (NamespaceEntry ns),
 Eq (NamespaceEntry ns), Show (NamespaceEntry ns)) =>
Spec
testNS @"gov/proposals/roots/v0"

-- | Validate concrete type against its definition in CDDL
validateType ::
  forall ns a.
  (KnownSymbol ns, ToCanonicalCBOR ns a, Arbitrary a, Show a, Typeable a) => T.Text -> Spec
validateType :: forall (ns :: Symbol) a.
(KnownSymbol ns, ToCanonicalCBOR ns a, Arbitrary a, Show a,
 Typeable a) =>
Text -> Spec
validateType Text
t = String -> (a -> Bool) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop (String
"validate type<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">") (forall (ns :: Symbol) a.
(KnownSymbol ns, ToCanonicalCBOR ns a) =>
Text -> a -> Bool
propTypeConformsToSpec @ns @a Text
t)
  where
    n :: String
n = TypeRep -> String
forall a. Show a => a -> String
show (Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a))

testNS ::
  forall ns.
  ( KnownSymbol ns
  , KnownNamespace ns
  , Arbitrary (NamespaceEntry ns)
  , Eq (NamespaceEntry ns)
  , Show (NamespaceEntry ns)
  ) =>
  Spec
testNS :: forall (ns :: Symbol).
(KnownSymbol ns, KnownNamespace ns, Arbitrary (NamespaceEntry ns),
 Eq (NamespaceEntry ns), Show (NamespaceEntry ns)) =>
Spec
testNS =
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
nsName (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> (NamespaceEntry ns -> Bool) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"conforms to spec" ((NamespaceEntry ns -> Bool) -> Spec)
-> (NamespaceEntry ns -> Bool) -> Spec
forall a b. (a -> b) -> a -> b
$
      forall (ns :: Symbol).
(KnownSymbol ns, KnownNamespace ns) =>
NamespaceEntry ns -> Bool
propNamespaceEntryConformsToSpec @ns
    String -> (NamespaceEntry ns -> IO ()) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"canonical with regards to its definition" ((NamespaceEntry ns -> IO ()) -> Spec)
-> (NamespaceEntry ns -> IO ()) -> Spec
forall a b. (a -> b) -> a -> b
$
      forall (ns :: Symbol).
(KnownNamespace ns, Eq (NamespaceEntry ns),
 Show (NamespaceEntry ns)) =>
NamespaceEntry ns -> IO ()
propNamespaceEntryRoundTrip @ns
    String -> (NamespaceEntry ns -> IO ()) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"is canonical" ((NamespaceEntry ns -> IO ()) -> Spec)
-> (NamespaceEntry ns -> IO ()) -> Spec
forall a b. (a -> b) -> a -> b
$
      forall (ns :: Symbol).
KnownNamespace ns =>
NamespaceEntry ns -> IO ()
propNamespaceEntryIsCanonical @ns
  where
    nsName :: String
nsName = Proxy ns -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @ns)

-- | Each value from the known namespace conforms to its spec
propNamespaceEntryConformsToSpec ::
  forall ns.
  (KnownSymbol ns, KnownNamespace ns) => NamespaceEntry ns -> Bool
propNamespaceEntryConformsToSpec :: forall (ns :: Symbol).
(KnownSymbol ns, KnownNamespace ns) =>
NamespaceEntry ns -> Bool
propNamespaceEntryConformsToSpec = \NamespaceEntry ns
a ->
  case ByteString -> Text -> Text -> Maybe (Evidenced ValidationTrace)
validateBytesAgainst (Encoding -> ByteString
toStrictByteString (CanonicalEncoding -> Encoding
getRawEncoding (CanonicalEncoding -> Encoding) -> CanonicalEncoding -> Encoding
forall a b. (a -> b) -> a -> b
$ forall {k} (ns :: k) a.
CanonicalCBOREntryEncoder ns a =>
a -> CanonicalEncoding
forall (ns :: Symbol) a.
CanonicalCBOREntryEncoder ns a =>
a -> CanonicalEncoding
encodeEntry @ns NamespaceEntry ns
a)) Text
nsName Text
"record_entry" of
    Just Evidenced ValidationTrace
res -> Evidenced ValidationTrace -> Bool
forall (t :: Validity -> *). Evidenced t -> Bool
VT.isValid Evidenced ValidationTrace
res
    Maybe (Evidenced ValidationTrace)
_ -> Bool
False
  where
    nsName :: Text
nsName = String -> Text
T.pack (Proxy ns -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @ns))

propTypeConformsToSpec :: forall ns a. (KnownSymbol ns, ToCanonicalCBOR ns a) => T.Text -> a -> Bool
propTypeConformsToSpec :: forall (ns :: Symbol) a.
(KnownSymbol ns, ToCanonicalCBOR ns a) =>
Text -> a -> Bool
propTypeConformsToSpec Text
t = \a
a ->
  case ByteString -> Text -> Text -> Maybe (Evidenced ValidationTrace)
validateBytesAgainst (Encoding -> ByteString
toStrictByteString (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$ CanonicalEncoding -> Encoding
getRawEncoding (Proxy ns -> a -> CanonicalEncoding
forall (v :: Symbol) a (proxy :: Symbol -> *).
ToCanonicalCBOR v a =>
proxy v -> a -> CanonicalEncoding
forall (proxy :: Symbol -> *). proxy ns -> a -> CanonicalEncoding
toCanonicalCBOR (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @ns) a
a)) Text
nsName Text
t of
    Just Evidenced ValidationTrace
res -> Evidenced ValidationTrace -> Bool
forall (t :: Validity -> *). Evidenced t -> Bool
VT.isValid Evidenced ValidationTrace
res
    Maybe (Evidenced ValidationTrace)
_ -> Bool
False
  where
    nsName :: Text
nsName = String -> Text
T.pack (Proxy ns -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @ns))

propNamespaceEntryIsCanonical ::
  forall ns.
  KnownNamespace ns => NamespaceEntry ns -> IO ()
propNamespaceEntryIsCanonical :: forall (ns :: Symbol).
KnownNamespace ns =>
NamespaceEntry ns -> IO ()
propNamespaceEntryIsCanonical NamespaceEntry ns
a =
  let encodedData :: FlatTerm
encodedData = Encoding -> FlatTerm
toFlatTerm (CanonicalEncoding -> Encoding
getRawEncoding (CanonicalEncoding -> Encoding) -> CanonicalEncoding -> Encoding
forall a b. (a -> b) -> a -> b
$ forall {k} (ns :: k) a.
CanonicalCBOREntryEncoder ns a =>
a -> CanonicalEncoding
forall (ns :: Symbol) a.
CanonicalCBOREntryEncoder ns a =>
a -> CanonicalEncoding
encodeEntry @ns NamespaceEntry ns
a)
   in case (forall s. Decoder s Term) -> FlatTerm -> Either String Term
forall a. (forall s. Decoder s a) -> FlatTerm -> Either String a
fromFlatTerm Decoder s Term
forall s. Decoder s Term
decodeTerm FlatTerm
encodedData of
        Right Term
decodedAsTerm -> String -> IO () -> IO ()
forall a. String -> IO a -> IO a
annotate String
"(b, t) = decode @Term (encode x)" (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          let encodedTerm :: FlatTerm
encodedTerm = Encoding -> FlatTerm
toFlatTerm (CanonicalEncoding -> Encoding
getRawEncoding (CanonicalEncoding -> Encoding) -> CanonicalEncoding -> Encoding
forall a b. (a -> b) -> a -> b
$ Proxy ns -> Term -> CanonicalEncoding
forall (v :: Symbol) a (proxy :: Symbol -> *).
ToCanonicalCBOR v a =>
proxy v -> a -> CanonicalEncoding
forall (proxy :: Symbol -> *).
proxy ns -> Term -> CanonicalEncoding
toCanonicalCBOR (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @ns) Term
decodedAsTerm)
          FlatTerm
encodedTerm FlatTerm -> FlatTerm -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` FlatTerm
encodedData
        Either String Term
r -> Either String Term
r Either String Term -> (Either String Term -> Bool) -> IO ()
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`shouldSatisfy` Either String Term -> Bool
forall a b. Either a b -> Bool
isRight

-- | Namespace entry are not contradictory and can roundtrip: `decode.encode.decode.encode = decode.encode`
--
-- We do not require `decode.encode=id` because we do not require input type to be in canonical form.
--
-- I.e. if we have types:
--
-- ```
-- data V a = NoHash a | WithHash a (Maybe Hash)
-- ```
--
-- And it's ok to decode `WithHash a Nothing` to `NoHash a`, `decode.encode=id` property will fail, because
-- decoding will put the value in it's canonical form.
propNamespaceEntryRoundTrip ::
  forall ns.
  (KnownNamespace ns, Eq (NamespaceEntry ns), Show (NamespaceEntry ns)) =>
  NamespaceEntry ns -> IO ()
propNamespaceEntryRoundTrip :: forall (ns :: Symbol).
(KnownNamespace ns, Eq (NamespaceEntry ns),
 Show (NamespaceEntry ns)) =>
NamespaceEntry ns -> IO ()
propNamespaceEntryRoundTrip NamespaceEntry ns
a = do
  case (forall s. Decoder s (Versioned ns (NamespaceEntry ns)))
-> FlatTerm -> Either String (Versioned ns (NamespaceEntry ns))
forall a. (forall s. Decoder s a) -> FlatTerm -> Either String a
fromFlatTerm (CanonicalDecoder s (Versioned ns (NamespaceEntry ns))
-> Decoder s (Versioned ns (NamespaceEntry ns))
forall s a. CanonicalDecoder s a -> Decoder s a
getRawDecoder (CanonicalDecoder s (Versioned ns (NamespaceEntry ns))
 -> Decoder s (Versioned ns (NamespaceEntry ns)))
-> CanonicalDecoder s (Versioned ns (NamespaceEntry ns))
-> Decoder s (Versioned ns (NamespaceEntry ns))
forall a b. (a -> b) -> a -> b
$ forall (ns :: Symbol) a s.
CanonicalCBOREntryDecoder ns a =>
CanonicalDecoder s (Versioned ns a)
decodeEntry @ns) (Encoding -> FlatTerm
toFlatTerm (CanonicalEncoding -> Encoding
getRawEncoding (CanonicalEncoding -> Encoding) -> CanonicalEncoding -> Encoding
forall a b. (a -> b) -> a -> b
$ forall {k} (ns :: k) a.
CanonicalCBOREntryEncoder ns a =>
a -> CanonicalEncoding
forall (ns :: Symbol) a.
CanonicalCBOREntryEncoder ns a =>
a -> CanonicalEncoding
encodeEntry @ns NamespaceEntry ns
a)) of
    Right (Versioned NamespaceEntry ns
a') -> String -> IO () -> IO ()
forall a. String -> IO a -> IO a
annotate String
"(b, a') = decode (encode a)" (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      NamespaceEntry ns
a' NamespaceEntry ns -> NamespaceEntry ns -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` NamespaceEntry ns
a
      case (forall s. Decoder s (Versioned ns (NamespaceEntry ns)))
-> FlatTerm -> Either String (Versioned ns (NamespaceEntry ns))
forall a. (forall s. Decoder s a) -> FlatTerm -> Either String a
fromFlatTerm (CanonicalDecoder s (Versioned ns (NamespaceEntry ns))
-> Decoder s (Versioned ns (NamespaceEntry ns))
forall s a. CanonicalDecoder s a -> Decoder s a
getRawDecoder (CanonicalDecoder s (Versioned ns (NamespaceEntry ns))
 -> Decoder s (Versioned ns (NamespaceEntry ns)))
-> CanonicalDecoder s (Versioned ns (NamespaceEntry ns))
-> Decoder s (Versioned ns (NamespaceEntry ns))
forall a b. (a -> b) -> a -> b
$ forall (ns :: Symbol) a s.
CanonicalCBOREntryDecoder ns a =>
CanonicalDecoder s (Versioned ns a)
decodeEntry @ns) (Encoding -> FlatTerm
toFlatTerm (CanonicalEncoding -> Encoding
getRawEncoding (CanonicalEncoding -> Encoding) -> CanonicalEncoding -> Encoding
forall a b. (a -> b) -> a -> b
$ forall {k} (ns :: k) a.
CanonicalCBOREntryEncoder ns a =>
a -> CanonicalEncoding
forall (ns :: Symbol) a.
CanonicalCBOREntryEncoder ns a =>
a -> CanonicalEncoding
encodeEntry @ns NamespaceEntry ns
a')) of
        Right (Versioned NamespaceEntry ns
a'') -> String -> IO () -> IO ()
forall a. String -> IO a -> IO a
annotate String
"(b', a'') = decode (encode a')" (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          NamespaceEntry ns
a'' NamespaceEntry ns -> NamespaceEntry ns -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` NamespaceEntry ns
a'
        Either String (Versioned ns (NamespaceEntry ns))
r -> Either String (Versioned ns (NamespaceEntry ns))
r Either String (Versioned ns (NamespaceEntry ns))
-> (Either String (Versioned ns (NamespaceEntry ns)) -> Bool)
-> IO ()
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`shouldSatisfy` Either String (Versioned ns (NamespaceEntry ns)) -> Bool
forall a b. Either a b -> Bool
isRight
    Either String (Versioned ns (NamespaceEntry ns))
r -> Either String (Versioned ns (NamespaceEntry ns))
r Either String (Versioned ns (NamespaceEntry ns))
-> (Either String (Versioned ns (NamespaceEntry ns)) -> Bool)
-> IO ()
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`shouldSatisfy` Either String (Versioned ns (NamespaceEntry ns)) -> Bool
forall a b. Either a b -> Bool
isRight

debugValidateType ::
  forall ns a.
  (KnownSymbol ns, ToCanonicalCBOR ns a) => T.Text -> a -> Maybe (Evidenced ValidationTrace)
debugValidateType :: forall (ns :: Symbol) a.
(KnownSymbol ns, ToCanonicalCBOR ns a) =>
Text -> a -> Maybe (Evidenced ValidationTrace)
debugValidateType Text
t a
a =
  ByteString -> Text -> Text -> Maybe (Evidenced ValidationTrace)
validateBytesAgainst (Encoding -> ByteString
toStrictByteString (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$ CanonicalEncoding -> Encoding
getRawEncoding (Proxy ns -> a -> CanonicalEncoding
forall (v :: Symbol) a (proxy :: Symbol -> *).
ToCanonicalCBOR v a =>
proxy v -> a -> CanonicalEncoding
forall (proxy :: Symbol -> *). proxy ns -> a -> CanonicalEncoding
toCanonicalCBOR (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @ns) a
a)) Text
nsName Text
t
  where
    nsName :: Text
nsName = String -> Text
T.pack (Proxy ns -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @ns))

-- | Serialize value to CBOR (for usage in debug tools)
debugEncodeType :: forall ns a. ToCanonicalCBOR ns a => a -> B.ByteString
debugEncodeType :: forall (ns :: Symbol) a. ToCanonicalCBOR ns a => a -> ByteString
debugEncodeType a
a = ByteString -> ByteString
Base16.encode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Encoding -> ByteString
toStrictByteString (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$ CanonicalEncoding -> Encoding
getRawEncoding (Proxy ns -> a -> CanonicalEncoding
forall (v :: Symbol) a (proxy :: Symbol -> *).
ToCanonicalCBOR v a =>
proxy v -> a -> CanonicalEncoding
forall (proxy :: Symbol -> *). proxy ns -> a -> CanonicalEncoding
toCanonicalCBOR (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @ns) a
a)

propTypeIsCanonical :: forall ns a. ToCanonicalCBOR ns a => a -> IO ()
propTypeIsCanonical :: forall (ns :: Symbol) a. ToCanonicalCBOR ns a => a -> IO ()
propTypeIsCanonical a
a =
  let encodedData :: FlatTerm
encodedData = Encoding -> FlatTerm
toFlatTerm (CanonicalEncoding -> Encoding
getRawEncoding (CanonicalEncoding -> Encoding) -> CanonicalEncoding -> Encoding
forall a b. (a -> b) -> a -> b
$ Proxy ns -> a -> CanonicalEncoding
forall (v :: Symbol) a (proxy :: Symbol -> *).
ToCanonicalCBOR v a =>
proxy v -> a -> CanonicalEncoding
forall (proxy :: Symbol -> *). proxy ns -> a -> CanonicalEncoding
toCanonicalCBOR (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @ns) a
a)
   in case (forall s. Decoder s Term) -> FlatTerm -> Either String Term
forall a. (forall s. Decoder s a) -> FlatTerm -> Either String a
fromFlatTerm Decoder s Term
forall s. Decoder s Term
decodeTerm FlatTerm
encodedData of
        Right Term
decodedAsTerm -> String -> IO () -> IO ()
forall a. String -> IO a -> IO a
annotate String
"(b, t) = decode @Term (encode x)" (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          let encodedTerm :: FlatTerm
encodedTerm = Encoding -> FlatTerm
toFlatTerm (CanonicalEncoding -> Encoding
getRawEncoding (CanonicalEncoding -> Encoding) -> CanonicalEncoding -> Encoding
forall a b. (a -> b) -> a -> b
$ Proxy ns -> Term -> CanonicalEncoding
forall (v :: Symbol) a (proxy :: Symbol -> *).
ToCanonicalCBOR v a =>
proxy v -> a -> CanonicalEncoding
forall (proxy :: Symbol -> *).
proxy ns -> Term -> CanonicalEncoding
toCanonicalCBOR (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @ns) Term
decodedAsTerm)
          FlatTerm
encodedTerm FlatTerm -> FlatTerm -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` FlatTerm
encodedData
        Either String Term
r -> Either String Term
r Either String Term -> (Either String Term -> Bool) -> IO ()
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`shouldSatisfy` Either String Term -> Bool
forall a b. Either a b -> Bool
isRight