{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

module Cardano.Api.Serialise.Cip129
  ( Cip129 (..)
  , Cip129EncodingError
  , deserialiseFromBech32Cip129
  , serialiseToBech32Cip129
  , serialiseGovActionIdToBech32Cip129
  , deserialiseGovActionIdFromBech32Cip129
  , AsType (AsColdCommitteeCredential, AsDrepCredential, AsHotCommitteeCredential)
  )
where

import Cardano.Api.Error
import Cardano.Api.Governance.Internal.Action.ProposalProcedure
import Cardano.Api.HasTypeProxy
import Cardano.Api.Internal.Orphans (AsType (..))
import Cardano.Api.Monad.Error
import Cardano.Api.Pretty
import Cardano.Api.Serialise.Bech32
import Cardano.Api.Serialise.Raw
import Cardano.Api.Serialise.SerialiseUsing

import Cardano.Crypto.Hash.Class qualified as Hash
import Cardano.Ledger.Conway.Governance qualified as Gov
import Cardano.Ledger.Core qualified as L
import Cardano.Ledger.Credential (Credential (..))
import Cardano.Ledger.Credential qualified as L

import Codec.Binary.Bech32 qualified as Bech32
import Control.Monad (guard)
import Data.ByteString qualified as BS
import Data.ByteString.Base16 qualified as Base16
import Data.Typeable
import Data.Word (Word8)
import GHC.Exts (IsList (..))

-- | Cip-129 is a typeclass that captures the serialisation requirements of https://cips.cardano.org/cip/CIP-0129
-- which pertain to governance credentials and governance action ids.
class (SerialiseAsRawBytes a, HasTypeProxy a) => Cip129 a where
  -- | The human readable part of the Bech32 encoding for the credential.
  cip129Bech32PrefixFor :: AsType a -> Bech32.HumanReadablePart

  -- | Permitted bech32 prefixes according to CIP-129.
  cip129Bech32PrefixesPermitted :: AsType a -> [Text]
  default cip129Bech32PrefixesPermitted :: AsType a -> [Text]
  cip129Bech32PrefixesPermitted = Text -> [Text]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> [Text]) -> (AsType a -> Text) -> AsType a -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HumanReadablePart -> Text
Bech32.humanReadablePartToText (HumanReadablePart -> Text)
-> (AsType a -> HumanReadablePart) -> AsType a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsType a -> HumanReadablePart
forall a. Cip129 a => AsType a -> HumanReadablePart
cip129Bech32PrefixFor

  -- | A sum type with all possible headers for CIP-129 identifier
  data Cip129Header a

  -- | A 'Word8' value of Cip129 header
  cip129Header :: Cip129Header a -> Word8

  -- | Serialise a value to a binary representation used in CIP 129. It's usually distinct from CBOR serialisation.
  -- Internal conversion function. Use 'serialiseToBech32Cip129' instead of calling this function directly.
  cip129SerialiseRaw :: a -> BS.ByteString

  -- | Deserialise a value from the bytes representation. Internal conversion function. Use
  -- 'deserialiseFromBech32Cip129' instead of calling this function directly.
  cip129DeserialiseRaw :: BS.ByteString -> Either Cip129EncodingError a

-- | CIP-129 decoding errors
data Cip129EncodingError
  = Cip129TypeDecodingError TypeRep BS.ByteString
  | Cip129UnknownHeaderError TypeRep Word8
  | Cip129EmptyBytesError TypeRep
  | Cip129Bech32Error TypeRep Bech32DecodeError
  deriving (Cip129EncodingError -> Cip129EncodingError -> Bool
(Cip129EncodingError -> Cip129EncodingError -> Bool)
-> (Cip129EncodingError -> Cip129EncodingError -> Bool)
-> Eq Cip129EncodingError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cip129EncodingError -> Cip129EncodingError -> Bool
== :: Cip129EncodingError -> Cip129EncodingError -> Bool
$c/= :: Cip129EncodingError -> Cip129EncodingError -> Bool
/= :: Cip129EncodingError -> Cip129EncodingError -> Bool
Eq, Int -> Cip129EncodingError -> ShowS
[Cip129EncodingError] -> ShowS
Cip129EncodingError -> String
(Int -> Cip129EncodingError -> ShowS)
-> (Cip129EncodingError -> String)
-> ([Cip129EncodingError] -> ShowS)
-> Show Cip129EncodingError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cip129EncodingError -> ShowS
showsPrec :: Int -> Cip129EncodingError -> ShowS
$cshow :: Cip129EncodingError -> String
show :: Cip129EncodingError -> String
$cshowList :: [Cip129EncodingError] -> ShowS
showList :: [Cip129EncodingError] -> ShowS
Show)

