Skip to content

Commit 3b11945

Browse files
Jimbo4350Jimbo4350
committed
Reorganize Orphans module to avoid cyclical dependencies
Rename class to Cip129 Return HumanReadablePart instead of Text
1 parent 7ba151e commit 3b11945

File tree

8 files changed

+789
-705
lines changed

8 files changed

+789
-705
lines changed

‎cardano-api/cardano-api.cabal

Lines changed: 3 additions & 1 deletion
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,7 +192,7 @@ library
190192

191193
other-modules:
192194
Cardano.Api.Internal.Anchor
193-
Cardano.Api.Internal.CIP.CIP129
195+
Cardano.Api.Internal.CIP.Cip129
194196
Cardano.Api.Internal.Certificate
195197
Cardano.Api.Internal.Compatible.Tx
196198
Cardano.Api.Internal.Convenience.Construction

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

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -710,9 +710,9 @@ module Cardano.Api
710710
, UsingBech32 (..)
711711

712712
-- ** Bech32 CIP-129
713-
, CIP129 (..)
713+
, Cip129 (..)
714714
, deserialiseFromBech32CIP129
715-
, serialiseToBech32CIP129
715+
, serialiseToBech32Cip129
716716

717717
-- ** Addresses
718718

@@ -1110,7 +1110,7 @@ where
11101110
import Cardano.Api.Internal.Address
11111111
import Cardano.Api.Internal.Anchor
11121112
import Cardano.Api.Internal.Block
1113-
import Cardano.Api.Internal.CIP.CIP129
1113+
import Cardano.Api.Internal.CIP.Cip129
11141114
import Cardano.Api.Internal.Certificate
11151115
import Cardano.Api.Internal.Convenience.Construction
11161116
import Cardano.Api.Internal.Convenience.Query

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

