{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}

module Cardano.Chain.Common.KeyHash (
  KeyHash (..),
  hashKey,
) where

import Cardano.Chain.Common.AddressHash
import Cardano.Crypto (decodeAbstractHash, hashHexF)
import Cardano.Crypto.Signing (VerificationKey)
import Cardano.HeapWords (HeapWords)
import Cardano.Ledger.Binary (DecCBOR, EncCBOR)
import Cardano.Prelude
import Formatting (formatToString)
import Formatting.Buildable (Buildable)
import NoThunks.Class (NoThunks (..))
import Text.JSON.Canonical (
  FromObjectKey (..),
  JSValue (..),
  ToObjectKey (..),
  toJSString,
 )

-- | A 'KeyHash' refers to a 'VerificationKey'
newtype KeyHash = KeyHash
  { KeyHash -> AddressHash VerificationKey
unKeyHash :: AddressHash VerificationKey
  }
  deriving
    ( KeyHash -> KeyHash -> Bool
(KeyHash -> KeyHash -> Bool)
-> (KeyHash -> KeyHash -> Bool) -> Eq KeyHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeyHash -> KeyHash -> Bool
== :: KeyHash -> KeyHash -> Bool
$c/= :: KeyHash -> KeyHash -> Bool
/= :: KeyHash -> KeyHash -> Bool
Eq
    , Eq KeyHash
Eq KeyHash =>
(KeyHash -> KeyHash -> Ordering)
-> (KeyHash -> KeyHash -> Bool)
-> (KeyHash -> KeyHash -> Bool)
-> (KeyHash -> KeyHash -> Bool)
-> (KeyHash -> KeyHash -> Bool)
-> (KeyHash -> KeyHash -> KeyHash)
-> (KeyHash -> KeyHash -> KeyHash)
-> Ord KeyHash
KeyHash -> KeyHash -> Bool
KeyHash -> KeyHash -> Ordering
KeyHash -> KeyHash -> KeyHash
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: KeyHash -> KeyHash -> Ordering
compare :: KeyHash -> KeyHash -> Ordering
$c< :: KeyHash -> KeyHash -> Bool
< :: KeyHash -> KeyHash -> Bool
$c<= :: KeyHash -> KeyHash -> Bool
<= :: KeyHash -> KeyHash -> Bool
$c> :: KeyHash -> KeyHash -> Bool
> :: KeyHash -> KeyHash -> Bool
$c>= :: KeyHash -> KeyHash -> Bool
>= :: KeyHash -> KeyHash -> Bool
$cmax :: KeyHash -> KeyHash -> KeyHash
max :: KeyHash -> KeyHash -> KeyHash
$cmin :: KeyHash -> KeyHash -> KeyHash
min :: KeyHash -> KeyHash -> KeyHash
Ord
    , Int -> KeyHash -> ShowS
[KeyHash] -> ShowS
KeyHash -> String
(Int -> KeyHash -> ShowS)
-> (KeyHash -> String) -> ([KeyHash] -> ShowS) -> Show KeyHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeyHash -> ShowS
showsPrec :: Int -> KeyHash -> ShowS
$cshow :: KeyHash -> String
show :: KeyHash -> String
$cshowList :: [KeyHash] -> ShowS
showList :: [KeyHash] -> ShowS
Show
    , KeyHash -> ()
(KeyHash -> ()) -> NFData KeyHash
forall a. (a -> ()) -> NFData a
$crnf :: KeyHash -> ()
rnf :: KeyHash -> ()
NFData
    , KeyHash -> Builder
(KeyHash -> Builder) -> Buildable KeyHash
forall p. (p -> Builder) -> Buildable p
$cbuild :: KeyHash -> Builder
build :: KeyHash -> Builder
Buildable
    , Typeable KeyHash
Typeable KeyHash =>
(forall s. Decoder s KeyHash)
-> (forall s. Proxy KeyHash -> Decoder s ())
-> (Proxy KeyHash -> Text)
-> DecCBOR KeyHash
Proxy KeyHash -> Text
forall s. Decoder s KeyHash
forall a.
Typeable a =>
(forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy KeyHash -> Decoder s ()
$cdecCBOR :: forall s. Decoder s KeyHash
decCBOR :: forall s. Decoder s KeyHash
$cdropCBOR :: forall s. Proxy KeyHash -> Decoder s ()
dropCBOR :: forall s. Proxy KeyHash -> Decoder s ()
$clabel :: Proxy KeyHash -> Text
label :: Proxy KeyHash -> Text
DecCBOR
    , Typeable KeyHash
Typeable KeyHash =>
(KeyHash -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy KeyHash -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy [KeyHash] -> Size)
-> EncCBOR KeyHash
KeyHash -> Encoding
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy [KeyHash] -> Size
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy KeyHash -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> EncCBOR a
$cencCBOR :: KeyHash -> Encoding
encCBOR :: KeyHash -> Encoding
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy KeyHash -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy KeyHash -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy [KeyHash] -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy [KeyHash] -> Size
EncCBOR
    , KeyHash -> Int
(KeyHash -> Int) -> HeapWords KeyHash
forall a. (a -> Int) -> HeapWords a
$cheapWords :: KeyHash -> Int
heapWords :: KeyHash -> Int
HeapWords
    , Context -> KeyHash -> IO (Maybe ThunkInfo)
Proxy KeyHash -> String
(Context -> KeyHash -> IO (Maybe ThunkInfo))
-> (Context -> KeyHash -> IO (Maybe ThunkInfo))
-> (Proxy KeyHash -> String)
-> NoThunks KeyHash
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> KeyHash -> IO (Maybe ThunkInfo)
noThunks :: Context -> KeyHash -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> KeyHash -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> KeyHash -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy KeyHash -> String
showTypeOf :: Proxy KeyHash -> String
NoThunks
    )

instance Monad m => ToObjectKey m KeyHash where
  toObjectKey :: KeyHash -> m JSString
toObjectKey = JSString -> m JSString
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JSString -> m JSString)
-> (KeyHash -> JSString) -> KeyHash -> m JSString
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> JSString
toJSString (String -> JSString) -> (KeyHash -> String) -> KeyHash -> JSString
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format String (AddressHash VerificationKey -> String)
-> AddressHash VerificationKey -> String
forall a. Format String a -> a
formatToString Format String (AddressHash VerificationKey -> String)
forall r algo a. Format r (AbstractHash algo a -> r)
hashHexF (AddressHash VerificationKey -> String)
-> (KeyHash -> AddressHash VerificationKey) -> KeyHash -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. KeyHash -> AddressHash VerificationKey
unKeyHash