instance Error Cip129EncodingError where
  prettyError :: forall ann. Cip129EncodingError -> Doc ann
prettyError = \case
    Cip129TypeDecodingError SomeTypeRep
tr ByteString
bytes ->
      Doc ann
"Cannot decode CIP129 encoding of a type \""
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> SomeTypeRep -> Doc ann
forall ann. SomeTypeRep -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty SomeTypeRep
tr
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"\", bytes hex: "
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> UsingRawBytesHex ByteString -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. UsingRawBytesHex ByteString -> Doc ann
pretty (ByteString -> UsingRawBytesHex ByteString
forall a. a -> UsingRawBytesHex a
UsingRawBytesHex ByteString
bytes)
    Cip129UnknownHeaderError SomeTypeRep
tr Word8
header ->
      Doc ann
"Cannot decode CIP129 header of a type \""
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> SomeTypeRep -> Doc ann
forall ann. SomeTypeRep -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty SomeTypeRep
tr
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"\", header bytes hex: "
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> UsingRawBytesHex Word8 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. UsingRawBytesHex Word8 -> Doc ann
pretty (Word8 -> UsingRawBytesHex Word8
forall a. a -> UsingRawBytesHex a
UsingRawBytesHex Word8
header)
    Cip129EmptyBytesError SomeTypeRep
tr ->
      Doc ann
"Cannot decode CIP129 header of a type \"" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> SomeTypeRep -> Doc ann
forall ann. SomeTypeRep -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty SomeTypeRep
tr Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"\", cannot decode empty bytes"
    Cip129Bech32Error SomeTypeRep
tr Bech32DecodeError
be ->
      Doc ann
"Cannot decode CIP129 encoding of a type \""
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> SomeTypeRep -> Doc ann
forall ann. SomeTypeRep -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty SomeTypeRep
tr
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"\", due to Bech32 decoding error: "
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Bech32DecodeError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. Bech32DecodeError -> Doc ann
prettyError Bech32DecodeError
be

instance Cip129 (Credential L.ColdCommitteeRole) where
  cip129Bech32PrefixFor :: AsType (Credential ColdCommitteeRole) -> HumanReadablePart
cip129Bech32PrefixFor AsType (Credential ColdCommitteeRole)
_ = HasCallStack => Text -> HumanReadablePart
Text -> HumanReadablePart
unsafeHumanReadablePartFromText Text
"cc_cold"
  cip129Bech32PrefixesPermitted :: AsType (Credential ColdCommitteeRole) -> [Text]
cip129Bech32PrefixesPermitted AsType (Credential ColdCommitteeRole)
R:AsTypeCredential3
AsColdCommitteeCredential = [Text
"cc_cold"]

  data Cip129Header (Credential L.ColdCommitteeRole)
    = Cip129CredColdCommitteKey
    | Cip129CredColdCommitteScript

  cip129Header :: Cip129Header (Credential ColdCommitteeRole) -> Word8
cip129Header = \case
    Cip129Header (Credential ColdCommitteeRole)
R:Cip129HeaderCredential3
Cip129CredColdCommitteKey -> Word8
0b0001_0010
    Cip129Header (Credential ColdCommitteeRole)
R:Cip129HeaderCredential3
Cip129CredColdCommitteScript -> Word8
0b0001_0011

  cip129SerialiseRaw :: Credential ColdCommitteeRole -> ByteString
