Skip to content

Commit 7ba151e

Browse files
Jimbo4350Jimbo4350
committed
Implement Cip129 class
1 parent d37195c commit 7ba151e

File tree

7 files changed

+250
-0
lines changed

7 files changed

+250
-0
lines changed

‎cardano-api/cardano-api.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -190,6 +190,7 @@ library
190190

191191
other-modules:
192192
Cardano.Api.Internal.Anchor
193+
Cardano.Api.Internal.CIP.CIP129
193194
Cardano.Api.Internal.Certificate
194195
Cardano.Api.Internal.Compatible.Tx
195196
Cardano.Api.Internal.Convenience.Construction

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

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -709,6 +709,11 @@ module Cardano.Api
709709
, Bech32DecodeError (..)
710710
, UsingBech32 (..)
711711

712+
-- ** Bech32 CIP-129
713+
, CIP129 (..)
714+
, deserialiseFromBech32CIP129
715+
, serialiseToBech32CIP129
716+
712717
-- ** Addresses
713718

714719
-- | Address serialisation is (sadly) special
@@ -1105,6 +1110,7 @@ where
11051110
import Cardano.Api.Internal.Address
11061111
import Cardano.Api.Internal.Anchor
11071112
import Cardano.Api.Internal.Block
1113+
import Cardano.Api.Internal.CIP.CIP129
11081114
import Cardano.Api.Internal.Certificate
11091115
import Cardano.Api.Internal.Convenience.Construction
11101116
import Cardano.Api.Internal.Convenience.Query

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