instance MonadError SchemaError m => FromObjectKey m KeyHash where
  fromObjectKey :: JSString -> m (Maybe KeyHash)
fromObjectKey =
    (AddressHash VerificationKey -> Maybe KeyHash)
-> m (AddressHash VerificationKey) -> m (Maybe KeyHash)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (KeyHash -> Maybe KeyHash
forall a. a -> Maybe a
Just (KeyHash -> Maybe KeyHash)
-> (AddressHash VerificationKey -> KeyHash)
-> AddressHash VerificationKey
-> Maybe KeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AddressHash VerificationKey -> KeyHash
KeyHash)
      (m (AddressHash VerificationKey) -> m (Maybe KeyHash))
-> (JSString -> m (AddressHash VerificationKey))
-> JSString
-> m (Maybe KeyHash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Text -> Either Text (AddressHash VerificationKey))
-> JSValue -> m (AddressHash VerificationKey)
forall a (m :: * -> *) e.
(Typeable a, ReportSchemaErrors m, Buildable e) =>
(Text -> Either e a) -> JSValue -> m a
parseJSString Text -> Either Text (AddressHash VerificationKey)
forall algo a.
HashAlgorithm algo =>
Text -> Either Text (AbstractHash algo a)
decodeAbstractHash
      (JSValue -> m (AddressHash VerificationKey))
-> (JSString -> JSValue)
-> JSString
-> m (AddressHash VerificationKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. JSString -> JSValue
JSString

hashKey :: VerificationKey -> KeyHash
hashKey :: VerificationKey -> KeyHash
hashKey = AddressHash VerificationKey -> KeyHash
KeyHash (AddressHash VerificationKey -> KeyHash)
-> (VerificationKey -> AddressHash VerificationKey)
-> VerificationKey
-> KeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. VerificationKey -> AddressHash VerificationKey
forall a. EncCBOR a => a -> AddressHash a
addressHash