cip129SerialiseRaw = \case
    L.KeyHashObj (L.KeyHash Hash ADDRHASH (VerKeyDSIGN DSIGN)
kh) -> Word8 -> ByteString
BS.singleton (Cip129Header (Credential ColdCommitteeRole) -> Word8
forall a. Cip129 a => Cip129Header a -> Word8
cip129Header Cip129Header (Credential ColdCommitteeRole)
Cip129CredColdCommitteKey) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Hash ADDRHASH (VerKeyDSIGN DSIGN) -> ByteString
forall h a. Hash h a -> ByteString
Hash.hashToBytes Hash ADDRHASH (VerKeyDSIGN DSIGN)
kh
    L.ScriptHashObj (L.ScriptHash Hash ADDRHASH EraIndependentScript
sh) -> Word8 -> ByteString
BS.singleton (Cip129Header (Credential ColdCommitteeRole) -> Word8
forall a. Cip129 a => Cip129Header a -> Word8
cip129Header Cip129Header (Credential ColdCommitteeRole)
Cip129CredColdCommitteScript) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Hash ADDRHASH EraIndependentScript -> ByteString
forall h a. Hash h a -> ByteString
Hash.hashToBytes Hash ADDRHASH EraIndependentScript
sh

  cip129DeserialiseRaw
    :: forall a
     . a ~ Credential L.ColdCommitteeRole
    => BS.ByteString
    -> Either Cip129EncodingError a
  cip129DeserialiseRaw :: forall a.
(a ~ Credential ColdCommitteeRole) =>
ByteString -> Either Cip129EncodingError a
cip129DeserialiseRaw ByteString
bytes = do
    let t :: SomeTypeRep
t = Proxy a -> SomeTypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> SomeTypeRep
typeRep (Proxy a -> SomeTypeRep) -> Proxy a -> SomeTypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a
    case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bytes of
      Just (Word8
header, ByteString
cred)
        | Word8
header Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Cip129Header (Credential ColdCommitteeRole) -> Word8
forall a. Cip129 a => Cip129Header a -> Word8
cip129Header Cip129Header (Credential ColdCommitteeRole)
Cip129CredColdCommitteKey ->
            KeyHash ColdCommitteeRole -> a
KeyHash ColdCommitteeRole -> Credential ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
L.KeyHashObj (KeyHash ColdCommitteeRole -> a)
-> (Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash ColdCommitteeRole)
-> Hash ADDRHASH (VerKeyDSIGN DSIGN)
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash ColdCommitteeRole
forall (r :: KeyRole).
Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
L.KeyHash (Hash ADDRHASH (VerKeyDSIGN DSIGN) -> a)
-> Either Cip129EncodingError (Hash ADDRHASH (VerKeyDSIGN DSIGN))
-> Either Cip129EncodingError a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (Hash ADDRHASH (VerKeyDSIGN DSIGN))
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Hash.hashFromBytes ByteString
cred Maybe (Hash ADDRHASH (VerKeyDSIGN DSIGN))
-> Cip129EncodingError
-> Either Cip129EncodingError (Hash ADDRHASH (VerKeyDSIGN DSIGN))
forall e (m :: * -> *) a. MonadError e m => Maybe a -> e -> m a
?! SomeTypeRep -> ByteString -> Cip129EncodingError
Cip129TypeDecodingError SomeTypeRep
t ByteString
bytes
        | Word8
header Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Cip129Header (Credential ColdCommitteeRole) -> Word8
forall a. Cip129 a => Cip129Header a -> Word8
cip129Header Cip129Header (Credential ColdCommitteeRole)
Cip129CredColdCommitteScript ->
            ScriptHash -> a
ScriptHash -> Credential ColdCommitteeRole
forall (kr :: KeyRole). ScriptHash -> Credential kr
L.ScriptHashObj (ScriptHash -> a)
-> (Hash ADDRHASH EraIndependentScript -> ScriptHash)
-> Hash ADDRHASH EraIndependentScript
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash ADDRHASH EraIndependentScript -> ScriptHash
L.ScriptHash (Hash ADDRHASH EraIndependentScript -> a)
-> Either Cip129EncodingError (Hash ADDRHASH EraIndependentScript)
-> Either Cip129EncodingError a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (Hash ADDRHASH EraIndependentScript)
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Hash.hashFromBytes ByteString
cred Maybe (Hash ADDRHASH EraIndependentScript)
-> Cip129EncodingError
-> Either Cip129EncodingError (Hash ADDRHASH EraIndependentScript)
forall e (m :: * -> *) a. MonadError e m => Maybe a -> e -> m a
?! SomeTypeRep -> ByteString -> Cip129EncodingError
Cip129TypeDecodingError SomeTypeRep
t ByteString
bytes
        | Bool
