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

instance Monad m => ToObjectKey m KeyHash where
  toObjectKey :: KeyHash -> m JSString
toObjectKey = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Format String a -> a
formatToString forall r algo a. Format r (AbstractHash algo a -> r)
hashHexF 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 =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a
Just 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)
      forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a (m :: * -> *) e.
(Typeable a, ReportSchemaErrors m, Buildable e) =>
(Text -> Either e a) -> JSValue -> m a
parseJSString forall algo a.
HashAlgorithm algo =>
Text -> Either Text (AbstractHash algo a)
decodeAbstractHash
      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 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. EncCBOR a => a -> AddressHash a
addressHash