Lines changed: 56 additions & 107 deletions
Original file line numberDiff line numberDiff line change
@@ -1,140 +1,104 @@
11
{-# LANGUAGE DataKinds #-}
22
{-# LANGUAGE DefaultSignatures #-}
33
{-# LANGUAGE FlexibleInstances #-}
4+
{-# LANGUAGE LambdaCase #-}
45
{-# LANGUAGE RankNTypes #-}
56
{-# LANGUAGE ScopedTypeVariables #-}
67
{-# LANGUAGE TypeFamilies #-}
78
{-# OPTIONS_GHC -Wno-orphans #-}
89

9-
module Cardano.Api.Internal.CIP.CIP129
10-
( CIP129 (..)
10+
module Cardano.Api.Internal.CIP.Cip129
11+
( Cip129 (..)
1112
, deserialiseFromBech32CIP129
12-
, serialiseToBech32CIP129
13+
, serialiseToBech32Cip129
1314
, serialiseGovActionIdToBech32CIP129
1415
, deserialiseGovActionIdFromBech32CIP129
16+
, AsType (AsColdCommitteeCredential, AsDrepCredential, AsHotCommitteeCredential)
1517
)
1618
where
1719

1820
import Cardano.Api.Internal.Governance.Actions.ProposalProcedure
1921
import Cardano.Api.Internal.HasTypeProxy
20-
import Cardano.Api.Internal.Orphans ()
22+
import Cardano.Api.Internal.Orphans (AsType (..))
2123
import Cardano.Api.Internal.SerialiseBech32
2224
import Cardano.Api.Internal.SerialiseRaw
2325
import Cardano.Api.Internal.TxIn
2426
import Cardano.Api.Internal.Utils
2527

26-
import Cardano.Binary qualified as CBOR
2728
import Cardano.Ledger.Conway.Governance qualified as Gov
2829
import Cardano.Ledger.Credential (Credential (..))
2930
import Cardano.Ledger.Credential qualified as L
3031
import Cardano.Ledger.Keys qualified as L
3132

3233
import Codec.Binary.Bech32 qualified as Bech32
3334
import Control.Monad (guard)
34-
import Data.Bifunctor
3535
import Data.ByteString (ByteString)
3636
import Data.ByteString qualified as BS
3737
import Data.ByteString.Base16 qualified as Base16
3838
import Data.ByteString.Char8 qualified as C8
3939
import Data.Text (Text)
4040
import Data.Text.Encoding qualified as Text
4141
import GHC.Exts (IsList (..))
42-
import Text.Read
4342

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
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
4748

49+
-- | The header byte that identifies the credential type according to Cip-129.
4850
cip129HeaderHexByte :: a -> ByteString
4951

52+
-- | Permitted bech32 prefixes according to Cip-129.
5053
cip129Bech32PrefixesPermitted :: AsType a -> [Text]
5154
default cip129Bech32PrefixesPermitted :: AsType a -> [Text]
52-
cip129Bech32PrefixesPermitted = return . cip129Bech32PrefixFor
55+
cip129Bech32PrefixesPermitted = return . Bech32.humanReadablePartToText . cip129Bech32PrefixFor
5356

54-
instance CIP129 (Credential L.ColdCommitteeRole) where
55-
cip129Bech32PrefixFor _ = "cc_cold"
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"
5666
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"
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"
7875
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"
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"
10083
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 =
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 =
12194
Bech32.encodeLenient
12295
humanReadablePart
12396
(Bech32.dataPartFromBytes (cip129HeaderHexByte a <> serialiseToRawBytes a))
12497
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
98+
humanReadablePart = cip129Bech32PrefixFor (proxyToAsType (Proxy :: Proxy a))
13599

136100
deserialiseFromBech32CIP129
137-
:: CIP129 a
101+
:: Cip129 a
138102
=> AsType a -> Text -> Either Bech32DecodeError a
139103
deserialiseFromBech32CIP129 asType bech32Str = do
140104
(prefix, dataPart) <-
@@ -150,7 +114,10 @@ deserialiseFromBech32CIP129 asType bech32Str = do
150114
Bech32.dataPartToBytes dataPart
151115
?! Bech32DataPartToBytesError (Bech32.dataPartToText dataPart)
152116

153-
let (header, credential) = BS.uncons payload
117+
(header, credential) <-
118+
case C8.uncons payload of
119+
Just (header, credential) -> return (C8.singleton header, credential)
120+
Nothing -> Left $ Bech32DeserialiseFromBytesError payload
154121

155122
value <- case deserialiseFromRawBytes asType credential of
156123
Right a -> Right a
@@ -161,7 +128,7 @@ deserialiseFromBech32CIP129 asType bech32Str = do
161128
guard (header == expectedHeader)
162129
?! Bech32UnexpectedHeader (toBase16Text expectedHeader) (toBase16Text header)
163130

164-
let expectedPrefix = cip129Bech32PrefixFor asType
131+
let expectedPrefix = Bech32.humanReadablePartToText $ cip129Bech32PrefixFor asType
165132
guard (actualPrefix == expectedPrefix)
166133
?! Bech32WrongPrefix actualPrefix expectedPrefix
167134

@@ -170,7 +137,7 @@ deserialiseFromBech32CIP129 asType bech32Str = do
170137
toBase16Text = Text.decodeUtf8 . Base16.encode
171138

172139
-- | Governance Action ID
173-
-- According to CIP129 there is no header byte for GovActionId.
140+
-- According to Cip129 there is no header byte for GovActionId.
174141
-- Instead they append the txid and index to form the payload.
175142
serialiseGovActionIdToBech32CIP129 :: Gov.GovActionId -> Text
176143
serialiseGovActionIdToBech32CIP129 (Gov.GovActionId txid index) =
@@ -210,21 +177,3 @@ deserialiseGovActionIdFromBech32CIP129 bech32Str = do
210177
case deserialiseFromRawBytes AsGovActionId payload of
211178
Right a -> Right a
212179
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/DeserialiseAnyOf.hs

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

0 commit comments

Comments
 (0)