otherwise -> Cip129EncodingError -> Either Cip129EncodingError a
forall a. Cip129EncodingError -> Either Cip129EncodingError a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Cip129EncodingError -> Either Cip129EncodingError a)
-> Cip129EncodingError -> Either Cip129EncodingError a
forall a b. (a -> b) -> a -> b
$ SomeTypeRep -> Word8 -> Cip129EncodingError
Cip129UnknownHeaderError SomeTypeRep
t Word8
header
      Maybe (Word8, ByteString)
Nothing -> Cip129EncodingError -> Either Cip129EncodingError a
forall a. Cip129EncodingError -> Either Cip129EncodingError a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Cip129EncodingError -> Either Cip129EncodingError a)
-> Cip129EncodingError -> Either Cip129EncodingError a
forall a b. (a -> b) -> a -> b
$ SomeTypeRep -> Cip129EncodingError
Cip129EmptyBytesError SomeTypeRep
t

instance Cip129 (Credential L.HotCommitteeRole) where
  cip129Bech32PrefixFor :: AsType (Credential HotCommitteeRole) -> HumanReadablePart
cip129Bech32PrefixFor AsType (Credential HotCommitteeRole)
_ = HasCallStack => Text -> HumanReadablePart
Text -> HumanReadablePart
unsafeHumanReadablePartFromText Text
"cc_hot"
  cip129Bech32PrefixesPermitted :: AsType (Credential HotCommitteeRole) -> [Text]
cip129Bech32PrefixesPermitted AsType (Credential HotCommitteeRole)
R:AsTypeCredential1
AsHotCommitteeCredential = [Text
"cc_hot"]

  data Cip129Header (Credential L.HotCommitteeRole)
    = Cip129CredHotCommitteKey
    | Cip129CredHotCommitteScript

  cip129Header :: Cip129Header (Credential HotCommitteeRole) -> Word8
cip129Header = \case
    Cip129Header (Credential HotCommitteeRole)
R:Cip129HeaderCredential1
Cip129CredHotCommitteKey -> Word8
0b0000_0010
    Cip129Header (Credential HotCommitteeRole)
R:Cip129HeaderCredential1
Cip129CredHotCommitteScript -> Word8
0b0000_0011

  cip129SerialiseRaw :: Credential HotCommitteeRole -> ByteString
cip129SerialiseRaw = \case
    L.KeyHashObj (L.KeyHash Hash ADDRHASH (VerKeyDSIGN DSIGN)
kh) -> Word8 -> ByteString
BS.singleton (Cip129Header (Credential HotCommitteeRole) -> Word8
forall a. Cip129 a => Cip129Header a -> Word8
cip129Header Cip129Header (Credential HotCommitteeRole)
Cip129CredHotCommitteKey) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Hash ADDRHASH (VerKeyDSIGN DSIGN) -> ByteString
forall h a. Hash h a -> ByteString
Hash.hashToBytes Hash ADDRHASH (VerKeyDSIGN DSIGN)
kh
    L.ScriptHashObj (L.ScriptHash Hash ADDRHASH EraIndependentScript
sh) -> Word8 -> ByteString
BS.singleton (Cip129Header (Credential HotCommitteeRole) -> Word8
forall a. Cip129 a => Cip129Header a -> Word8
cip129Header Cip129Header (Credential HotCommitteeRole)
Cip129CredHotCommitteScript) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Hash ADDRHASH EraIndependentScript -> ByteString
forall h a. Hash h a -> ByteString
Hash.hashToBytes Hash ADDRHASH EraIndependentScript
sh

  cip129DeserialiseRaw
    :: forall a
     . a ~ Credential L.HotCommitteeRole
    => BS.ByteString
    -> Either Cip129EncodingError a
  cip129DeserialiseRaw :: forall a.
(a ~ Credential HotCommitteeRole) =>
ByteString -> Either Cip129EncodingError a
cip129DeserialiseRaw ByteString
bytes = do
    let t :: SomeTypeRep
t = Proxy a -> SomeTypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> SomeTypeRep
typeRep (Proxy a -> SomeTypeRep) -> Proxy a -> SomeTypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a
    case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bytes of
      Just (Word8
header, ByteString
cred)
        | Word8
header Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Cip129Header (Credential HotCommitteeRole) -> Word8
forall a. Cip129 a => Cip129Header a -> Word8
cip129Header Cip129Header (Credential HotCommitteeRole)
Cip129CredHotCommitteKey ->
            KeyHash HotCommitteeRole -> a
