Skip to content

Commit 73fd870

Browse files
Jimbo4350Jimbo4350
authored
Merge pull request #778 from IntersectMBO/jordan/cip-129
Implement `Cip129` class
2 parents d37195c + 1801294 commit 73fd870

File tree

11 files changed

+928
-592
lines changed

11 files changed

+928
-592
lines changed

‎cardano-api/cardano-api.cabal

+3
Original file line numberDiff line numberDiff line change
@@ -88,6 +88,8 @@ library
8888
Cardano.Api.Internal.LedgerState
8989
Cardano.Api.Internal.Modes
9090
Cardano.Api.Internal.Orphans
91+
Cardano.Api.Internal.Orphans.Misc
92+
Cardano.Api.Internal.Orphans.Serialisation
9193
Cardano.Api.Internal.Plutus
9294
Cardano.Api.Internal.Pretty
9395
Cardano.Api.Internal.ProtocolParameters
@@ -190,6 +192,7 @@ library
190192

191193
other-modules:
192194
Cardano.Api.Internal.Anchor
195+
Cardano.Api.Internal.CIP.Cip129
193196
Cardano.Api.Internal.Certificate
194197
Cardano.Api.Internal.Compatible.Tx
195198
Cardano.Api.Internal.Convenience.Construction

‎cardano-api/src/Cardano/Api.hs

+8
Original file line numberDiff line numberDiff line change
@@ -709,6 +709,13 @@ module Cardano.Api
709709
, Bech32DecodeError (..)
710710
, UsingBech32 (..)
711711

712+
-- ** Bech32 CIP-129
713+
, Cip129 (..)
714+
, deserialiseFromBech32Cip129
715+
, serialiseToBech32Cip129
716+
, serialiseGovActionIdToBech32Cip129
717+
, deserialiseGovActionIdFromBech32Cip129
718+
712719
-- ** Addresses
713720

714721
-- | Address serialisation is (sadly) special
@@ -1105,6 +1112,7 @@ where
11051112
import Cardano.Api.Internal.Address
11061113
import Cardano.Api.Internal.Anchor
11071114
import Cardano.Api.Internal.Block
1115+
import Cardano.Api.Internal.CIP.Cip129
11081116
import Cardano.Api.Internal.Certificate
11091117
import Cardano.Api.Internal.Convenience.Construction
11101118
import Cardano.Api.Internal.Convenience.Query

‎cardano-api/src/Cardano/Api/Internal/CIP/Cip129.hs