Lines changed: 230 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,230 @@
1+
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE DefaultSignatures #-}
3+
{-# LANGUAGE FlexibleInstances #-}
4+
{-# LANGUAGE RankNTypes #-}
5+
{-# LANGUAGE ScopedTypeVariables #-}
6+
{-# LANGUAGE TypeFamilies #-}
7+
{-# OPTIONS_GHC -Wno-orphans #-}
8+
9+
module Cardano.Api.Internal.CIP.CIP129
10+
( CIP129 (..)
11+
, deserialiseFromBech32CIP129
12+
, serialiseToBech32CIP129
13+
, serialiseGovActionIdToBech32CIP129
14+
, deserialiseGovActionIdFromBech32CIP129
15+
)
16+
where
17+
18+
import Cardano.Api.Internal.Governance.Actions.ProposalProcedure
19+
import Cardano.Api.Internal.HasTypeProxy
20+
import Cardano.Api.Internal.Orphans ()
21+
import Cardano.Api.Internal.SerialiseBech32
22+
import Cardano.Api.Internal.SerialiseRaw
23+
import Cardano.Api.Internal.TxIn
24+
import Cardano.Api.Internal.Utils
25+
26+
import Cardano.Binary qualified as CBOR
27+
import Cardano.Ledger.Conway.Governance qualified as Gov
28+
import Cardano.Ledger.Credential (Credential (..))
29+
import Cardano.Ledger.Credential qualified as L
30+
import Cardano.Ledger.Keys qualified as L
31+
32+
import Codec.Binary.Bech32 qualified as Bech32
33+
import Control.Monad (guard)
34+
import Data.Bifunctor
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+
import Text.Read
43+
44+
-- | CIP129 is a typeclass that captures the serialisation requirements of https://cips.cardano.org/cip/CIP-0129
45+
class (SerialiseAsRawBytes a, HasTypeProxy a) => CIP129 a where
46+
cip129Bech32PrefixFor :: AsType a -> Text
47+
48+
cip129HeaderHexByte :: a -> ByteString
49+
50+
cip129Bech32PrefixesPermitted :: AsType a -> [Text]
51+
default cip129Bech32PrefixesPermitted :: AsType a -> [Text]
52+
cip129Bech32PrefixesPermitted = return . cip129Bech32PrefixFor
53+
54+
instance CIP129 (Credential L.ColdCommitteeRole) where
55+
cip129Bech32PrefixFor _ = "cc_cold"
56+
cip129Bech32PrefixesPermitted AsColdCommitteeCredential = ["cc_cold"]
57+
cip129HeaderHexByte c =
58+
case c of
59+
L.KeyHashObj{} -> BS.singleton 0x12 -- 0001 0010
60+
L.ScriptHashObj{} -> BS.singleton 0x13 -- 0001 0011
61+
62+
instance HasTypeProxy (Credential L.ColdCommitteeRole) where
63+
data AsType (Credential L.ColdCommitteeRole) = AsColdCommitteeCredential
64+
proxyToAsType _ = AsColdCommitteeCredential
65+
66+
instance SerialiseAsRawBytes (Credential L.ColdCommitteeRole) where
67+
serialiseToRawBytes = CBOR.serialize'
68+
deserialiseFromRawBytes AsColdCommitteeCredential =
69+
first
70+
( \e ->
71+
SerialiseAsRawBytesError
72+
("Unable to deserialise Credential ColdCommitteeRole: " ++ show e)
73+
)
74+
. CBOR.decodeFull'
75+
76+
instance CIP129 (Credential L.HotCommitteeRole) where
77+
cip129Bech32PrefixFor _ = "cc_hot"
78+
cip129Bech32PrefixesPermitted AsHotCommitteeCredential = ["cc_hot"]
79+
cip129HeaderHexByte c =
80+
case c of
81+
L.KeyHashObj{} -> BS.singleton 0x02 -- 0000 0010
82+
L.ScriptHashObj{} -> BS.singleton 0x03 -- 0000 0011
83+
84+
instance HasTypeProxy (Credential L.HotCommitteeRole) where
85+
data AsType (Credential L.HotCommitteeRole) = AsHotCommitteeCredential
86+
proxyToAsType _ = AsHotCommitteeCredential
87+
88+
instance SerialiseAsRawBytes (Credential L.HotCommitteeRole) where
89+
serialiseToRawBytes = CBOR.serialize'
90+
deserialiseFromRawBytes AsHotCommitteeCredential =
91+
first
92+
( \e ->
93+
SerialiseAsRawBytesError
94+
("Unable to deserialise Credential HotCommitteeRole: " ++ show e)
95+
)
96+
. CBOR.decodeFull'
97+
98+
instance CIP129 (Credential L.DRepRole) where
99+
cip129Bech32PrefixFor _ = "drep"
100+
cip129Bech32PrefixesPermitted AsDrepCredential = ["drep"]
101+
cip129HeaderHexByte c =
102+
case c of
103+
L.KeyHashObj{} -> BS.singleton 0x22 -- 0010 0010
104+
L.ScriptHashObj{} -> BS.singleton 0x23 -- 0010 0011
105+
106+
instance HasTypeProxy (Credential L.DRepRole) where
107+
data AsType (Credential L.DRepRole) = AsDrepCredential
108+
proxyToAsType _ = AsDrepCredential
109+
110+
instance SerialiseAsRawBytes (Credential L.DRepRole) where
111+
serialiseToRawBytes = CBOR.serialize'
112+
deserialiseFromRawBytes AsDrepCredential =
113+
first
114+
( \e ->
115+
SerialiseAsRawBytesError ("Unable to deserialise Credential DRepRole: " ++ show e)
116+
)
117+
. CBOR.decodeFull'
118+
119+
serialiseToBech32CIP129 :: forall a. CIP129 a => a -> Text
120+
serialiseToBech32CIP129 a =
121+
Bech32.encodeLenient
122+
humanReadablePart
123+
(Bech32.dataPartFromBytes (cip129HeaderHexByte a <> serialiseToRawBytes a))
124+
where
125+
prefix = cip129Bech32PrefixFor (proxyToAsType (Proxy :: Proxy a))
126+
humanReadablePart =
127+
case Bech32.humanReadablePartFromText prefix of
128+
Right p -> p
129+
Left err ->
130+
error $
131+
"serialiseToBech32CIP129: invalid prefix "
132+
++ show prefix
133+
++ ", "
134+
++ show err
135+
136+
deserialiseFromBech32CIP129
137+
:: CIP129 a
138+
=> AsType a -> Text -> Either Bech32DecodeError a
139+
deserialiseFromBech32CIP129 asType bech32Str = do
140+
(prefix, dataPart) <-
141+
Bech32.decodeLenient bech32Str
142+
?!. Bech32DecodingError
143+
144+
let actualPrefix = Bech32.humanReadablePartToText prefix
145+
permittedPrefixes = cip129Bech32PrefixesPermitted asType
146+
guard (actualPrefix `elem` permittedPrefixes)
147+
?! Bech32UnexpectedPrefix actualPrefix (fromList permittedPrefixes)
148+
149+
payload <-
150+
Bech32.dataPartToBytes dataPart
151+
?! Bech32DataPartToBytesError (Bech32.dataPartToText dataPart)
152+
153+
let (header, credential) = BS.uncons payload
154+
155+
value <- case deserialiseFromRawBytes asType credential of
156+
Right a -> Right a
157+
Left _ -> Left $ Bech32DeserialiseFromBytesError payload
158+
159+
let expectedHeader = cip129HeaderHexByte value
160+
161+
guard (header == expectedHeader)
162+
?! Bech32UnexpectedHeader (toBase16Text expectedHeader) (toBase16Text header)
163+
164+
let expectedPrefix = cip129Bech32PrefixFor asType
165+
guard (actualPrefix == expectedPrefix)
166+
?! Bech32WrongPrefix actualPrefix expectedPrefix
167+
168+
return value
169+
where
170+
toBase16Text = Text.decodeUtf8 . Base16.encode
171+
172+
-- | Governance Action ID
173+
-- According to CIP129 there is no header byte for GovActionId.
174+
-- Instead they append the txid and index to form the payload.
175+
serialiseGovActionIdToBech32CIP129 :: Gov.GovActionId -> Text
176+
serialiseGovActionIdToBech32CIP129 (Gov.GovActionId txid index) =
177+
let txidHex = serialiseToRawBytes $ fromShelleyTxId txid
178+
indexHex = C8.pack $ show $ Gov.unGovActionIx index
179+
payload = txidHex <> indexHex
180+
in Bech32.encodeLenient
181+
humanReadablePart
182+
(Bech32.dataPartFromBytes payload)
183+
where
184+
humanReadablePart =
185+
let prefix = "gov_action"
186+
in case Bech32.humanReadablePartFromText prefix of
187+
Right p -> p
188+
Left err ->
189+
error $
190+
"serialiseGovActionIdToBech32CIP129: invalid prefix "
191+
++ show prefix
192+
++ ", "
193+
++ show err
194+
195+
deserialiseGovActionIdFromBech32CIP129
196+
:: Text -> Either Bech32DecodeError Gov.GovActionId
197+
deserialiseGovActionIdFromBech32CIP129 bech32Str = do
198+
let permittedPrefixes = ["gov_action"]
199+
(prefix, dataPart) <-
200+
Bech32.decodeLenient bech32Str
201+
?!. Bech32DecodingError
202+
let actualPrefix = Bech32.humanReadablePartToText prefix
203+
guard (actualPrefix `elem` permittedPrefixes)
204+
?! Bech32UnexpectedPrefix actualPrefix (fromList permittedPrefixes)
205+
206+
payload <-
207+
Bech32.dataPartToBytes dataPart
208+
?! Bech32DataPartToBytesError (Bech32.dataPartToText dataPart)
209+
210+
case deserialiseFromRawBytes AsGovActionId payload of
211+
Right a -> Right a
212+
Left _ -> Left $ Bech32DeserialiseFromBytesError payload
213+
214+
instance HasTypeProxy Gov.GovActionId where
215+
data AsType Gov.GovActionId = AsGovActionId
216+
proxyToAsType _ = AsGovActionId
217+
218+
instance SerialiseAsRawBytes Gov.GovActionId where
219+
serialiseToRawBytes (Gov.GovActionId txid (Gov.GovActionIx ix)) =
220+
let hex = Base16.encode $ C8.pack $ show ix
221+
in mconcat [serialiseToRawBytes $ fromShelleyTxId txid, hex]
222+
deserialiseFromRawBytes AsGovActionId bytes = do
223+
let (txidBs, index) = BS.splitAt 32 bytes
224+
225+
txid <- deserialiseFromRawBytes AsTxId txidBs
226+
let asciiIndex = C8.unpack $ Base16.decodeLenient index
227+
case readMaybe asciiIndex of
228+
Just ix -> return $ Gov.GovActionId (toShelleyTxId txid) (Gov.GovActionIx ix)
229+
Nothing ->
230+
Left $ SerialiseAsRawBytesError $ "Unable to deserialise GovActionId: invalid index: " <> asciiIndex

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

Lines changed: 1 addition & 0 deletions
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

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

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -141,6 +141,11 @@ data Bech32DecodeError
141141
| -- | The human-readable prefix in the Bech32-encoded string does not
142142
-- correspond to the prefix that should be used for the payload value.
143143
Bech32WrongPrefix !Text !Text
144+
| Bech32UnexpectedHeader
145+
!Text
146+
-- ^ Expected header
147+
!Text
148+
-- ^ Unexpected header
144149
deriving (Eq, Show, Data)
145150

146151
instance Error Bech32DecodeError where
@@ -168,3 +173,8 @@ instance Error Bech32DecodeError where
168173
[ "Mismatch in the Bech32 prefix: the actual prefix is " <> pshow actual
169174
, ", but the prefix for this payload value should be " <> pshow expected
170175
]
176+
Bech32UnexpectedHeader expected actual ->
177+
mconcat
178+
[ "Unexpected CIP-129 Bech32 header: the actual header is " <> pshow actual
179+
, ", but it was expected to be " <> pshow expected
180+
]

‎cardano-api/test/cardano-api-golden/Test/Golden/ErrorsSpec.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -157,6 +157,7 @@ test_Bech32DecodeError =
157157
, Bech32DataPartToBytesError text
158158
, Bech32DeserialiseFromBytesError bytestring
159159
, Bech32WrongPrefix text text
160+
, Bech32UnexpectedHeader text text
160161
]
161162

162163
test_InputDecodeError :: TestTree

‎cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Internal.SerialiseBech32.Bech32DecodeError/Bech32UnexpectedHeader.txt‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
Unexpected CIP-129 Bech32 header: the actual header is "<text>", but it was expected to be "<text>"

0 commit comments

Comments
 (0)