{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Test.Cardano.Ledger.Shelley.SafeHash (safeHashTest) where

import Cardano.Ledger.Hashes
import Data.ByteString (ByteString)
import Data.ByteString.Short (ShortByteString, toShort)
import Data.Proxy
import Data.String (fromString)
import Test.Tasty
import Test.Tasty.HUnit

data FooI -- HashAnnotated indexes which are analogs of our EraIndependentXXX

long :: ByteString
long :: ByteString
long = forall a. IsString a => String -> a
fromString String
"abc"

short :: ShortByteString
short :: ShortByteString
short = ByteString -> ShortByteString
toShort ByteString
long

-- Any newtype over some type that is SafeToHash can easily
-- derive SafeToHash and also assign its HashAnnotated type, and
-- thus become a client of 'hashAnnotated'

newtype Foo = Foo ShortByteString
  deriving (Int -> Foo -> ShowS
[Foo] -> ShowS
Foo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Foo] -> ShowS
$cshowList :: [Foo] -> ShowS
show :: Foo -> String
$cshow :: Foo -> String
showsPrec :: Int -> Foo -> ShowS
$cshowsPrec :: Int -> Foo -> ShowS
Show, Foo -> Int
Foo -> ByteString
forall i. Proxy i -> Foo -> SafeHash i
forall t.
(t -> ByteString)
-> (t -> Int)
-> (forall i. Proxy i -> t -> SafeHash i)
-> SafeToHash t
makeHashWithExplicitProxys :: forall i. Proxy i -> Foo -> SafeHash i
$cmakeHashWithExplicitProxys :: forall i. Proxy i -> Foo -> SafeHash i
originalBytesSize :: Foo -> Int
$coriginalBytesSize :: Foo -> Int
originalBytes :: Foo -> ByteString
$coriginalBytes :: Foo -> ByteString
SafeToHash)

instance HashAnnotated Foo FooI

foo :: Foo
foo :: Foo
foo = ShortByteString -> Foo
Foo ShortByteString
short

-- ===================================
-- Lets run some examples, we'll need some concrete Crypto

foohash :: SafeHash FooI
foohash :: SafeHash FooI
foohash = forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated Foo
foo

shorthash :: SafeHash ShortByteString
shorthash :: SafeHash ShortByteString
shorthash = forall t i. SafeToHash t => Proxy i -> t -> SafeHash i
makeHashWithExplicitProxys (forall {k} (t :: k). Proxy t
Proxy @ShortByteString) ShortByteString
short

longhash :: SafeHash ByteString
longhash :: SafeHash ByteString
longhash = forall t i. SafeToHash t => Proxy i -> t -> SafeHash i
makeHashWithExplicitProxys (forall {k} (t :: k). Proxy t
Proxy @ByteString) ByteString
long

test1, test2 :: TestTree
test1 :: TestTree
test1 =
  String -> Assertion -> TestTree
testCase
    String
"short==long"
    (forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual String
"ShortByteString and ByteString don't hash the same" SafeHash ShortByteString
shorthash (forall i j. SafeHash i -> SafeHash j
castSafeHash SafeHash ByteString
longhash))
test2 :: TestTree
test2 =
  String -> Assertion -> TestTree
testCase
    String
"newtype==underlyingtype"
    (forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual String
"A newtype and its underlying type dont hash the same" SafeHash ShortByteString
shorthash (forall i j. SafeHash i -> SafeHash j
castSafeHash SafeHash FooI
foohash))

safeHashTest :: TestTree
safeHashTest :: TestTree
safeHashTest =
  String -> [TestTree] -> TestTree
testGroup
    String
"SafeHash"
    [ String -> [TestTree] -> TestTree
testGroup String
"StandardCrypto" [TestTree
test1, TestTree
test2]
    ]