+179
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,179 @@
1+
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE DefaultSignatures #-}
3+
{-# LANGUAGE FlexibleInstances #-}
4+
{-# LANGUAGE LambdaCase #-}
5+
{-# LANGUAGE RankNTypes #-}
6+
{-# LANGUAGE ScopedTypeVariables #-}
7+
{-# LANGUAGE TypeFamilies #-}
8+
{-# OPTIONS_GHC -Wno-orphans #-}
9+
10+
module Cardano.Api.Internal.CIP.Cip129
11+
( Cip129 (..)
12+
, deserialiseFromBech32Cip129
13+
, serialiseToBech32Cip129
14+
, serialiseGovActionIdToBech32Cip129
15+
, deserialiseGovActionIdFromBech32Cip129
16+
, AsType (AsColdCommitteeCredential, AsDrepCredential, AsHotCommitteeCredential)
17+
)
18+
where
19+
20+
import Cardano.Api.Internal.Governance.Actions.ProposalProcedure
21+
import Cardano.Api.Internal.HasTypeProxy
22+
import Cardano.Api.Internal.Orphans (AsType (..))
23+
import Cardano.Api.Internal.SerialiseBech32
24+
import Cardano.Api.Internal.SerialiseRaw
25+
import Cardano.Api.Internal.TxIn
26+
import Cardano.Api.Internal.Utils
27+
28+
import Cardano.Ledger.Conway.Governance qualified as Gov
29+
import Cardano.Ledger.Credential (Credential (..))
30+
import Cardano.Ledger.Credential qualified as L
31+
import Cardano.Ledger.Keys qualified as L
32+
33+
import Codec.Binary.Bech32 qualified as Bech32
34+
import Control.Monad (guard)
35+
import Data.ByteString (ByteString)
36+
import Data.ByteString qualified as BS
37+
import Data.ByteString.Base16 qualified as Base16
38+
import Data.ByteString.Char8 qualified as C8
39+
import Data.Text (Text)
40+
import Data.Text.Encoding qualified as Text
41+
import GHC.Exts (IsList (..))
42+
43+
-- | Cip-129 is a typeclass that captures the serialisation requirements of https://cips.cardano.org/cip/CIP-0129
44+
-- which pertain to governance credentials and governance action ids.
45+
class (SerialiseAsRawBytes a, HasTypeProxy a) => Cip129 a where
46+
-- | The human readable part of the Bech32 encoding for the credential.
47+
cip129Bech32PrefixFor :: AsType a -> Bech32.HumanReadablePart
48+
49+
-- | The header byte that identifies the credential type according to Cip-129.
50+
cip129HeaderHexByte :: a -> ByteString
51+
52+
-- | Permitted bech32 prefixes according to Cip-129.
53+
cip129Bech32PrefixesPermitted :: AsType a -> [Text]
54+
default cip129Bech32PrefixesPermitted :: AsType a -> [Text]
55+
cip129Bech32PrefixesPermitted = return . Bech32.humanReadablePartToText . cip129Bech32PrefixFor
56+
57+
-- | The human readable part of the Bech32 encoding for the credential. This will
58+
-- error if the prefix is not valid.
59+
unsafeHumanReadablePartFromText :: Text -> Bech32.HumanReadablePart
60+
unsafeHumanReadablePartFromText =
61+
either (error . ("Error while parsing Bech32: " <>) . show) id
62+
. Bech32.humanReadablePartFromText
63+
64+
instance Cip129 (Credential L.ColdCommitteeRole) where
65+
cip129Bech32PrefixFor _ = unsafeHumanReadablePartFromText "cc_cold"
66+
cip129Bech32PrefixesPermitted AsColdCommitteeCredential = ["cc_cold"]
67+
68+
cip129HeaderHexByte =
69+
BS.singleton . \case
70+
L.KeyHashObj{} -> 0x12 -- 0001 0010
71+
L.ScriptHashObj{} -> 0x13 -- 0001 0011
72+
73+
instance Cip129 (Credential L.HotCommitteeRole) where
74+
cip129Bech32PrefixFor _ = unsafeHumanReadablePartFromText "cc_hot"
75+
cip129Bech32PrefixesPermitted AsHotCommitteeCredential = ["cc_hot"]
76+
cip129HeaderHexByte =
77+
BS.singleton . \case
78+
L.KeyHashObj{} -> 0x02 -- 0000 0010
79+
L.ScriptHashObj{} -> 0x03 -- 0000 0011
80+
81+
instance Cip129 (Credential L.DRepRole) where
82+
cip129Bech32PrefixFor _ = unsafeHumanReadablePartFromText "drep"
83+
cip129Bech32PrefixesPermitted AsDrepCredential = ["drep"]
84+
cip129HeaderHexByte =
85+
BS.singleton . \case
86+
L.KeyHashObj{} -> 0x22 -- 0010 0010
87+
L.ScriptHashObj{} -> 0x23 -- 0010 0011
88+
89+
-- | Serialize a accoding to the serialisation requirements of https://cips.cardano.org/cip/CIP-0129
90+
-- which currently pertain to governance credentials. Governance action ids are dealt separately with
91+
-- via 'serialiseGovActionIdToBech32Cip129'.
92+
serialiseToBech32Cip129 :: forall a. Cip129 a => a -> Text
93+
serialiseToBech32Cip129 a =
94+
Bech32.encodeLenient
95+
humanReadablePart
96+
(Bech32.dataPartFromBytes (cip129HeaderHexByte a <> serialiseToRawBytes a))
97+
where
98+
humanReadablePart = cip129Bech32PrefixFor (proxyToAsType (Proxy :: Proxy a))
99+
100+
deserialiseFromBech32Cip129
101+
:: Cip129 a
102+
=> AsType a -> Text -> Either Bech32DecodeError a
103+
deserialiseFromBech32Cip129 asType bech32Str = do
104+
(prefix, dataPart) <-
105+
Bech32.decodeLenient bech32Str
106+
?!. Bech32DecodingError
107+
108+
let actualPrefix = Bech32.humanReadablePartToText prefix
109+
permittedPrefixes = cip129Bech32PrefixesPermitted asType
110+
guard (actualPrefix `elem` permittedPrefixes)
111+
?! Bech32UnexpectedPrefix actualPrefix (fromList permittedPrefixes)
112+
113+
payload <-
114+
Bech32.dataPartToBytes dataPart
115+
?! Bech32DataPartToBytesError (Bech32.dataPartToText dataPart)
116+
117+
(header, credential) <-
118+
case C8.uncons payload of
119+
Just (header, credential) -> return (C8.singleton header, credential)
120+
Nothing -> Left $ Bech32DeserialiseFromBytesError payload
121+
122+
value <- case deserialiseFromRawBytes asType credential of
123+
Right a -> Right a
124+
Left _ -> Left $ Bech32DeserialiseFromBytesError payload
125+
126+
let expectedHeader = cip129HeaderHexByte value
127+
128+
guard (header == expectedHeader)
129+
?! Bech32UnexpectedHeader (toBase16Text expectedHeader) (toBase16Text header)
130+
131+
let expectedPrefix = Bech32.humanReadablePartToText $ cip129Bech32PrefixFor asType
132+
guard (actualPrefix == expectedPrefix)
133+
?! Bech32WrongPrefix actualPrefix expectedPrefix
134+
135+
return value
136+
where
137+
toBase16Text = Text.decodeUtf8 . Base16.encode
138+
139+
-- | Governance Action ID
140+
-- According to Cip129 there is no header byte for GovActionId.
141+
-- Instead they append the txid and index to form the payload.
142+
serialiseGovActionIdToBech32Cip129 :: Gov.GovActionId -> Text
143+
serialiseGovActionIdToBech32Cip129 (Gov.GovActionId txid index) =
144+
let txidHex = serialiseToRawBytes $ fromShelleyTxId txid
145+
indexHex = C8.pack $ show $ Gov.unGovActionIx index
146+
payload = txidHex <> indexHex
147+
in Bech32.encodeLenient
148+
humanReadablePart
149+
(Bech32.dataPartFromBytes payload)
150+
where
151+
humanReadablePart =
152+
let prefix = "gov_action"
153+
in case Bech32.humanReadablePartFromText prefix of
154+
Right p -> p
155+
Left err ->
156+
error $
157+
"serialiseGovActionIdToBech32Cip129: invalid prefix "
158+
++ show prefix
159+
++ ", "
160+
++ show err
161+
162+
deserialiseGovActionIdFromBech32Cip129
163+
:: Text -> Either Bech32DecodeError Gov.GovActionId
164+
deserialiseGovActionIdFromBech32Cip129 bech32Str = do
165+
let permittedPrefixes = ["gov_action"]
166+
(prefix, dataPart) <-
167+
Bech32.decodeLenient bech32Str
168+
?!. Bech32DecodingError
169+
let actualPrefix = Bech32.humanReadablePartToText prefix
170+
guard (actualPrefix `elem` permittedPrefixes)
171+
?! Bech32UnexpectedPrefix actualPrefix (fromList permittedPrefixes)
172+
173+
payload <-
174+
Bech32.dataPartToBytes dataPart
175+
?! Bech32DataPartToBytesError (Bech32.dataPartToText dataPart)
176+
177+
case deserialiseFromRawBytes AsGovActionId payload of
178+
Right a -> Right a
179+
Left _ -> Left $ Bech32DeserialiseFromBytesError payload

‎cardano-api/src/Cardano/Api/Internal/DeserialiseAnyOf.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -39,7 +39,7 @@ import Data.Bifunctor (first)
3939
import Data.ByteString (ByteString)
4040
import Data.ByteString.Char8 qualified as BSC
4141
import Data.Char (toLower)
42-
import Data.Data (Data)
42+
import Data.Data
4343
import Data.List.NonEmpty (NonEmpty)
4444
import Data.Text (Text)
4545
import Data.Text.Encoding qualified as Text

‎cardano-api/src/Cardano/Api/Internal/Keys/Shelley.hs

+1
Original file line numberDiff line numberDiff line change
@@ -2102,6 +2102,7 @@ instance HasTextEnvelope (SigningKey DRepKey) where
21022102
---
21032103
--- Drep extended keys
21042104
---
2105+
21052106
data DRepExtendedKey
21062107

21072108
instance HasTypeProxy DRepExtendedKey where

0 commit comments

Comments
 (0)