{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_HADDOCK prune #-}

-- |
-- Copyright: 2020 Input Output (Hong Kong) Ltd., 2021-2022 Input Output Global Inc. (IOG), 2023-2025 Intersect
-- License: Apache-2.0

module Cardano.Address.KeyHash
    (
      KeyHash (..)
    , KeyRole (..)
    , GovernanceType (..)
    , keyHashFromBytes
    , keyHashFromText
    , keyHashToText
    , ErrKeyHashFromText
    , prettyErrKeyHashFromText
    ) where

import Prelude

import Cardano.Address.Derivation
    ( credentialHashSize, hashCredential )
import Codec.Binary.Encoding
    ( AbstractEncoding (..), encode, fromBase16 )
import Control.DeepSeq
    ( NFData )
import Data.Aeson
    ( ToJSON (..), Value (..) )
import Data.Bifunctor
    ( first )
import Data.ByteString
    ( ByteString )
import Data.Either.Combinators
    ( maybeToRight )
import Data.Text
    ( Text )
import GHC.Generics
    ( Generic )

import qualified Cardano.Codec.Bech32.Prefixes as CIP5
import qualified Codec.Binary.Bech32 as Bech32
import qualified Data.ByteString as BS
import qualified Data.Text.Encoding as T

-- | Determines if one asks for deprecated HRP prefixes, '*_vkh' and '*_script'
-- in accordance to CIP-0105 (on demand when flag 'cip-0105' is used) or uses default format
-- specified in CIP-0129 (where additional byte is prepended to 28-byte hash).
data GovernanceType = NoGovernance | CIP0129 | CIP0105
    deriving (GovernanceType -> GovernanceType -> Bool
(GovernanceType -> GovernanceType -> Bool)
-> (GovernanceType -> GovernanceType -> Bool) -> Eq GovernanceType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GovernanceType -> GovernanceType -> Bool
== :: GovernanceType -> GovernanceType -> Bool
$c/= :: GovernanceType -> GovernanceType -> Bool
/= :: GovernanceType -> GovernanceType -> Bool
Eq, Int -> GovernanceType -> ShowS
[GovernanceType] -> ShowS
GovernanceType -> String
(Int -> GovernanceType -> ShowS)
-> (GovernanceType -> String)
-> ([GovernanceType] -> ShowS)
-> Show GovernanceType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GovernanceType -> ShowS
showsPrec :: Int -> GovernanceType -> ShowS
$cshow :: GovernanceType -> String
show :: GovernanceType -> String
$cshowList :: [GovernanceType] -> ShowS
showList :: [GovernanceType] -> ShowS
Show)

-- | Determines the role a given key plays. The role basically can be mapped into derivation path
-- which was used to derive it from the parent. Also it has a dedicated user facing HRP
-- when presented in bech32 format - see 'keyHashToText' for more details.
-- Take notice that purpose/role (except 'Policy') are as defined below in derivation path:
-- m / purpose' / coin_type' / account_ix' / role / index
-- 'Policy' has a dedicated derivation path as follows:
-- m / purpose' / coin_type' / policy_ix'
--
-- |    KeyRole       |   purpose  |  role  |                                  CIP                                         |
-- ------------------------------------------------------------------------------------------------------------------------|
-- | PaymentShared    |   1854H    |   0,1  | [CIP-1854](https://github.com/cardano-foundation/CIPs/tree/master/CIP-1854)  |
-- | DelegationShared |   1854H    |   2    | [CIP-1854](https://github.com/cardano-foundation/CIPs/tree/master/CIP-1854)  |
-- | Payment          |   1852H    |   0,1  | [CIP-1852](https://github.com/cardano-foundation/CIPs/tree/master/CIP-1852)  |
-- | Delegation       |   1852H    |   2    | [CIP-0011](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0011)  |
-- | Representative   |   1852H    |   3    | [CIP-0105](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0105)  |
-- | CommitteeCold    |   1852H    |   4    | [CIP-0105](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0105)  |
-- | CommitteeHot     |   1852H    |   5    | [CIP-0105](https://github.com/cardano-foundation/CIPs/tree/master/CIP-0105)  |
-- | Policy           |   1855H    |   -    | [CIP-1855](https://github.com/cardano-foundation/CIPs/tree/master/CIP-1855)  |
data KeyRole =
      PaymentShared
    | DelegationShared
    | Payment
    | Delegation
    | Policy
    | Representative
    | CommitteeCold
    | CommitteeHot
    | Unknown
    deriving ((forall x. KeyRole -> Rep KeyRole x)
-> (forall x. Rep KeyRole x -> KeyRole) -> Generic KeyRole
forall x. Rep KeyRole x -> KeyRole
forall x. KeyRole -> Rep KeyRole x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. KeyRole -> Rep KeyRole x
from :: forall x. KeyRole -> Rep KeyRole x
$cto :: forall x. Rep KeyRole x -> KeyRole
to :: forall x. Rep KeyRole x -> KeyRole
Generic, Int -> KeyRole -> ShowS
[KeyRole] -> ShowS
KeyRole -> String
(Int -> KeyRole -> ShowS)
-> (KeyRole -> String) -> ([KeyRole] -> ShowS) -> Show KeyRole
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeyRole -> ShowS
showsPrec :: Int -> KeyRole -> ShowS
$cshow :: KeyRole -> String
show :: KeyRole -> String
$cshowList :: [KeyRole] -> ShowS
showList :: [KeyRole] -> ShowS
Show, Eq KeyRole
Eq KeyRole =>
(KeyRole -> KeyRole -> Ordering)
-> (KeyRole -> KeyRole -> Bool)
-> (KeyRole -> KeyRole -> Bool)
-> (KeyRole -> KeyRole -> Bool)
-> (KeyRole -> KeyRole -> Bool)
-> (KeyRole -> KeyRole -> KeyRole)
-> (KeyRole -> KeyRole -> KeyRole)
-> Ord KeyRole
KeyRole -> KeyRole -> Bool
KeyRole -> KeyRole -> Ordering
KeyRole -> KeyRole -> KeyRole
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 :: KeyRole -> KeyRole -> Ordering
compare :: KeyRole -> KeyRole -> Ordering
$c< :: KeyRole -> KeyRole -> Bool
< :: KeyRole -> KeyRole -> Bool
$c<= :: KeyRole -> KeyRole -> Bool
<= :: KeyRole -> KeyRole -> Bool
$c> :: KeyRole -> KeyRole -> Bool
> :: KeyRole -> KeyRole -> Bool
$c>= :: KeyRole -> KeyRole -> Bool
>= :: KeyRole -> KeyRole -> Bool
$cmax :: KeyRole -> KeyRole -> KeyRole
max :: KeyRole -> KeyRole -> KeyRole
$cmin :: KeyRole -> KeyRole -> KeyRole
min :: KeyRole -> KeyRole -> KeyRole
Ord, KeyRole -> KeyRole -> Bool
(KeyRole -> KeyRole -> Bool)
-> (KeyRole -> KeyRole -> Bool) -> Eq KeyRole
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeyRole -> KeyRole -> Bool
== :: KeyRole -> KeyRole -> Bool
$c/= :: KeyRole -> KeyRole -> Bool
/= :: KeyRole -> KeyRole -> Bool
Eq)
instance NFData KeyRole

-- | A 'KeyHash' type represents verification key hash that participate in building
-- multi-signature script. The hash is expected to have size of 28-byte.
--
-- @since 3.0.0
data KeyHash = KeyHash
    { KeyHash -> KeyRole
role :: KeyRole
    , KeyHash -> ByteString
digest :: ByteString }
    deriving ((forall x. KeyHash -> Rep KeyHash x)
-> (forall x. Rep KeyHash x -> KeyHash) -> Generic KeyHash
forall x. Rep KeyHash x -> KeyHash
forall x. KeyHash -> Rep KeyHash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. KeyHash -> Rep KeyHash x
from :: forall x. KeyHash -> Rep KeyHash x
$cto :: forall x. Rep KeyHash x -> KeyHash
to :: forall x. Rep KeyHash x -> KeyHash
Generic, 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, 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, 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)
instance NFData KeyHash

-- | Construct an 'KeyHash' from raw 'ByteString' (28 bytes).
--
-- @since 3.0.0
keyHashFromBytes :: (KeyRole, ByteString) -> Maybe KeyHash
keyHashFromBytes :: (KeyRole, ByteString) -> Maybe KeyHash
keyHashFromBytes (KeyRole
cred, ByteString
bytes)
    | ByteString -> Int
BS.length ByteString
bytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
credentialHashSize = Maybe KeyHash
forall a. Maybe a
Nothing
    | Bool
otherwise = KeyHash -> Maybe KeyHash
forall a. a -> Maybe a
Just (KeyHash -> Maybe KeyHash) -> KeyHash -> Maybe KeyHash
forall a b. (a -> b) -> a -> b
$ KeyRole -> ByteString -> KeyHash
KeyHash KeyRole
cred ByteString
bytes

-- | Encode a 'KeyHash' to bech32 'Text' or hex is key role unknown.
--  If one wants to include, valid in governance roles only, additional byte
--  as specified in CIP-0129, the function needs to be called with withByte=true.
--
-- @since 3.0.0
keyHashToText :: KeyHash -> GovernanceType -> Text
keyHashToText :: KeyHash -> GovernanceType -> Text
keyHashToText (KeyHash KeyRole
cred ByteString
keyHash) GovernanceType
govType = case KeyRole
cred of
    KeyRole
PaymentShared ->
        ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Encoding -> ByteString -> ByteString
encode (HumanReadablePart -> Encoding
forall a. a -> AbstractEncoding a
EBech32 HumanReadablePart
CIP5.addr_shared_vkh) ByteString
keyHash
    KeyRole
DelegationShared ->
        ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Encoding -> ByteString -> ByteString
encode (HumanReadablePart -> Encoding
forall a. a -> AbstractEncoding a
EBech32 HumanReadablePart
CIP5.stake_shared_vkh) ByteString
keyHash
    KeyRole
Payment ->
        ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Encoding -> ByteString -> ByteString
encode (HumanReadablePart -> Encoding
forall a. a -> AbstractEncoding a
EBech32 HumanReadablePart
CIP5.addr_vkh) ByteString
keyHash
    KeyRole
Delegation ->
        ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Encoding -> ByteString -> ByteString
encode (HumanReadablePart -> Encoding
forall a. a -> AbstractEncoding a
EBech32 HumanReadablePart
CIP5.stake_vkh) ByteString
keyHash
    KeyRole
Policy ->
        ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Encoding -> ByteString -> ByteString
encode (HumanReadablePart -> Encoding
forall a. a -> AbstractEncoding a
EBech32 HumanReadablePart
CIP5.policy_vkh) ByteString
keyHash
    KeyRole
Representative -> case GovernanceType
govType of
        GovernanceType
CIP0105 ->
            ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Encoding -> ByteString -> ByteString
encode (HumanReadablePart -> Encoding
forall a. a -> AbstractEncoding a
EBech32 HumanReadablePart
CIP5.drep_vkh) ByteString
keyHash
        GovernanceType
_ ->
            ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Encoding -> ByteString -> ByteString
encode (HumanReadablePart -> Encoding
forall a. a -> AbstractEncoding a
EBech32 HumanReadablePart
CIP5.drep) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> KeyRole -> ByteString
keyHashAppendByteCIP0129 ByteString
keyHash KeyRole
cred
    KeyRole
CommitteeCold -> case GovernanceType
govType of
        GovernanceType
CIP0105 ->
            ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Encoding -> ByteString -> ByteString
encode (HumanReadablePart -> Encoding
forall a. a -> AbstractEncoding a
EBech32 HumanReadablePart
CIP5.cc_cold_vkh) ByteString
keyHash
        GovernanceType
_ ->
            ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Encoding -> ByteString -> ByteString
encode (HumanReadablePart -> Encoding
forall a. a -> AbstractEncoding a
EBech32 HumanReadablePart
CIP5.cc_cold) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> KeyRole -> ByteString
keyHashAppendByteCIP0129 ByteString
keyHash KeyRole
cred
    KeyRole
CommitteeHot -> case GovernanceType
govType of
        GovernanceType
CIP0105 ->
            ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Encoding -> ByteString -> ByteString
encode (HumanReadablePart -> Encoding
forall a. a -> AbstractEncoding a
EBech32 HumanReadablePart
CIP5.cc_hot_vkh) ByteString
keyHash
        GovernanceType
_ ->
            ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Encoding -> ByteString -> ByteString
encode (HumanReadablePart -> Encoding
forall a. a -> AbstractEncoding a
EBech32 HumanReadablePart
CIP5.cc_hot) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> KeyRole -> ByteString
keyHashAppendByteCIP0129 ByteString
keyHash KeyRole
cred
    KeyRole
Unknown ->
        ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Encoding -> ByteString -> ByteString
encode Encoding
forall a. AbstractEncoding a
EBase16 ByteString
keyHash

-- | In accordance to CIP-0129 (https://github.com/cardano-foundation/CIPs/tree/master/CIP-0129)
--   one byte is prepended to vkh only in governance context. The rules how to contruct it are summarized
--   below
--
--   drep       0010....
--   hot        0000....    key type
--   cold       0001....
--
--   keyhash    ....0010
--   This is on top of X_vkh, where X={drep, cc_hot, cc_hot}, which lacks the additional byte.
--   In `keyHashFromText` we additionally
--   support reading legacy X which also lacks the additional byte, and has the same payload as
--   as the corresponding X_vkh.
keyHashAppendByteCIP0129 :: ByteString -> KeyRole -> ByteString
keyHashAppendByteCIP0129 :: ByteString -> KeyRole -> ByteString
keyHashAppendByteCIP0129 ByteString
payload KeyRole
cred =
    ByteString -> (Word8 -> ByteString) -> Maybe Word8 -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
payload (Word8 -> ByteString -> ByteString
`BS.cons` ByteString
payload) Maybe Word8
bytePrefix
  where
    bytePrefix :: Maybe Word8
bytePrefix = case KeyRole
cred of
        KeyRole
Representative -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
0b00100010
        KeyRole
CommitteeCold -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
0b00010010
        KeyRole
CommitteeHot -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
0b00000010
        KeyRole
_ -> Maybe Word8
forall a. Maybe a
Nothing

-- | Construct a 'KeyHash' from 'Text'. It should be
-- Bech32 encoded text with one of following hrp:

-- - `addr_shared_vkh`
-- - `stake_shared_vkh`
-- - `addr_vkh`
-- - `stake_vkh`
-- - `policy_vkh`
-- - `drep`
-- - `cc_cold`
-- - `cc_hot`
-- - `drep_vkh`
-- - `cc_cold_vkh`
-- - `cc_hot_vkh`
-- - `addr_shared_vk`
-- - `stake_shared_vk`
-- - `addr_vk`
-- - `stake_vk`
-- - `policy_vk`
-- - `cc_cold_vk`
-- - `cc_hot_vk`
-- - `addr_shared_xvk`
-- - `stake_shared_xvk`
-- - `addr_xvk`
-- - `stake_xvk`
-- - `policy_xvk`
-- - `drep_xvk`
-- - `cc_cold_xvk`
-- - `cc_hot_xvk`

-- Raw keys will be hashed on the fly, whereas hash that are directly
-- provided will remain as such.
-- If if hex is encountered 'Unknown' policy key is assumed.
--
-- @since 3.1.0
keyHashFromText :: Text -> Either ErrKeyHashFromText KeyHash
keyHashFromText :: Text -> Either ErrKeyHashFromText KeyHash
keyHashFromText Text
txt =
    case (ByteString -> Either String ByteString
fromBase16 (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 Text
txt) of
        Right ByteString
bs ->
            if ByteString -> Int -> Bool
checkBSLength ByteString
bs Int
28 then
                KeyHash -> Either ErrKeyHashFromText KeyHash
forall a. a -> Either ErrKeyHashFromText a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KeyHash -> Either ErrKeyHashFromText KeyHash)
-> KeyHash -> Either ErrKeyHashFromText KeyHash
forall a b. (a -> b) -> a -> b
$ KeyRole -> ByteString -> KeyHash
KeyHash KeyRole
Unknown ByteString
bs
            else if ByteString -> Int -> Bool
checkBSLength ByteString
bs Int
32 then
                KeyHash -> Either ErrKeyHashFromText KeyHash
forall a. a -> Either ErrKeyHashFromText a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KeyHash -> Either ErrKeyHashFromText KeyHash)
-> KeyHash -> Either ErrKeyHashFromText KeyHash
forall a b. (a -> b) -> a -> b
$ KeyRole -> ByteString -> KeyHash
KeyHash KeyRole
Unknown (ByteString -> ByteString
hashCredential ByteString
bs)
            else if ByteString -> Int -> Bool
checkBSLength ByteString
bs Int
64 then
                KeyHash -> Either ErrKeyHashFromText KeyHash
forall a. a -> Either ErrKeyHashFromText a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KeyHash -> Either ErrKeyHashFromText KeyHash)
-> KeyHash -> Either ErrKeyHashFromText KeyHash
forall a b. (a -> b) -> a -> b
$ KeyRole -> ByteString -> KeyHash
KeyHash KeyRole
Unknown (ByteString -> ByteString
hashCredential (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
32 ByteString
bs)
            else
                ErrKeyHashFromText -> Either ErrKeyHashFromText KeyHash
forall a b. a -> Either a b
Left (Int -> ErrKeyHashFromText
ErrKeyHashFromTextInvalidHex (Int -> ErrKeyHashFromText) -> Int -> ErrKeyHashFromText
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
bs)
        Left String
_ -> do
            (HumanReadablePart
hrp, DataPart
dp) <- (DecodingError -> ErrKeyHashFromText)
-> Either DecodingError (HumanReadablePart, DataPart)
-> Either ErrKeyHashFromText (HumanReadablePart, DataPart)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ErrKeyHashFromText -> DecodingError -> ErrKeyHashFromText
forall a b. a -> b -> a
const ErrKeyHashFromText
ErrKeyHashFromTextInvalidString) (Either DecodingError (HumanReadablePart, DataPart)
 -> Either ErrKeyHashFromText (HumanReadablePart, DataPart))
-> Either DecodingError (HumanReadablePart, DataPart)
-> Either ErrKeyHashFromText (HumanReadablePart, DataPart)
forall a b. (a -> b) -> a -> b
$
                Text -> Either DecodingError (HumanReadablePart, DataPart)
Bech32.decodeLenient Text
txt

            ErrKeyHashFromText
-> Maybe ByteString -> Either ErrKeyHashFromText ByteString
forall b a. b -> Maybe a -> Either b a
maybeToRight ErrKeyHashFromText
ErrKeyHashFromTextWrongDataPart (DataPart -> Maybe ByteString
Bech32.dataPartToBytes DataPart
dp)
                Either ErrKeyHashFromText ByteString
-> (ByteString -> Either ErrKeyHashFromText (KeyRole, ByteString))
-> Either ErrKeyHashFromText (KeyRole, ByteString)
forall a b.
Either ErrKeyHashFromText a
-> (a -> Either ErrKeyHashFromText b)
-> Either ErrKeyHashFromText b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ErrKeyHashFromText
-> Maybe (KeyRole, ByteString)
-> Either ErrKeyHashFromText (KeyRole, ByteString)
forall b a. b -> Maybe a -> Either b a
maybeToRight ErrKeyHashFromText
ErrKeyHashFromTextWrongHrp (Maybe (KeyRole, ByteString)
 -> Either ErrKeyHashFromText (KeyRole, ByteString))
-> (ByteString -> Maybe (KeyRole, ByteString))
-> ByteString
-> Either ErrKeyHashFromText (KeyRole, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HumanReadablePart -> ByteString -> Maybe (KeyRole, ByteString)
convertBytes HumanReadablePart
hrp
                Either ErrKeyHashFromText (KeyRole, ByteString)
-> ((KeyRole, ByteString) -> Either ErrKeyHashFromText KeyHash)
-> Either ErrKeyHashFromText KeyHash
forall a b.
Either ErrKeyHashFromText a
-> (a -> Either ErrKeyHashFromText b)
-> Either ErrKeyHashFromText b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ErrKeyHashFromText
-> Maybe KeyHash -> Either ErrKeyHashFromText KeyHash
forall b a. b -> Maybe a -> Either b a
maybeToRight ErrKeyHashFromText
ErrKeyHashFromTextWrongPayload (Maybe KeyHash -> Either ErrKeyHashFromText KeyHash)
-> ((KeyRole, ByteString) -> Maybe KeyHash)
-> (KeyRole, ByteString)
-> Either ErrKeyHashFromText KeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyRole, ByteString) -> Maybe KeyHash
keyHashFromBytes
 where
    convertBytes :: HumanReadablePart -> ByteString -> Maybe (KeyRole, ByteString)
convertBytes HumanReadablePart
hrp ByteString
bytes
        | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.addr_shared_vkh Bool -> Bool -> Bool
&& ByteString -> Int -> Bool
checkBSLength ByteString
bytes Int
28 =
              (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
Payment, ByteString
bytes)
        | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.stake_shared_vkh Bool -> Bool -> Bool
&& ByteString -> Int -> Bool
checkBSLength ByteString
bytes Int
28 =
              (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
Delegation, ByteString
bytes)
        | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.addr_vkh Bool -> Bool -> Bool
&& ByteString -> Int -> Bool
checkBSLength ByteString
bytes Int
28 =
              (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
Payment, ByteString
bytes)
        | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.stake_vkh Bool -> Bool -> Bool
&& ByteString -> Int -> Bool
checkBSLength ByteString
bytes Int
28 =
              (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
Delegation, ByteString
bytes)
        | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.policy_vkh Bool -> Bool -> Bool
&& ByteString -> Int -> Bool
checkBSLength ByteString
bytes Int
28 =
              (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
Policy, ByteString
bytes)
        | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.drep Bool -> Bool -> Bool
&& ByteString -> Int -> Bool
checkBSLength ByteString
bytes Int
29 =
              let (Word8
fstByte, ByteString
payload) = (ByteString -> Word8)
-> (ByteString, ByteString) -> (Word8, ByteString)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first HasCallStack => ByteString -> Word8
ByteString -> Word8
BS.head ((ByteString, ByteString) -> (Word8, ByteString))
-> (ByteString, ByteString) -> (Word8, ByteString)
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
1 ByteString
bytes
              --   drep          0010....
              --   keyhash       ....0010
              in if Word8
fstByte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0b00100010 then
                  (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
Representative, ByteString
payload)
                 else
                  Maybe (KeyRole, ByteString)
forall a. Maybe a
Nothing
        | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.drep Bool -> Bool -> Bool
&& ByteString -> Int -> Bool
checkBSLength ByteString
bytes Int
28 =
              (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
Representative, ByteString
bytes)
        | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.drep_vkh Bool -> Bool -> Bool
&& ByteString -> Int -> Bool
checkBSLength ByteString
bytes Int
28 =
              (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
Representative, ByteString
bytes)
        | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.cc_cold Bool -> Bool -> Bool
&& ByteString -> Int -> Bool
checkBSLength ByteString
bytes Int
29 =
              let (Word8
fstByte, ByteString
payload) = (ByteString -> Word8)
-> (ByteString, ByteString) -> (Word8, ByteString)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first HasCallStack => ByteString -> Word8
ByteString -> Word8
BS.head ((ByteString, ByteString) -> (Word8, ByteString))
-> (ByteString, ByteString) -> (Word8, ByteString)
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
1 ByteString
bytes
              --   cold          0001....
              --   keyhash       ....0010
              in if Word8
fstByte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0b00010010 then
                  (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
CommitteeCold, ByteString
payload)
                 else
                  Maybe (KeyRole, ByteString)
forall a. Maybe a
Nothing
        | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.cc_cold Bool -> Bool -> Bool
&& ByteString -> Int -> Bool
checkBSLength ByteString
bytes Int
28 =
              (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
CommitteeCold, ByteString
bytes)
        | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.cc_cold_vkh Bool -> Bool -> Bool
&& ByteString -> Int -> Bool
checkBSLength ByteString
bytes Int
28 =
              (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
CommitteeCold, ByteString
bytes)
        | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.cc_hot Bool -> Bool -> Bool
&& ByteString -> Int -> Bool
checkBSLength ByteString
bytes Int
29 =
              let (Word8
fstByte, ByteString
payload) = (ByteString -> Word8)
-> (ByteString, ByteString) -> (Word8, ByteString)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first HasCallStack => ByteString -> Word8
ByteString -> Word8
BS.head ((ByteString, ByteString) -> (Word8, ByteString))
-> (ByteString, ByteString) -> (Word8, ByteString)
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
1 ByteString
bytes
              --   hot           0000....
              --   keyhash       ....0010
              in if Word8
fstByte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0b00000010 then
                  (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
CommitteeHot, ByteString
payload)
                 else
                  Maybe (KeyRole, ByteString)
forall a. Maybe a
Nothing
        | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.cc_hot Bool -> Bool -> Bool
&& ByteString -> Int -> Bool
checkBSLength ByteString
bytes Int
28 =
              (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
CommitteeHot, ByteString
bytes)
        | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.cc_hot_vkh Bool -> Bool -> Bool
&& ByteString -> Int -> Bool
checkBSLength ByteString
bytes Int
28 =
              (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
CommitteeHot, ByteString
bytes)
        | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.addr_shared_vk Bool -> Bool -> Bool
&& ByteString -> Int -> Bool
checkBSLength ByteString
bytes Int
32 =
              (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
Payment, ByteString -> ByteString
hashCredential ByteString
bytes)
        | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.addr_vk Bool -> Bool -> Bool
&& ByteString -> Int -> Bool
checkBSLength ByteString
bytes Int
32 =
              (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
Payment, ByteString -> ByteString
hashCredential ByteString
bytes)
        | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.addr_shared_xvk Bool -> Bool -> Bool
&& ByteString -> Int -> Bool
checkBSLength ByteString
bytes Int
64 =
              (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
Payment, ByteString -> ByteString
hashCredential (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
32 ByteString
bytes)
        | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.addr_xvk Bool -> Bool -> Bool
&& ByteString -> Int -> Bool
checkBSLength ByteString
bytes Int
64 =
              (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
Payment, ByteString -> ByteString
hashCredential (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
32 ByteString
bytes)
        | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.stake_shared_vk Bool -> Bool -> Bool
&& ByteString -> Int -> Bool
checkBSLength ByteString
bytes Int
32 =
              (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
Delegation, ByteString -> ByteString
hashCredential ByteString
bytes)
        | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.stake_vk Bool -> Bool -> Bool
&& ByteString -> Int -> Bool
checkBSLength ByteString
bytes Int
32 =
              (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
Delegation, ByteString -> ByteString
hashCredential ByteString
bytes)
        | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.stake_shared_xvk Bool -> Bool -> Bool
&& ByteString -> Int -> Bool
checkBSLength ByteString
bytes Int
64 =
              (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
Delegation, ByteString -> ByteString
hashCredential (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
32 ByteString
bytes)
        | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.stake_xvk Bool -> Bool -> Bool
&& ByteString -> Int -> Bool
checkBSLength ByteString
bytes Int
64 =
              (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
Delegation, ByteString -> ByteString
hashCredential (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
32 ByteString
bytes)
        | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.policy_vk Bool -> Bool -> Bool
&& ByteString -> Int -> Bool
checkBSLength ByteString
bytes Int
32 =
              (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
Policy, ByteString -> ByteString
hashCredential ByteString
bytes)
        | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.policy_xvk Bool -> Bool -> Bool
&& ByteString -> Int -> Bool
checkBSLength ByteString
bytes Int
64 =
              (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
Policy, ByteString -> ByteString
hashCredential (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
32 ByteString
bytes)
        | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.drep_vk Bool -> Bool -> Bool
&& ByteString -> Int -> Bool
checkBSLength ByteString
bytes Int
32 =
              (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
Representative, ByteString -> ByteString
hashCredential ByteString
bytes)
        | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.drep_xvk Bool -> Bool -> Bool
&& ByteString -> Int -> Bool
checkBSLength ByteString
bytes Int
64 =
              (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
Representative, ByteString -> ByteString
hashCredential (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
32 ByteString
bytes)
        | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.cc_cold_vk Bool -> Bool -> Bool
&& ByteString -> Int -> Bool
checkBSLength ByteString
bytes Int
32 =
              (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
CommitteeCold, ByteString -> ByteString
hashCredential ByteString
bytes)
        | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.cc_cold_xvk Bool -> Bool -> Bool
&& ByteString -> Int -> Bool
checkBSLength ByteString
bytes Int
64 =
              (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
CommitteeCold, ByteString -> ByteString
hashCredential (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
32 ByteString
bytes)
        | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.cc_hot_vk Bool -> Bool -> Bool
&& ByteString -> Int -> Bool
checkBSLength ByteString
bytes Int
32 =
              (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
CommitteeHot, ByteString -> ByteString
hashCredential ByteString
bytes)
        | HumanReadablePart
hrp HumanReadablePart -> HumanReadablePart -> Bool
forall a. Eq a => a -> a -> Bool
== HumanReadablePart
CIP5.cc_hot_xvk Bool -> Bool -> Bool
&& ByteString -> Int -> Bool
checkBSLength ByteString
bytes Int
64 =
              (KeyRole, ByteString) -> Maybe (KeyRole, ByteString)
forall a. a -> Maybe a
Just (KeyRole
CommitteeHot, ByteString -> ByteString
hashCredential (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
32 ByteString
bytes)
        | Bool
otherwise = Maybe (KeyRole, ByteString)
forall a. Maybe a
Nothing
    checkBSLength :: ByteString -> Int -> Bool
    checkBSLength :: ByteString -> Int -> Bool
checkBSLength ByteString
bytes Int
expLength =
        ByteString -> Int
BS.length ByteString
bytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
expLength

-- Possible errors when deserializing a key hash from text.
--
-- @since 3.0.0
data ErrKeyHashFromText
    = ErrKeyHashFromTextInvalidString
    | ErrKeyHashFromTextWrongPayload
    | ErrKeyHashFromTextWrongHrp
    | ErrKeyHashFromTextWrongDataPart
    | ErrKeyHashFromTextInvalidHex Int
    deriving (Int -> ErrKeyHashFromText -> ShowS
[ErrKeyHashFromText] -> ShowS
ErrKeyHashFromText -> String
(Int -> ErrKeyHashFromText -> ShowS)
-> (ErrKeyHashFromText -> String)
-> ([ErrKeyHashFromText] -> ShowS)
-> Show ErrKeyHashFromText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ErrKeyHashFromText -> ShowS
showsPrec :: Int -> ErrKeyHashFromText -> ShowS
$cshow :: ErrKeyHashFromText -> String
show :: ErrKeyHashFromText -> String
$cshowList :: [ErrKeyHashFromText] -> ShowS
showList :: [ErrKeyHashFromText] -> ShowS
Show, ErrKeyHashFromText -> ErrKeyHashFromText -> Bool
(ErrKeyHashFromText -> ErrKeyHashFromText -> Bool)
-> (ErrKeyHashFromText -> ErrKeyHashFromText -> Bool)
-> Eq ErrKeyHashFromText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ErrKeyHashFromText -> ErrKeyHashFromText -> Bool
== :: ErrKeyHashFromText -> ErrKeyHashFromText -> Bool
$c/= :: ErrKeyHashFromText -> ErrKeyHashFromText -> Bool
/= :: ErrKeyHashFromText -> ErrKeyHashFromText -> Bool
Eq)

-- Possible errors when deserializing a key hash from text.
--
-- @since 3.0.0
prettyErrKeyHashFromText :: ErrKeyHashFromText -> String
prettyErrKeyHashFromText :: ErrKeyHashFromText -> String
prettyErrKeyHashFromText = \case
    ErrKeyHashFromText
ErrKeyHashFromTextInvalidString ->
        String
"Invalid encoded string: must be either bech32 or hex-encoded."
    ErrKeyHashFromText
ErrKeyHashFromTextWrongPayload ->
        String
"Verification key hash must contain exactly 28 bytes."
    ErrKeyHashFromText
ErrKeyHashFromTextWrongHrp ->
        String
"Invalid human-readable prefix: must be 'X_vkh', 'X_vk', 'X_xvk' where X is 'addr_shared', 'stake_shared' or 'policy'."
    ErrKeyHashFromText
ErrKeyHashFromTextWrongDataPart ->
        String
"Verification key hash is Bech32-encoded but has an invalid data part."
    ErrKeyHashFromTextInvalidHex Int
size->
        String
"Invalid hex-encoded string: must be either 28, 32 or 64 bytes, but has " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
size String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" bytes."

instance ToJSON KeyHash where
    toJSON :: KeyHash -> Value
toJSON = Text -> Value
String (Text -> Value) -> (KeyHash -> Text) -> KeyHash -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyHash -> GovernanceType -> Text)
-> GovernanceType -> KeyHash -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip KeyHash -> GovernanceType -> Text
keyHashToText GovernanceType
CIP0129