{-# 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.Text (Text)
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 TypeRep
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
<> TypeRep -> Doc ann
forall ann. TypeRep -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty TypeRep
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 TypeRep
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
<> TypeRep -> Doc ann
forall ann. TypeRep -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty TypeRep
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 TypeRep
tr ->
      Doc ann
"Cannot decode CIP129 header of a type \"" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> TypeRep -> Doc ann
forall ann. TypeRep -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty TypeRep
tr Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"\", cannot decode empty bytes"
    Cip129Bech32Error TypeRep
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
<> TypeRep -> Doc ann
forall ann. TypeRep -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty TypeRep
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 :: TypeRep
t = Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a -> TypeRep) -> Proxy a -> TypeRep
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
?! TypeRep -> ByteString -> Cip129EncodingError
Cip129TypeDecodingError TypeRep
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
?! TypeRep -> ByteString -> Cip129EncodingError
Cip129TypeDecodingError TypeRep
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
$ TypeRep -> Word8 -> Cip129EncodingError
Cip129UnknownHeaderError TypeRep
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
$ TypeRep -> Cip129EncodingError
Cip129EmptyBytesError TypeRep
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 :: TypeRep
t = Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a -> TypeRep) -> Proxy a -> TypeRep
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
?! TypeRep -> ByteString -> Cip129EncodingError
Cip129TypeDecodingError TypeRep
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
?! TypeRep -> ByteString -> Cip129EncodingError
Cip129TypeDecodingError TypeRep
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
$ TypeRep -> Word8 -> Cip129EncodingError
Cip129UnknownHeaderError TypeRep
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
$ TypeRep -> Cip129EncodingError
Cip129EmptyBytesError TypeRep
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 :: TypeRep
t = Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a -> TypeRep) -> Proxy a -> TypeRep
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
?! TypeRep -> ByteString -> Cip129EncodingError
Cip129TypeDecodingError TypeRep
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
?! TypeRep -> ByteString -> Cip129EncodingError
Cip129TypeDecodingError TypeRep
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
$ TypeRep -> Word8 -> Cip129EncodingError
Cip129UnknownHeaderError TypeRep
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
$ TypeRep -> Cip129EncodingError
Cip129EmptyBytesError TypeRep
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 (TypeRep -> ByteString -> Cip129EncodingError
Cip129TypeDecodingError (Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a -> TypeRep) -> Proxy a -> TypeRep
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' :: TypeRep
type' = Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a -> TypeRep) -> Proxy a -> TypeRep
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
?!& TypeRep -> Bech32DecodeError -> Cip129EncodingError
Cip129Bech32Error TypeRep
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