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

module Test.Cardano.Ledger.Conformance.ConformanceSpec (spec) where

import Cardano.Ledger.Crypto (Crypto (..), StandardCrypto)
import Cardano.Ledger.TxIn (TxId)
import Data.List (isInfixOf)
import Data.Typeable (Proxy (..), Typeable, typeRep)
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Conformance (
  FixupSpecRep,
  SpecTranslate (..),
  hashToInteger,
  integerToHash,
  runSpecTransM,
  toTestRep,
 )
import Test.Cardano.Ledger.Conformance.Spec.Conway ()
import Test.Cardano.Ledger.Conformance.SpecTranslate.Conway (vkeyFromInteger, vkeyToInteger)

hashDisplayProp ::
  forall a.
  ( Typeable a
  , Arbitrary a
  , SpecTranslate () a
  , FixupSpecRep (SpecRep a)
  , ToExpr (SpecRep a)
  , ToExpr a
  ) =>
  Spec
hashDisplayProp :: forall a.
(Typeable a, Arbitrary a, SpecTranslate () a,
 FixupSpecRep (SpecRep a), ToExpr (SpecRep a), ToExpr a) =>
Spec
hashDisplayProp = forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy @a)) forall a b. (a -> b) -> a -> b
$ do
  a
someHash <- forall a. Arbitrary a => Gen a
arbitrary @a
  let
    specRes :: SpecRep a
specRes =
      case forall ctx a.
ctx -> SpecTransM ctx a -> Either SpecTranslationError a
runSpecTransM () (forall ctx a.
(SpecTranslate ctx a, FixupSpecRep (SpecRep a)) =>
a -> SpecTransM ctx (SpecRep a)
toTestRep a
someHash) of
        Left SpecTranslationError
e -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Failed to translate hash: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show SpecTranslationError
e
        Right SpecRep a
x -> SpecRep a
x
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall prop. Testable prop => String -> prop -> Property
counterexample (String
"impl expr: " forall a. Semigroup a => a -> a -> a
<> forall a. ToExpr a => a -> String
showExpr a
someHash)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall prop. Testable prop => String -> prop -> Property
counterexample (String
"spec expr: " forall a. Semigroup a => a -> a -> a
<> forall a. ToExpr a => a -> String
showExpr SpecRep a
specRes)
    forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'"') (forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/= Char
'"') (forall a. ToExpr a => a -> String
showExpr SpecRep a
specRes)) forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` forall a. ToExpr a => a -> String
showExpr a
someHash

-- TODO think of a more sensible way to test this

spec :: Spec
spec :: Spec
spec =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Translation" forall a b. (a -> b) -> a -> b
$ do
    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Hashes are displayed in the same way in the implementation and in the spec" forall a b. (a -> b) -> a -> b
$ do
      forall a.
(Typeable a, Arbitrary a, SpecTranslate () a,
 FixupSpecRep (SpecRep a), ToExpr (SpecRep a), ToExpr a) =>
Spec
hashDisplayProp @(TxId StandardCrypto)
    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Utility properties" forall a b. (a -> b) -> a -> b
$ do
      forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"vkeyToInteger and vkeyFromInteger are inverses" forall a b. (a -> b) -> a -> b
$
        \VKey Any StandardCrypto
vk -> forall c (kd :: KeyRole).
DSIGNAlgorithm (DSIGN c) =>
TxId -> Maybe (VKey kd c)
vkeyFromInteger (forall c (kd :: KeyRole).
DSIGNAlgorithm (DSIGN c) =>
VKey kd c -> TxId
vkeyToInteger @StandardCrypto VKey Any StandardCrypto
vk) forall a. (Eq a, Show a) => a -> a -> Property
=== forall a. a -> Maybe a
Just VKey Any StandardCrypto
vk
      forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"hashToInteger and integerToHash are inverses" forall a b. (a -> b) -> a -> b
$
        \Hash Blake2b_224 Any
h -> forall h a. HashAlgorithm h => TxId -> Maybe (Hash h a)
integerToHash (forall a b. Hash a b -> TxId
hashToInteger @(ADDRHASH StandardCrypto) Hash Blake2b_224 Any
h) forall a. (Eq a, Show a) => a -> a -> Property
=== forall a. a -> Maybe a
Just Hash Blake2b_224 Any
h