KeyHash HotCommitteeRole -> Credential HotCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
L.KeyHashObj (KeyHash HotCommitteeRole -> a)
-> (Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash HotCommitteeRole)
-> Hash ADDRHASH (VerKeyDSIGN DSIGN)
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash HotCommitteeRole
forall (r :: KeyRole).
Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
L.KeyHash (Hash ADDRHASH (VerKeyDSIGN DSIGN) -> a)
-> Either Cip129EncodingError (Hash ADDRHASH (VerKeyDSIGN DSIGN))
-> Either Cip129EncodingError a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (Hash ADDRHASH (VerKeyDSIGN DSIGN))
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Hash.hashFromBytes ByteString
cred Maybe (Hash ADDRHASH (VerKeyDSIGN DSIGN))
-> Cip129EncodingError
-> Either Cip129EncodingError (Hash ADDRHASH (VerKeyDSIGN DSIGN))
forall e (m :: * -> *) a. MonadError e m => Maybe a -> e -> m a
?! SomeTypeRep -> ByteString -> Cip129EncodingError
Cip129TypeDecodingError SomeTypeRep
t ByteString
bytes
        | Word8
header Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Cip129Header (Credential HotCommitteeRole) -> Word8
forall a. Cip129 a => Cip129Header a -> Word8
cip129Header Cip129Header (Credential HotCommitteeRole)
Cip129CredHotCommitteScript ->
            ScriptHash -> a
ScriptHash -> Credential HotCommitteeRole
forall (kr :: KeyRole). ScriptHash -> Credential kr
L.ScriptHashObj (ScriptHash -> a)
-> (Hash ADDRHASH EraIndependentScript -> ScriptHash)
-> Hash ADDRHASH EraIndependentScript
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash ADDRHASH EraIndependentScript -> ScriptHash
L.ScriptHash (Hash ADDRHASH EraIndependentScript -> a)
-> Either Cip129EncodingError (Hash ADDRHASH EraIndependentScript)
-> Either Cip129EncodingError a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (Hash ADDRHASH EraIndependentScript)
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Hash.hashFromBytes ByteString
cred Maybe (Hash ADDRHASH EraIndependentScript)
-> Cip129EncodingError
-> Either Cip129EncodingError (Hash ADDRHASH EraIndependentScript)
forall e (m :: * -> *) a. MonadError e m => Maybe a -> e -> m a
?! SomeTypeRep -> ByteString -> Cip129EncodingError
Cip129TypeDecodingError SomeTypeRep
t ByteString
bytes
        | Bool
otherwise -> Cip129EncodingError -> Either Cip129EncodingError a
forall a. Cip129EncodingError -> Either Cip129EncodingError a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Cip129EncodingError -> Either Cip129EncodingError a)
-> Cip129EncodingError -> Either Cip129EncodingError a
forall a b. (a -> b) -> a -> b
$ SomeTypeRep -> Word8 -> Cip129EncodingError
Cip129UnknownHeaderError SomeTypeRep
t Word8
header
      Maybe (Word8, ByteString)
Nothing -> Cip129EncodingError -> Either Cip129EncodingError a
forall a. Cip129EncodingError -> Either Cip129EncodingError a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Cip129EncodingError -> Either Cip129EncodingError a)
-> Cip129EncodingError -> Either Cip129EncodingError a
forall a b. (a -> b) -> a -> b
$ SomeTypeRep -> Cip129EncodingError
Cip129EmptyBytesError SomeTypeRep
t

instance Cip129 (Credential L.DRepRole) where
  cip129Bech32PrefixFor :: AsType (Credential DRepRole) -> HumanReadablePart
cip129Bech32PrefixFor AsType (Credential DRepRole)
_ = HasCallStack => Text -> HumanReadablePart
Text -> HumanReadablePart
unsafeHumanReadablePartFromText Text
"drep"
  cip129Bech32PrefixesPermitted :: AsType (Credential DRepRole) -> [Text]
cip129Bech32PrefixesPermitted AsType (Credential DRepRole)
R:AsTypeCredential
AsDrepCredential = [Text
"drep"]

  data Cip129Header (Credential L.DRepRole)
    = Cip129CredDRepKey
    | Cip129CredDRepScript

  cip129Header :: Cip129Header (Credential DRepRole) -> Word8
