Skip to content

Commit 5f2abfb

Browse files
Jimbo4350Jimbo4350
committed
Implement CIP129 class
1 parent 2a961be commit 5f2abfb

File tree

5 files changed

+205
-0
lines changed

5 files changed

+205
-0
lines changed

‎cardano-api/cardano-api.cabal

+1
Original file line numberDiff line numberDiff line change
@@ -188,6 +188,7 @@ library
188188
other-modules:
189189
Cardano.Api.Internal.Anchor
190190
Cardano.Api.Internal.Certificate
191+
Cardano.Api.Internal.CIP.CIP129
191192
Cardano.Api.Internal.Compatible.Tx
192193
Cardano.Api.Internal.Convenience.Construction
193194
Cardano.Api.Internal.Convenience.Query

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

+6
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
@@ -1103,6 +1108,7 @@ where
11031108
import Cardano.Api.Internal.Address
11041109
import Cardano.Api.Internal.Anchor
11051110
import Cardano.Api.Internal.Block
1111+
import Cardano.Api.Internal.CIP.CIP129
11061112
import Cardano.Api.Internal.Certificate
11071113
import Cardano.Api.Internal.Convenience.Construction
11081114
import Cardano.Api.Internal.Convenience.Query

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

+187
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,187 @@
1+
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE FlexibleInstances #-}
3+
{-# LANGUAGE RankNTypes #-}
4+
{-# LANGUAGE ScopedTypeVariables #-}
5+
{-# LANGUAGE TypeFamilies #-}
6+
{-# OPTIONS_GHC -Wno-orphans #-}
7+
8+
module Cardano.Api.Internal.CIP.CIP129
9+
( CIP129 (..)
10+
, deserialiseFromBech32CIP129
11+
, serialiseToBech32CIP129
12+
)
13+
where
14+
15+
import Cardano.Api.Internal.Governance.Actions.ProposalProcedure
16+
import Cardano.Api.Internal.HasTypeProxy
17+
import Cardano.Api.Internal.Orphans ()
18+
import Cardano.Api.Internal.SerialiseBech32
19+
import Cardano.Api.Internal.SerialiseRaw
20+
import Cardano.Api.Internal.TxIn
21+
import Cardano.Api.Internal.Utils
22+
23+
import Cardano.Binary qualified as CBOR
24+
import Cardano.Ledger.Conway.Governance qualified as Gov
25+
import Cardano.Ledger.Credential (Credential (..))
26+
import Cardano.Ledger.Credential qualified as L
27+
import Cardano.Ledger.Crypto (StandardCrypto)
28+
import Cardano.Ledger.Keys qualified as L
29+
30+
import Codec.Binary.Bech32 qualified as Bech32
31+
import Control.Monad (guard)
32+
import Data.Bifunctor
33+
import Data.ByteString (ByteString)
34+
import Data.ByteString qualified as BS
35+
import Data.ByteString.Base16 qualified as Base16
36+
import Data.ByteString.Char8 qualified as C8
37+
import Data.Text (Text)
38+
import Data.Text.Encoding qualified as Text
39+
import GHC.Exts (IsList (..))
40+
import Text.Read
41+
42+
class SerialiseAsRawBytes a => CIP129 a where
43+
cip129Bech32PrefixFor :: a -> Text
44+
cip129HeaderHexByte :: a -> ByteString
45+
cip129Bech32PrefixesPermitted :: AsType a -> [Text]
46+
47+
instance CIP129 (Credential L.ColdCommitteeRole StandardCrypto) where
48+
cip129Bech32PrefixFor _ = "cc_cold"
49+
cip129Bech32PrefixesPermitted AsColdCommitteeCredential = ["cc_cold"]
50+
cip129HeaderHexByte c =
51+
case c of
52+
L.ScriptHashObj{} -> "\x13"
53+
L.KeyHashObj{} -> "\x12"
54+
55+
instance HasTypeProxy (Credential L.ColdCommitteeRole StandardCrypto) where
56+
data AsType (Credential L.ColdCommitteeRole StandardCrypto) = AsColdCommitteeCredential
57+
proxyToAsType _ = AsColdCommitteeCredential
58+
59+
instance SerialiseAsRawBytes (Credential L.ColdCommitteeRole StandardCrypto) where
60+
serialiseToRawBytes = CBOR.serialize'
61+
deserialiseFromRawBytes AsColdCommitteeCredential =
62+
first
63+
( \e ->
64+
SerialiseAsRawBytesError
65+
("Unable to deserialise Credential ColdCommitteeRole StandardCrypto: " ++ show e)
66+
)
67+
. CBOR.decodeFull'
68+
69+
instance CIP129 (Credential L.HotCommitteeRole StandardCrypto) where
70+
cip129Bech32PrefixFor _ = "cc_hot"
71+
cip129Bech32PrefixesPermitted AsHotCommitteeCredential = ["cc_hot"]
72+
cip129HeaderHexByte c =
73+
case c of
74+
L.ScriptHashObj{} -> "\x03"
75+
L.KeyHashObj{} -> "\x02"
76+
77+
instance HasTypeProxy (Credential L.HotCommitteeRole StandardCrypto) where
78+
data AsType (Credential L.HotCommitteeRole StandardCrypto) = AsHotCommitteeCredential
79+
proxyToAsType _ = AsHotCommitteeCredential
80+
81+
instance SerialiseAsRawBytes (Credential L.HotCommitteeRole StandardCrypto) where
82+
serialiseToRawBytes = CBOR.serialize'
83+
deserialiseFromRawBytes AsHotCommitteeCredential =
84+
first
85+
( \e ->
86+
SerialiseAsRawBytesError
87+
("Unable to deserialise Credential HotCommitteeRole StandardCrypto: " ++ show e)
88+
)
89+
. CBOR.decodeFull'
90+
91+
instance CIP129 (Credential L.DRepRole StandardCrypto) where
92+
cip129Bech32PrefixFor _ = "drep"
93+
cip129Bech32PrefixesPermitted AsDrepCredential = ["drep"]
94+
cip129HeaderHexByte c =
95+
case c of
96+
L.ScriptHashObj{} -> "\x23"
97+
L.KeyHashObj{} -> "\x22"
98+
99+
instance HasTypeProxy (Credential L.DRepRole StandardCrypto) where
100+
data AsType (Credential L.DRepRole StandardCrypto) = AsDrepCredential
101+
proxyToAsType _ = AsDrepCredential
102+
103+
instance SerialiseAsRawBytes (Credential L.DRepRole StandardCrypto) where
104+
serialiseToRawBytes = CBOR.serialize'
105+
deserialiseFromRawBytes AsDrepCredential =
106+
first
107+
( \e ->
108+
SerialiseAsRawBytesError ("Unable to deserialise Credential DRepRole StandardCrypto: " ++ show e)
109+
)
110+
. CBOR.decodeFull'
111+
112+
instance CIP129 (Gov.GovActionId StandardCrypto) where
113+
cip129Bech32PrefixFor _ = "gov_action"
114+
cip129Bech32PrefixesPermitted AsGovActionId = ["gov_action"]
115+
cip129HeaderHexByte _ = "\x01"
116+
117+
instance HasTypeProxy (Gov.GovActionId StandardCrypto) where
118+
data AsType (Gov.GovActionId StandardCrypto) = AsGovActionId
119+
proxyToAsType _ = AsGovActionId
120+
121+
instance SerialiseAsRawBytes (Gov.GovActionId StandardCrypto) where
122+
serialiseToRawBytes (Gov.GovActionId txid (Gov.GovActionIx ix)) =
123+
let hex = Base16.encode $ C8.pack $ show ix
124+
in mconcat [serialiseToRawBytes $ fromShelleyTxId txid, hex]
125+
deserialiseFromRawBytes AsGovActionId bytes = do
126+
let (txidBs, index) = BS.splitAt 32 bytes
127+
128+
txid <- deserialiseFromRawBytes AsTxId txidBs
129+
let asciiIndex = C8.unpack $ Base16.decodeLenient index
130+
case readMaybe asciiIndex of
131+
Just ix -> return $ Gov.GovActionId (toShelleyTxId txid) (Gov.GovActionIx ix)
132+
Nothing ->
133+
Left $ SerialiseAsRawBytesError $ "Unable to deserialise GovActionId: invalid index: " <> asciiIndex
134+
135+
serialiseToBech32CIP129 :: forall a. CIP129 a => a -> Text
136+
serialiseToBech32CIP129 a =
137+
Bech32.encodeLenient
138+
humanReadablePart
139+
(Bech32.dataPartFromBytes (cip129HeaderHexByte a <> serialiseToRawBytes a))
140+
where
141+
prefix = cip129Bech32PrefixFor a
142+
humanReadablePart =
143+
case Bech32.humanReadablePartFromText prefix of
144+
Right p -> p
145+
Left err ->
146+
error $
147+
"serialiseToBech32: invalid prefix "
148+
++ show prefix
149+
++ ", "
150+
++ show err
151+
152+
deserialiseFromBech32CIP129
153+
:: forall a
154+
. CIP129 a
155+
=> AsType a -> Text -> Either Bech32DecodeError a
156+
deserialiseFromBech32CIP129 asType bech32Str = do
157+
(prefix, dataPart) <-
158+
Bech32.decodeLenient bech32Str
159+
?!. Bech32DecodingError
160+
161+
let actualPrefix = Bech32.humanReadablePartToText prefix
162+
permittedPrefixes = cip129Bech32PrefixesPermitted asType
163+
guard (actualPrefix `elem` permittedPrefixes)
164+
?! Bech32UnexpectedPrefix actualPrefix (fromList permittedPrefixes)
165+
166+
payload <-
167+
Bech32.dataPartToBytes dataPart
168+
?! Bech32DataPartToBytesError (Bech32.dataPartToText dataPart)
169+
170+
let (header, credential) = BS.splitAt 1 payload
171+
172+
value <- case deserialiseFromRawBytes asType credential of
173+
Right a -> Right a
174+
Left _ -> Left $ Bech32DeserialiseFromBytesError payload
175+
176+
let expectedHeader = cip129HeaderHexByte value
177+
178+
guard (header == expectedHeader)
179+
?! Bech32UnexpectedHeader (toBase16Text expectedHeader) (toBase16Text header)
180+
181+
let expectedPrefix = cip129Bech32PrefixFor value
182+
guard (actualPrefix == expectedPrefix)
183+
?! Bech32WrongPrefix actualPrefix expectedPrefix
184+
185+
return value
186+
where
187+
toBase16Text = Text.decodeUtf8 . Base16.encode

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

+1
Original file line numberDiff line numberDiff line change
@@ -2045,6 +2045,7 @@ instance HasTextEnvelope (SigningKey DRepKey) where
20452045
---
20462046
--- Drep extended keys
20472047
---
2048+
20482049
data DRepExtendedKey
20492050

20502051
instance HasTypeProxy DRepExtendedKey where

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

+10
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+
]

0 commit comments

Comments
 (0)