Skip to content

Commit 4913e52

Browse files
carbolymercarbolymer
committed
Use raw bytes representation instead of CBOR for CIP-129 identifier serialisation.
1 parent 7871c9f commit 4913e52

File tree

5 files changed

+231
-76
lines changed

5 files changed

+231
-76
lines changed

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

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,18 +1,22 @@
11
{-# LANGUAGE ConstraintKinds #-}
22
{-# LANGUAGE GADTs #-}
33
{-# LANGUAGE TypeFamilies #-}
4+
{-# OPTIONS_GHC -Wno-duplicate-exports #-}
45

56
module Cardano.Api.HasTypeProxy
67
( HasTypeProxy (AsType, proxyToAsType)
78
, asType
9+
, AsType (..)
810
, Proxy (..)
911
, FromSomeType (..)
1012
)
1113
where
1214

15+
import Data.ByteString qualified as BS
1316
import Data.Kind (Constraint, Type)
1417
import Data.Proxy (Proxy (..))
1518
import Data.Typeable (Typeable)
19+
import Data.Word (Word8)
1620

1721
class Typeable t => HasTypeProxy t where
1822
-- | A family of singleton types used in this API to indicate which type to
@@ -23,6 +27,14 @@ class Typeable t => HasTypeProxy t where
2327

2428
proxyToAsType :: Proxy t -> AsType t
2529

30+
instance HasTypeProxy Word8 where
31+
data AsType Word8 = AsWord8
32+
proxyToAsType _ = AsWord8
33+
34+
instance HasTypeProxy BS.ByteString where
35+
data AsType BS.ByteString = AsByteString
36+
proxyToAsType _ = AsByteString
37+
2638
data FromSomeType (c :: Type -> Constraint) b where
2739
FromSomeType :: c a => AsType a -> (a -> b) -> FromSomeType c b
2840

‎cardano-api/src/Cardano/Api/Internal/Orphans/Misc.hs

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -39,6 +39,7 @@ import Data.ListMap qualified as ListMap
3939
import Data.Maybe.Strict (StrictMaybe (..))
4040
import Data.Monoid
4141
import Data.Text.Encoding.Error qualified as T
42+
import Data.Typeable
4243
import GHC.Exts (IsList (..))
4344
import Network.Mux qualified as Mux
4445
import Text.Parsec.Error qualified as P
@@ -292,3 +293,5 @@ instance Error Byron.GenesisDataGenerationError where
292293

293294
instance Error P.ParseError where
294295
prettyError = pretty . show
296+
297+
deriving via ShowOf TypeRep instance Pretty TypeRep

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

Lines changed: 136 additions & 69 deletions
Original file line numberDiff line numberDiff line change
@@ -1,14 +1,19 @@
1+
{-# LANGUAGE BinaryLiterals #-}
12
{-# LANGUAGE DataKinds #-}
23
{-# LANGUAGE DefaultSignatures #-}
34
{-# LANGUAGE FlexibleInstances #-}
5+
{-# LANGUAGE InstanceSigs #-}
46
{-# LANGUAGE LambdaCase #-}
7+
{-# LANGUAGE NumericUnderscores #-}
58
{-# LANGUAGE RankNTypes #-}
69
{-# LANGUAGE ScopedTypeVariables #-}
710
{-# LANGUAGE TypeApplications #-}
811
{-# LANGUAGE TypeFamilies #-}
12+
{-# LANGUAGE TypeOperators #-}
913

1014
module Cardano.Api.Serialise.Cip129
1115
( Cip129 (..)
16+
, Cip129EncodingError
1217
, deserialiseFromBech32Cip129
1318
, serialiseToBech32Cip129
1419
, serialiseGovActionIdToBech32Cip129
@@ -17,26 +22,29 @@ module Cardano.Api.Serialise.Cip129
1722
)
1823
where
1924

25+
import Cardano.Api.Error
2026
import Cardano.Api.Governance.Internal.Action.ProposalProcedure
2127
import Cardano.Api.HasTypeProxy
2228
import Cardano.Api.Internal.Orphans (AsType (..))
2329
import Cardano.Api.Monad.Error
30+
import Cardano.Api.Pretty
2431
import Cardano.Api.Serialise.Bech32
2532
import Cardano.Api.Serialise.Raw
33+
import Cardano.Api.Serialise.SerialiseUsing
2634

35+
import Cardano.Crypto.Hash.Class qualified as Hash
2736
import Cardano.Ledger.Conway.Governance qualified as Gov
37+
import Cardano.Ledger.Core qualified as L
2838
import Cardano.Ledger.Credential (Credential (..))
2939
import Cardano.Ledger.Credential qualified as L
30-
import Cardano.Ledger.Keys qualified as L
3140

3241
import Codec.Binary.Bech32 qualified as Bech32
3342
import Control.Monad (guard)
34-
import Data.ByteString (ByteString)
3543
import Data.ByteString qualified as BS
3644
import Data.ByteString.Base16 qualified as Base16
37-
import Data.ByteString.Char8 qualified as C8
3845
import Data.Text (Text)
39-
import Data.Text.Encoding qualified as Text
46+
import Data.Typeable
47+
import Data.Word (Word8)
4048
import GHC.Exts (IsList (..))
4149

4250
-- | Cip-129 is a typeclass that captures the serialisation requirements of https://cips.cardano.org/cip/CIP-0129
@@ -45,115 +53,174 @@ class (SerialiseAsRawBytes a, HasTypeProxy a) => Cip129 a where
4553
-- | The human readable part of the Bech32 encoding for the credential.
4654
cip129Bech32PrefixFor :: AsType a -> Bech32.HumanReadablePart
4755

48-
-- | The header byte that identifies the credential type according to Cip-129.
49-
cip129HeaderHexByte :: a -> ByteString
50-
51-
-- | Permitted bech32 prefixes according to Cip-129.
56+
-- | Permitted bech32 prefixes according to CIP-129.
5257
cip129Bech32PrefixesPermitted :: AsType a -> [Text]
5358
default cip129Bech32PrefixesPermitted :: AsType a -> [Text]
5459
cip129Bech32PrefixesPermitted = return . Bech32.humanReadablePartToText . cip129Bech32PrefixFor
5560

61+
-- | Serialise a value to a binary representation used in CIP 129. It's usually distinct from CBOR serialisation.
62+
-- Internal conversion function. Use 'serialiseToBech32Cip129' instead of calling this function directly.
63+
cip129SerialiseRaw :: a -> BS.ByteString
64+
65+
-- | Deserialise a value from the bytes representation. Internal conversion function. Use
66+
-- 'deserialiseFromBech32Cip129' instead of calling this function directly.
67+
cip129DeserialiseRaw :: BS.ByteString -> Either Cip129EncodingError a
68+
69+
-- | CIP-129 decoding errors
70+
data Cip129EncodingError
71+
= CeeTypeDecodingError TypeRep BS.ByteString
72+
| CeeUnknownHeaderError TypeRep Word8
73+
| CeeEmptyBytesError TypeRep
74+
| CeeBech32Error TypeRep Bech32DecodeError
75+
deriving (Eq, Show)
76+
77+
instance Error Cip129EncodingError where
78+
prettyError = \case
79+
CeeTypeDecodingError tr bytes ->
80+
"Cannot decode CIP129 encoding of a type \""
81+
<> pretty tr
82+
<> "\", bytes hex: "
83+
<> pretty (UsingRawBytesHex bytes)
84+
CeeUnknownHeaderError tr header ->
85+
"Cannot decode CIP129 header of a type \""
86+
<> pretty tr
87+
<> "\", header bytes hex: "
88+
<> pretty (UsingRawBytesHex header)
89+
CeeEmptyBytesError tr ->
90+
"Cannot decode CIP129 header of a type \"" <> pretty tr <> "\", cannot decode empty bytes"
91+
CeeBech32Error tr be ->
92+
"Cannot decode CIP129 encoding of a type \""
93+
<> pretty tr
94+
<> "\", due to Bech32 decoding error: "
95+
<> prettyError be
96+
5697
instance Cip129 (Credential L.ColdCommitteeRole) where
5798
cip129Bech32PrefixFor _ = unsafeHumanReadablePartFromText "cc_cold"
5899
cip129Bech32PrefixesPermitted AsColdCommitteeCredential = ["cc_cold"]
59100

60-
cip129HeaderHexByte =
61-
BS.singleton . \case
62-
L.KeyHashObj{} -> 0x12 -- 0001 0010
63-
L.ScriptHashObj{} -> 0x13 -- 0001 0011
101+
cip129SerialiseRaw = \case
102+
L.KeyHashObj (L.KeyHash kh) -> BS.singleton 0b0001_0010 <> Hash.hashToBytes kh
103+
L.ScriptHashObj (L.ScriptHash sh) -> BS.singleton 0b0001_0011 <> Hash.hashToBytes sh
104+
105+
cip129DeserialiseRaw
106+
:: forall a
107+
. a ~ Credential L.ColdCommitteeRole
108+
=> BS.ByteString
109+
-> Either Cip129EncodingError a
110+
cip129DeserialiseRaw bytes = do
111+
let t = typeRep $ Proxy @a
112+
case BS.uncons bytes of
113+
Just (0b0001_0010, cred) -> L.KeyHashObj . L.KeyHash <$> Hash.hashFromBytes cred ?! CeeTypeDecodingError t bytes
114+
Just (0b0001_0011, cred) -> L.ScriptHashObj . L.ScriptHash <$> Hash.hashFromBytes cred ?! CeeTypeDecodingError t bytes
115+
Just (header, _) -> throwError $ CeeUnknownHeaderError t header
116+
Nothing -> throwError $ CeeEmptyBytesError t
64117

65118
instance Cip129 (Credential L.HotCommitteeRole) where
66119
cip129Bech32PrefixFor _ = unsafeHumanReadablePartFromText "cc_hot"
67120
cip129Bech32PrefixesPermitted AsHotCommitteeCredential = ["cc_hot"]
68-
cip129HeaderHexByte =
69-
BS.singleton . \case
70-
L.KeyHashObj{} -> 0x02 -- 0000 0010
71-
L.ScriptHashObj{} -> 0x03 -- 0000 0011
121+
122+
cip129SerialiseRaw = \case
123+
L.KeyHashObj (L.KeyHash kh) -> BS.singleton 0b0000_0010 <> Hash.hashToBytes kh
124+
L.ScriptHashObj (L.ScriptHash sh) -> BS.singleton 0b0000_0011 <> Hash.hashToBytes sh
125+
126+
cip129DeserialiseRaw
127+
:: forall a
128+
. a ~ Credential L.HotCommitteeRole
129+
=> BS.ByteString
130+
-> Either Cip129EncodingError a
131+
cip129DeserialiseRaw bytes = do
132+
let t = typeRep $ Proxy @a
133+
case BS.uncons bytes of
134+
Just (0b0000_0010, cred) -> L.KeyHashObj . L.KeyHash <$> Hash.hashFromBytes cred ?! CeeTypeDecodingError t bytes
135+
Just (0b0000_0011, cred) -> L.ScriptHashObj . L.ScriptHash <$> Hash.hashFromBytes cred ?! CeeTypeDecodingError t bytes
136+
Just (header, _) -> throwError $ CeeUnknownHeaderError t header
137+
Nothing -> throwError $ CeeEmptyBytesError t
72138

73139
instance Cip129 (Credential L.DRepRole) where
74140
cip129Bech32PrefixFor _ = unsafeHumanReadablePartFromText "drep"
75141
cip129Bech32PrefixesPermitted AsDrepCredential = ["drep"]
76-
cip129HeaderHexByte =
77-
BS.singleton . \case
78-
L.KeyHashObj{} -> 0x22 -- 0010 0010
79-
L.ScriptHashObj{} -> 0x23 -- 0010 0011
80-
81-
-- | Serialize a accoding to the serialisation requirements of https://cips.cardano.org/cip/CIP-0129
82-
-- which currently pertain to governance credentials. Governance action ids are dealt separately with
83-
-- via 'serialiseGovActionIdToBech32Cip129'.
142+
143+
cip129SerialiseRaw = \case
144+
L.KeyHashObj (L.KeyHash kh) -> BS.singleton 0b0010_0010 <> Hash.hashToBytes kh
145+
L.ScriptHashObj (L.ScriptHash sh) -> BS.singleton 0b0010_0011 <> Hash.hashToBytes sh
146+
147+
cip129DeserialiseRaw
148+
:: forall a
149+
. a ~ Credential L.DRepRole
150+
=> BS.ByteString
151+
-> Either Cip129EncodingError a
152+
cip129DeserialiseRaw bytes = do
153+
let t = typeRep $ Proxy @a
154+
case BS.uncons bytes of
155+
Just (0b0010_0010, cred) -> L.KeyHashObj . L.KeyHash <$> Hash.hashFromBytes cred ?! CeeTypeDecodingError t bytes
156+
Just (0b0010_0011, cred) -> L.ScriptHashObj . L.ScriptHash <$> Hash.hashFromBytes cred ?! CeeTypeDecodingError t bytes
157+
Just (header, _) -> throwError $ CeeUnknownHeaderError t header
158+
Nothing -> throwError $ CeeEmptyBytesError t
159+
160+
instance Cip129 Gov.GovActionId where
161+
cip129Bech32PrefixFor _ = unsafeHumanReadablePartFromText "gov_action"
162+
cip129Bech32PrefixesPermitted AsGovActionId = ["gov_action"]
163+
164+
cip129SerialiseRaw = serialiseToRawBytes
165+
166+
cip129DeserialiseRaw
167+
:: forall a
168+
. a ~ Gov.GovActionId
169+
=> BS.ByteString
170+
-> Either Cip129EncodingError a
171+
cip129DeserialiseRaw bs =
172+
deserialiseFromRawBytes AsGovActionId bs ?!& const (CeeTypeDecodingError (typeRep $ Proxy @a) bs)
173+
174+
-- | Serialise a accoding to the serialisation requirements of https://cips.cardano.org/cip/CIP-0129
175+
-- which currently pertain to governance credentials.
84176
serialiseToBech32Cip129 :: forall a. Cip129 a => a -> Text
85177
serialiseToBech32Cip129 a =
86178
Bech32.encodeLenient
87179
humanReadablePart
88-
(Bech32.dataPartFromBytes (cip129HeaderHexByte a <> serialiseToRawBytes a))
180+
(Bech32.dataPartFromBytes $ cip129SerialiseRaw a)
89181
where
90-
humanReadablePart = cip129Bech32PrefixFor (proxyToAsType (Proxy :: Proxy a))
182+
humanReadablePart = cip129Bech32PrefixFor (asType @a)
91183

184+
-- | Deserialise a governance identifier from CIP-129 format.
92185
deserialiseFromBech32Cip129
93186
:: forall a
94187
. Cip129 a
95188
=> Text
96-
-> Either Bech32DecodeError a
189+
-- ^ A Bech32-encoded governance identifier
190+
-> Either Cip129EncodingError a
97191
deserialiseFromBech32Cip129 bech32Str = do
192+
let type' = typeRep $ Proxy @a
98193
(prefix, dataPart) <-
99194
Bech32.decodeLenient bech32Str
100-
?!& Bech32DecodingError
195+
?!& CeeBech32Error type'
196+
. Bech32DecodingError
101197

102198
let actualPrefix = Bech32.humanReadablePartToText prefix
103199
permittedPrefixes = cip129Bech32PrefixesPermitted (asType @a)
104200
guard (actualPrefix `elem` permittedPrefixes)
105-
?! Bech32UnexpectedPrefix actualPrefix (fromList permittedPrefixes)
201+
?! CeeBech32Error type' (Bech32UnexpectedPrefix actualPrefix (fromList permittedPrefixes))
106202

107203
payload <-
108204
Bech32.dataPartToBytes dataPart
109-
?! Bech32DataPartToBytesError (Bech32.dataPartToText dataPart)
110-
111-
(header, credential) <-
112-
case C8.uncons payload of
113-
Just (header, credential) -> return (C8.singleton header, credential)
114-
Nothing -> Left $ Bech32DeserialiseFromBytesError payload
205+
?! CeeBech32Error type' (Bech32DataPartToBytesError (Bech32.dataPartToText dataPart))
115206

116-
value <- case deserialiseFromRawBytes asType credential of
117-
Right a -> Right a
118-
Left _ -> Left $ Bech32DeserialiseFromBytesError payload
119-
120-
let expectedHeader = cip129HeaderHexByte value
121-
122-
guard (header == expectedHeader)
123-
?! Bech32UnexpectedHeader (toBase16Text expectedHeader) (toBase16Text header)
207+
value <-
208+
cip129DeserialiseRaw payload
209+
?!& const (CeeBech32Error type' . Bech32DeserialiseFromBytesError $ Base16.encode payload)
124210

125211
let expectedPrefix = Bech32.humanReadablePartToText $ cip129Bech32PrefixFor (asType @a)
126212
guard (actualPrefix == expectedPrefix)
127-
?! Bech32WrongPrefix actualPrefix expectedPrefix
213+
?! CeeBech32Error type' (Bech32WrongPrefix actualPrefix expectedPrefix)
128214

129-
return value
130-
where
131-
toBase16Text = Text.decodeUtf8 . Base16.encode
215+
pure value
132216

133217
-- | Governance Action ID
134218
-- According to Cip129 there is no header byte for GovActionId.
135219
-- Instead they append the txid and index to form the payload.
220+
{-# DEPRECATED serialiseGovActionIdToBech32Cip129 "Use serialiseToBech32Cip129 instead" #-}
136221
serialiseGovActionIdToBech32Cip129 :: Gov.GovActionId -> Text
137-
serialiseGovActionIdToBech32Cip129 govActionId = do
138-
let humanReadablePart = unsafeHumanReadablePartFromText "gov_action"
139-
Bech32.encodeLenient
140-
humanReadablePart
141-
(Bech32.dataPartFromBytes $ serialiseToRawBytes govActionId)
142-
143-
deserialiseGovActionIdFromBech32Cip129
144-
:: Text -> Either Bech32DecodeError Gov.GovActionId
145-
deserialiseGovActionIdFromBech32Cip129 bech32Str = do
146-
let permittedPrefixes = ["gov_action"]
147-
(prefix, dataPart) <-
148-
Bech32.decodeLenient bech32Str
149-
?!& Bech32DecodingError
150-
let actualPrefix = Bech32.humanReadablePartToText prefix
151-
guard (actualPrefix `elem` permittedPrefixes)
152-
?! Bech32UnexpectedPrefix actualPrefix (fromList permittedPrefixes)
153-
154-
payload <-
155-
Bech32.dataPartToBytes dataPart
156-
?! Bech32DataPartToBytesError (Bech32.dataPartToText dataPart)
222+
serialiseGovActionIdToBech32Cip129 = serialiseToBech32Cip129
157223

158-
deserialiseFromRawBytes AsGovActionId payload
159-
?!& const (Bech32DeserialiseFromBytesError payload)
224+
{-# DEPRECATED deserialiseGovActionIdFromBech32Cip129 "Use deserialiseFromBech32Cip129 instead" #-}
225+
deserialiseGovActionIdFromBech32Cip129 :: Text -> Either Cip129EncodingError Gov.GovActionId
226+
deserialiseGovActionIdFromBech32Cip129 = deserialiseFromBech32Cip129

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

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -17,23 +17,38 @@ where
1717

1818
import Cardano.Api.Error (Error, failEitherError, prettyError)
1919
import Cardano.Api.HasTypeProxy
20+
import Cardano.Api.Monad.Error (MonadError (..))
2021
import Cardano.Api.Parser.Text qualified as P
2122
import Cardano.Api.Pretty
2223

2324
import Data.Bifunctor (Bifunctor (..))
25+
import Data.ByteString qualified as BS
2426
import Data.ByteString.Base16 qualified as Base16
2527
import Data.ByteString.Char8 as BSC
2628
import Data.Data (typeRep)
2729
import Data.Text (Text)
2830
import Data.Text qualified as Text
2931
import Data.Text.Encoding qualified as Text
3032
import Data.Typeable (TypeRep, Typeable)
33+
import Data.Word (Word8)
3134

3235
class (HasTypeProxy a, Typeable a) => SerialiseAsRawBytes a where
3336
serialiseToRawBytes :: a -> ByteString
3437

3538
deserialiseFromRawBytes :: AsType a -> ByteString -> Either SerialiseAsRawBytesError a
3639

40+
instance SerialiseAsRawBytes Word8 where
41+
serialiseToRawBytes = BS.singleton
42+
deserialiseFromRawBytes AsWord8 bs = case BS.unpack bs of
43+
[w] -> pure w
44+
_ ->
45+
throwError . SerialiseAsRawBytesError $
46+
"Cannot decode Word8 from (hex): " <> show (Base16.encode bs)
47+
48+
instance SerialiseAsRawBytes BS.ByteString where
49+
serialiseToRawBytes = id
50+
deserialiseFromRawBytes AsByteString = pure
51+
3752
serialiseToRawBytesHex :: SerialiseAsRawBytes a => a -> ByteString
3853
serialiseToRawBytesHex = Base16.encode . serialiseToRawBytes
3954

0 commit comments

Comments
 (0)