cip129Header = \case
    Cip129Header (Credential DRepRole)
R:Cip129HeaderCredential
Cip129CredDRepKey -> Word8
0b0010_0010
    Cip129Header (Credential DRepRole)
R:Cip129HeaderCredential
Cip129CredDRepScript -> Word8
0b0010_0011

  cip129SerialiseRaw :: Credential DRepRole -> ByteString
cip129SerialiseRaw = \case
    L.KeyHashObj (L.KeyHash Hash ADDRHASH (VerKeyDSIGN DSIGN)
kh) -> Word8 -> ByteString
BS.singleton (Cip129Header (Credential DRepRole) -> Word8
forall a. Cip129 a => Cip129Header a -> Word8
cip129Header Cip129Header (Credential DRepRole)
Cip129CredDRepKey) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Hash ADDRHASH (VerKeyDSIGN DSIGN) -> ByteString
forall h a. Hash h a -> ByteString
Hash.hashToBytes Hash ADDRHASH (VerKeyDSIGN DSIGN)
kh
    L.ScriptHashObj (L.ScriptHash Hash ADDRHASH EraIndependentScript
sh) -> Word8 -> ByteString
BS.singleton (Cip129Header (Credential DRepRole) -> Word8
forall a. Cip129 a => Cip129Header a -> Word8
cip129Header Cip129Header (Credential DRepRole)
Cip129CredDRepScript) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Hash ADDRHASH EraIndependentScript -> ByteString
forall h a. Hash h a -> ByteString
Hash.hashToBytes Hash ADDRHASH EraIndependentScript
sh

  cip129DeserialiseRaw
    :: forall a
     . a ~ Credential L.DRepRole
    => BS.ByteString
    -> Either Cip129EncodingError a
  cip129DeserialiseRaw :: forall a.
(a ~ Credential DRepRole) =>
ByteString -> Either Cip129EncodingError a
cip129DeserialiseRaw ByteString
bytes = do
    let t :: SomeTypeRep
t = Proxy a -> SomeTypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> SomeTypeRep
typeRep (Proxy a -> SomeTypeRep) -> Proxy a -> SomeTypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a
    case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bytes of
      Just (Word8
header, ByteString
cred)
        | Word8
header Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Cip129Header (Credential DRepRole) -> Word8
forall a. Cip129 a => Cip129Header a -> Word8
cip129Header Cip129Header (Credential DRepRole)
Cip129CredDRepKey ->
            KeyHash DRepRole -> a
KeyHash DRepRole -> Credential DRepRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
L.KeyHashObj (KeyHash DRepRole -> a)
-> (Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash DRepRole)
-> Hash ADDRHASH (VerKeyDSIGN DSIGN)
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash DRepRole
forall (r :: KeyRole).
Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
L.KeyHash (Hash ADDRHASH (VerKeyDSIGN DSIGN) -> a)
-> Either Cip129EncodingError (Hash ADDRHASH (VerKeyDSIGN DSIGN))
-> Either Cip129EncodingError a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (Hash ADDRHASH (VerKeyDSIGN DSIGN))
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Hash.hashFromBytes ByteString
cred Maybe (Hash ADDRHASH (VerKeyDSIGN DSIGN))
-> Cip129EncodingError
-> Either Cip129EncodingError (Hash ADDRHASH (VerKeyDSIGN DSIGN))
forall e (m :: * -> *) a. MonadError e m => Maybe a -> e -> m a
?! SomeTypeRep -> ByteString -> Cip129EncodingError
Cip129TypeDecodingError SomeTypeRep
t ByteString
bytes
        | Word8
header Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Cip129Header (Credential DRepRole) -> Word8
forall a. Cip129 a => Cip129Header a -> Word8
cip129Header Cip129Header (Credential DRepRole)
Cip129CredDRepScript ->
            ScriptHash -> a
ScriptHash -> Credential DRepRole
forall (kr :: KeyRole). ScriptHash -> Credential kr
L.ScriptHashObj (ScriptHash -> a)
-> (Hash ADDRHASH EraIndependentScript -> ScriptHash)
-> Hash ADDRHASH EraIndependentScript
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash ADDRHASH EraIndependentScript -> ScriptHash
L.ScriptHash (Hash ADDRHASH EraIndependentScript -> a)
-> Either Cip129EncodingError (Hash ADDRHASH EraIndependentScript)
-> Either Cip129EncodingError a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (Hash ADDRHASH EraIndependentScript)
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Hash.hashFromBytes ByteString
cred Maybe (Hash ADDRHASH EraIndependentScript)
-> Cip129EncodingError
-> Either Cip129EncodingError (Hash ADDRHASH EraIndependentScript)
forall e (m :: * -> *) a. MonadError e m => Maybe a -> e -> m a
?! SomeTypeRep -> ByteString -> Cip129EncodingError
Cip129TypeDecodingError SomeTypeRep
t ByteString
bytes
        | Bool
otherwise -> Cip129EncodingError -> Either Cip129EncodingError a
forall a. Cip129EncodingError -> Either Cip129EncodingError a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Cip129EncodingError -> Either Cip129EncodingError a)
-> Cip129EncodingError -> Either Cip129EncodingError a
forall a b. (a -> b) -> a -> b
$ SomeTypeRep -> Word8 -> Cip129EncodingError
Cip129UnknownHeaderError SomeTypeRep
t Word8
header
      Maybe (Word8, ByteString)
Nothing -> Cip129EncodingError -> Either Cip129EncodingError a
forall a. Cip129EncodingError -> Either Cip129EncodingError a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Cip129EncodingError -> Either Cip129EncodingError a)
-> Cip129EncodingError -> Either Cip129EncodingError a
forall a b. (a -> b) -> a -> b
$ SomeTypeRep -> Cip129EncodingError
Cip129EmptyBytesError SomeTypeRep
t

instance Cip129 Gov.GovActionId where
  cip129Bech32PrefixFor :: AsType GovActionId -> HumanReadablePart
cip129Bech32PrefixFor AsType GovActionId
_ = HasCallStack => Text -> HumanReadablePart
Text -> HumanReadablePart
unsafeHumanReadablePartFromText Text
"gov_action"
  cip129Bech32PrefixesPermitted :: AsType GovActionId -> [Text]
cip129Bech32PrefixesPermitted AsType GovActionId
R:AsTypeGovActionId
AsGovActionId = [Text
"gov_action"]

  -- uninhabited type - no headers
  data Cip129Header Gov.GovActionId

  cip129Header :: Cip129Header GovActionId -> Word8
cip129Header = \case {}

  cip129SerialiseRaw :: GovActionId -> ByteString
cip129SerialiseRaw = GovActionId -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes

  cip129DeserialiseRaw
    :: forall a
     . a ~ Gov.GovActionId
    => BS.ByteString
    -> Either Cip129EncodingError a
  cip129DeserialiseRaw :: forall a.
(a ~ GovActionId) =>
ByteString -> Either Cip129EncodingError a
cip129DeserialiseRaw ByteString
bs =
    AsType a -> ByteString -> Either SerialiseAsRawBytesError a
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either SerialiseAsRawBytesError a
deserialiseFromRawBytes AsType a
AsType GovActionId
AsGovActionId ByteString
bs Either SerialiseAsRawBytesError a
-> (SerialiseAsRawBytesError -> Cip129EncodingError)
-> Either Cip129EncodingError a
forall e a e'. Either e a -> (e -> e') -> Either e' a
?!& Cip129EncodingError
-> SerialiseAsRawBytesError -> Cip129EncodingError
forall a b. a -> b -> a
const (SomeTypeRep -> ByteString -> Cip129EncodingError
Cip129TypeDecodingError (Proxy a -> SomeTypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> SomeTypeRep
typeRep (Proxy a -> SomeTypeRep) -> Proxy a -> SomeTypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a) ByteString
bs)

-- | Serialise a accoding to the serialisation requirements of https://cips.cardano.org/cip/CIP-0129
-- which currently pertain to governance credentials.
serialiseToBech32Cip129 :: forall a. Cip129 a => a -> Text
serialiseToBech32Cip129 :: forall a. Cip129 a => a -> Text
serialiseToBech32Cip129 a
a =
  HumanReadablePart -> DataPart -> Text
Bech32.encodeLenient
    HumanReadablePart
humanReadablePart
    (ByteString -> DataPart
Bech32.dataPartFromBytes (ByteString -> DataPart) -> ByteString -> DataPart
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. Cip129 a => a -> ByteString
cip129SerialiseRaw a
a)
 where
  humanReadablePart :: HumanReadablePart
humanReadablePart = AsType a -> HumanReadablePart
forall a. Cip129 a => AsType a -> HumanReadablePart
cip129Bech32PrefixFor (forall t. HasTypeProxy t => AsType t
asType @a)

-- | Deserialise a governance identifier from CIP-129 format.
deserialiseFromBech32Cip129
  :: forall a
   . Cip129 a
  => Text
  -- ^ A Bech32-encoded governance identifier
  -> Either Cip129EncodingError a
deserialiseFromBech32Cip129 :: forall a. Cip129 a => Text -> Either Cip129EncodingError a
deserialiseFromBech32Cip129 Text
bech32Str = do
  let type' :: SomeTypeRep
type' = Proxy a -> SomeTypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> SomeTypeRep
typeRep (Proxy a -> SomeTypeRep) -> Proxy a -> SomeTypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a
  (prefix, dataPart) <-
    Text -> Either DecodingError (HumanReadablePart, DataPart)
Bech32.decodeLenient Text
bech32Str
      Either DecodingError (HumanReadablePart, DataPart)
-> (DecodingError -> Cip129EncodingError)
-> Either Cip129EncodingError (HumanReadablePart, DataPart)
forall e a e'. Either e a -> (e -> e') -> Either e' a
?!& SomeTypeRep -> Bech32DecodeError -> Cip129EncodingError
Cip129Bech32Error SomeTypeRep
type'
      (Bech32DecodeError -> Cip129EncodingError)
-> (DecodingError -> Bech32DecodeError)
-> DecodingError
-> Cip129EncodingError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodingError -> Bech32DecodeError
Bech32DecodingError

  let actualPrefix = HumanReadablePart -> Text
Bech32.humanReadablePartToText HumanReadablePart
prefix
      permittedPrefixes = AsType a -> [Text]
forall a. Cip129 a => AsType a -> [Text]
cip129Bech32PrefixesPermitted (forall t. HasTypeProxy t => AsType t
asType @a)
  guard (actualPrefix `elem` permittedPrefixes)
    ?! Cip129Bech32Error type' (Bech32UnexpectedPrefix actualPrefix (fromList permittedPrefixes))

  payload <-
    Bech32.dataPartToBytes dataPart
      ?! Cip129Bech32Error type' (Bech32DataPartToBytesError (Bech32.dataPartToText dataPart))

  value <-
    cip129DeserialiseRaw payload
      ?!& const (Cip129Bech32Error type' . Bech32DeserialiseFromBytesError $ Base16.encode payload)

  let expectedPrefix = HumanReadablePart -> Text
Bech32.humanReadablePartToText (HumanReadablePart -> Text) -> HumanReadablePart -> Text
forall a b. (a -> b) -> a -> b
$ AsType a -> HumanReadablePart
forall a. Cip129 a => AsType a -> HumanReadablePart
cip129Bech32PrefixFor (forall t. HasTypeProxy t => AsType t
asType @a)
  guard (actualPrefix == expectedPrefix)
    ?! Cip129Bech32Error type' (Bech32WrongPrefix actualPrefix expectedPrefix)

  pure value

-- | Governance Action ID
-- According to Cip129 there is no header byte for GovActionId.
-- Instead they append the txid and index to form the payload.
{-# DEPRECATED serialiseGovActionIdToBech32Cip129 "Use serialiseToBech32Cip129 instead" #-}
serialiseGovActionIdToBech32Cip129 :: Gov.GovActionId -> Text
serialiseGovActionIdToBech32Cip129 :: GovActionId -> Text
serialiseGovActionIdToBech32Cip129 = GovActionId -> Text
forall a. Cip129 a => a -> Text
serialiseToBech32Cip129

{-# DEPRECATED deserialiseGovActionIdFromBech32Cip129 "Use deserialiseFromBech32Cip129 instead" #-}
deserialiseGovActionIdFromBech32Cip129 :: Text -> Either Cip129EncodingError Gov.GovActionId
deserialiseGovActionIdFromBech32Cip129 :: Text -> Either Cip129EncodingError GovActionId
deserialiseGovActionIdFromBech32Cip129 = Text -> Either Cip129EncodingError GovActionId
forall a. Cip129 a => Text -> Either Cip129EncodingError a
deserialiseFromBech32Cip129