{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Crypto.Orphans () where

import Cardano.Crypto (
  SigningKey (..),
 )
import Cardano.Crypto.Hashing (serializeCborHash)
import Cardano.Prelude
import qualified Crypto.PubKey.Ed25519 as Ed25519
import qualified Data.ByteArray as BA

-- Note that we /only/ provide these Eq and Ord instances for test suites.
-- The crypto libraries encourage using key /hashes/ not keys for things
-- like sets, map etc.

instance Eq SigningKey where
  SigningKey
a == :: SigningKey -> SigningKey -> Bool
== SigningKey
b = forall a. EncCBOR a => a -> Hash a
serializeCborHash SigningKey
a forall a. Eq a => a -> a -> Bool
== forall a. EncCBOR a => a -> Hash a
serializeCborHash SigningKey
b

instance Ord Ed25519.PublicKey where
  compare :: PublicKey -> PublicKey -> Ordering
compare PublicKey
x1 PublicKey
x2 = forall a. Ord a => a -> a -> Ordering
compare (forall bin. ByteArrayAccess bin => bin -> ByteString
toByteString PublicKey
x1) (forall bin. ByteArrayAccess bin => bin -> ByteString
toByteString PublicKey
x2)

instance Ord Ed25519.SecretKey where
  compare :: SecretKey -> SecretKey -> Ordering
compare SecretKey
x1 SecretKey
x2 = forall a. Ord a => a -> a -> Ordering
compare (forall bin. ByteArrayAccess bin => bin -> ByteString
toByteString SecretKey
x1) (forall bin. ByteArrayAccess bin => bin -> ByteString
toByteString SecretKey
x2)

instance Ord Ed25519.Signature where
  compare :: Signature -> Signature -> Ordering
compare Signature
x1 Signature
x2 = forall a. Ord a => a -> a -> Ordering
compare (forall bin. ByteArrayAccess bin => bin -> ByteString
toByteString Signature
x1) (forall bin. ByteArrayAccess bin => bin -> ByteString
toByteString Signature
x2)

toByteString :: BA.ByteArrayAccess bin => bin -> ByteString
toByteString :: forall bin. ByteArrayAccess bin => bin -> ByteString
toByteString = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert