Skip to content

Commit e0c5ac0

Browse files
Jimbo4350Jimbo4350
committed
Add module Cardano.Api.DeserialiseAnyOf
1 parent 55ec227 commit e0c5ac0

File tree

4 files changed

+299
-1
lines changed

4 files changed

+299
-1
lines changed

‎cardano-api/cardano-api.cabal

+1
Original file line numberDiff line numberDiff line change
@@ -57,6 +57,7 @@ library
5757
Cardano.Api.Convenience.Constraints
5858
Cardano.Api.Convenience.Construction
5959
Cardano.Api.Convenience.Query
60+
Cardano.Api.DeserialiseAnyOf
6061
Cardano.Api.Environment
6162
Cardano.Api.EraCast
6263
Cardano.Api.Eras

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

+11
Original file line numberDiff line numberDiff line change
@@ -425,6 +425,16 @@ module Cardano.Api (
425425

426426
-- * Serialisation
427427
-- | Support for serialising data in JSON, CBOR and text files.
428+
InputFormat (..),
429+
InputDecodeError (..),
430+
deserialiseInput,
431+
deserialiseInputAnyOf,
432+
renderInputDecodeError,
433+
434+
SomeAddressVerificationKey(..),
435+
deserialiseAnyVerificationKey,
436+
deserialiseAnyVerificationKeyBech32,
437+
deserialiseAnyVerificationKeyTextEnvelope,
428438

429439
-- ** CBOR
430440
SerialiseAsCBOR,
@@ -727,6 +737,7 @@ import Cardano.Api.Certificate
727737
import Cardano.Api.Convenience.Constraints
728738
import Cardano.Api.Convenience.Construction
729739
import Cardano.Api.Convenience.Query
740+
import Cardano.Api.DeserialiseAnyOf
730741
import Cardano.Api.Environment
731742
import Cardano.Api.EraCast
732743
import Cardano.Api.Eras

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

+286
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,286 @@
1+
{-# LANGUAGE GADTs #-}
2+
{-# LANGUAGE ScopedTypeVariables #-}
3+
4+
-- | Class of errors used in the Api.
5+
--
6+
module Cardano.Api.DeserialiseAnyOf
7+
( InputFormat (..)
8+
, InputDecodeError (..)
9+
, deserialiseInput
10+
, deserialiseInputAnyOf
11+
, renderInputDecodeError
12+
13+
-- TODO: Consider moving everything below
14+
, SomeAddressVerificationKey(..)
15+
, deserialiseAnyVerificationKey
16+
, deserialiseAnyVerificationKeyBech32
17+
, deserialiseAnyVerificationKeyTextEnvelope
18+
) where
19+
20+
import Prelude
21+
22+
import qualified Data.Aeson as Aeson
23+
import Data.Bifunctor (first)
24+
import Data.ByteString (ByteString)
25+
import qualified Data.ByteString.Char8 as BSC
26+
import Data.Char (toLower)
27+
import Data.List.NonEmpty (NonEmpty)
28+
import qualified Data.List.NonEmpty as NE
29+
import Data.Text (Text)
30+
import qualified Data.Text as Text
31+
import qualified Data.Text.Encoding as Text
32+
33+
import Cardano.Api.Error
34+
import Cardano.Api.SerialiseBech32
35+
import Cardano.Api.SerialiseRaw
36+
import Cardano.Api.SerialiseTextEnvelope
37+
38+
-- TODO: Think about if these belong
39+
import Cardano.Api.Address
40+
import Cardano.Api.Key
41+
import Cardano.Api.KeysByron
42+
import Cardano.Api.KeysPraos
43+
import Cardano.Api.KeysShelley
44+
45+
------------------------------------------------------------------------------
46+
-- Formatted/encoded input deserialisation
47+
------------------------------------------------------------------------------
48+
49+
-- | Input format/encoding.
50+
data InputFormat a where
51+
-- | Bech32 encoding.
52+
InputFormatBech32 :: SerialiseAsBech32 a => InputFormat a
53+
54+
-- | Hex/Base16 encoding.
55+
InputFormatHex :: SerialiseAsRawBytes a => InputFormat a
56+
57+
-- TODO: Specify TextEnvelope CBOR hex
58+
-- | Text envelope format.
59+
InputFormatTextEnvelope :: HasTextEnvelope a => InputFormat a
60+
61+
-- TODO: Add constructor for TextEnvelope Bech32
62+
63+
-- | Input decoding error.
64+
data InputDecodeError
65+
= InputTextEnvelopeError !TextEnvelopeError
66+
-- ^ The provided data seems to be a valid text envelope, but some error
67+
-- occurred in deserialising it.
68+
| InputBech32DecodeError !Bech32DecodeError
69+
-- ^ The provided data is valid Bech32, but some error occurred in
70+
-- deserialising it.
71+
| InputInvalidError
72+
-- ^ The provided data does not represent a valid value of the provided
73+
-- type.
74+
deriving (Eq, Show)
75+
76+
instance Error InputDecodeError where
77+
displayError = Text.unpack . renderInputDecodeError
78+
79+
-- | Render an error message for a 'InputDecodeError'.
80+
renderInputDecodeError :: InputDecodeError -> Text
81+
renderInputDecodeError err =
82+
case err of
83+
InputTextEnvelopeError textEnvErr ->
84+
Text.pack (displayError textEnvErr)
85+
InputBech32DecodeError decodeErr ->
86+
Text.pack (displayError decodeErr)
87+
InputInvalidError -> "Invalid key."
88+
89+
-- | The result of a deserialisation function.
90+
--
91+
-- Note that this type isn't intended to be exported, but only used as a
92+
-- helper within the 'deserialiseInput' function.
93+
data DeserialiseInputResult a
94+
= DeserialiseInputSuccess !a
95+
-- ^ Input successfully deserialised.
96+
| DeserialiseInputError !InputDecodeError
97+
-- ^ The provided data is of the expected format/encoding, but an error
98+
-- occurred in deserialising it.
99+
| DeserialiseInputErrorFormatMismatch
100+
-- ^ The provided data's formatting/encoding does not match that which was
101+
-- expected. This error is an indication that one could attempt to
102+
-- deserialise the input again, but instead expecting a different format.
103+
104+
-- | Deserialise an input of some type that is formatted in some way.
105+
deserialiseInput
106+
:: forall a.
107+
AsType a
108+
-> NonEmpty (InputFormat a)
109+
-> ByteString
110+
-> Either InputDecodeError a
111+
deserialiseInput asType acceptedFormats inputBs =
112+
go (NE.toList acceptedFormats)
113+
where
114+
inputText :: Text
115+
inputText = Text.decodeUtf8 inputBs
116+
117+
go :: [InputFormat a] -> Either InputDecodeError a
118+
go [] = Left InputInvalidError
119+
go (kf:kfs) =
120+
let res =
121+
case kf of
122+
InputFormatBech32 -> deserialiseBech32
123+
InputFormatHex -> deserialiseHex
124+
InputFormatTextEnvelope -> deserialiseTextEnvelope
125+
in case res of
126+
DeserialiseInputSuccess a -> Right a
127+
DeserialiseInputError err -> Left err
128+
DeserialiseInputErrorFormatMismatch -> go kfs
129+
130+
deserialiseTextEnvelope :: HasTextEnvelope a => DeserialiseInputResult a
131+
deserialiseTextEnvelope = do
132+
let textEnvRes :: Either TextEnvelopeError a
133+
textEnvRes =
134+
deserialiseFromTextEnvelope asType
135+
=<< first TextEnvelopeAesonDecodeError (Aeson.eitherDecodeStrict' inputBs)
136+
case textEnvRes of
137+
Right res -> DeserialiseInputSuccess res
138+
139+
-- The input was valid a text envelope, but there was a type mismatch
140+
-- error.
141+
Left err@TextEnvelopeTypeError{} ->
142+
DeserialiseInputError (InputTextEnvelopeError err)
143+
144+
-- The input was not valid a text envelope.
145+
Left _ -> DeserialiseInputErrorFormatMismatch
146+
147+
deserialiseBech32 :: SerialiseAsBech32 a => DeserialiseInputResult a
148+
deserialiseBech32 =
149+
case deserialiseFromBech32 asType inputText of
150+
Right res -> DeserialiseInputSuccess res
151+
152+
-- The input was not valid Bech32.
153+
Left (Bech32DecodingError _) -> DeserialiseInputErrorFormatMismatch
154+
155+
-- The input was valid Bech32, but some other error occurred.
156+
Left err -> DeserialiseInputError $ InputBech32DecodeError err
157+
158+
deserialiseHex :: SerialiseAsRawBytes a => DeserialiseInputResult a
159+
deserialiseHex
160+
| isValidHex inputBs =
161+
case deserialiseFromRawBytesHex asType inputBs of
162+
Left _ -> DeserialiseInputError InputInvalidError
163+
Right x -> DeserialiseInputSuccess x
164+
| otherwise = DeserialiseInputErrorFormatMismatch
165+
166+
isValidHex :: ByteString -> Bool
167+
isValidHex x =
168+
all (`elem` hexAlpha) (toLower <$> BSC.unpack x)
169+
&& even (BSC.length x)
170+
where
171+
hexAlpha :: [Char]
172+
hexAlpha = "0123456789abcdef"
173+
174+
-- | Deserialise an input of some type that is formatted in some way.
175+
--
176+
-- The provided 'ByteString' can either be Bech32-encoded or in the text
177+
-- envelope format.
178+
deserialiseInputAnyOf
179+
:: forall b.
180+
[FromSomeType SerialiseAsBech32 b]
181+
-> [FromSomeType HasTextEnvelope b]
182+
-> ByteString
183+
-> Either InputDecodeError b
184+
deserialiseInputAnyOf bech32Types textEnvTypes inputBs =
185+
case deserialiseBech32 `orTry` deserialiseTextEnvelope of
186+
DeserialiseInputSuccess res -> Right res
187+
DeserialiseInputError err -> Left err
188+
DeserialiseInputErrorFormatMismatch -> Left InputInvalidError
189+
where
190+
inputText :: Text
191+
inputText = Text.decodeUtf8 inputBs
192+
193+
orTry
194+
:: DeserialiseInputResult b
195+
-> DeserialiseInputResult b
196+
-> DeserialiseInputResult b
197+
orTry x y =
198+
case x of
199+
DeserialiseInputSuccess _ -> x
200+
DeserialiseInputError _ -> x
201+
DeserialiseInputErrorFormatMismatch -> y
202+
203+
deserialiseTextEnvelope :: DeserialiseInputResult b
204+
deserialiseTextEnvelope = do
205+
let textEnvRes :: Either TextEnvelopeError b
206+
textEnvRes =
207+
deserialiseFromTextEnvelopeAnyOf textEnvTypes
208+
=<< first TextEnvelopeAesonDecodeError (Aeson.eitherDecodeStrict' inputBs)
209+
case textEnvRes of
210+
Right res -> DeserialiseInputSuccess res
211+
212+
-- The input was valid a text envelope, but there was a type mismatch
213+
-- error.
214+
Left err@TextEnvelopeTypeError{} ->
215+
DeserialiseInputError (InputTextEnvelopeError err)
216+
217+
-- The input was not valid a text envelope.
218+
Left _ -> DeserialiseInputErrorFormatMismatch
219+
220+
deserialiseBech32 :: DeserialiseInputResult b
221+
deserialiseBech32 =
222+
case deserialiseAnyOfFromBech32 bech32Types inputText of
223+
Right res -> DeserialiseInputSuccess res
224+
225+
-- The input was not valid Bech32.
226+
Left (Bech32DecodingError _) -> DeserialiseInputErrorFormatMismatch
227+
228+
-- The input was valid Bech32, but some other error occurred.
229+
Left err -> DeserialiseInputError $ InputBech32DecodeError err
230+
231+
data SomeAddressVerificationKey
232+
= AByronVerificationKey (VerificationKey ByronKey)
233+
| APaymentVerificationKey (VerificationKey PaymentKey)
234+
| APaymentExtendedVerificationKey (VerificationKey PaymentExtendedKey)
235+
| AGenesisUTxOVerificationKey (VerificationKey GenesisUTxOKey)
236+
| AGenesisExtendedVerificationKey (VerificationKey GenesisExtendedKey)
237+
| AGenesisDelegateExtendedVerificationKey
238+
(VerificationKey GenesisDelegateExtendedKey)
239+
| AKesVerificationKey (VerificationKey KesKey)
240+
| AVrfVerificationKey (VerificationKey VrfKey)
241+
| AStakeVerificationKey (VerificationKey StakeKey)
242+
| AStakeExtendedVerificationKey (VerificationKey StakeExtendedKey)
243+
deriving (Show)
244+
245+
246+
deserialiseAnyVerificationKey
247+
:: ByteString -> Either InputDecodeError SomeAddressVerificationKey
248+
deserialiseAnyVerificationKey bs =
249+
case deserialiseAnyVerificationKeyBech32 bs of
250+
Right vk -> Right vk
251+
Left _e ->
252+
case deserialiseAnyVerificationKeyTextEnvelope bs of
253+
Right vk -> Right vk
254+
Left _e -> Left InputInvalidError
255+
256+
deserialiseAnyVerificationKeyBech32
257+
:: ByteString -> Either Bech32DecodeError SomeAddressVerificationKey
258+
deserialiseAnyVerificationKeyBech32 =
259+
deserialiseAnyOfFromBech32 allBech32VerKey . Text.decodeUtf8
260+
where
261+
allBech32VerKey
262+
:: [FromSomeType SerialiseAsBech32 SomeAddressVerificationKey]
263+
allBech32VerKey =
264+
[ FromSomeType (AsVerificationKey AsPaymentKey) APaymentVerificationKey
265+
, FromSomeType (AsVerificationKey AsPaymentExtendedKey) APaymentExtendedVerificationKey
266+
, FromSomeType (AsVerificationKey AsKesKey) AKesVerificationKey
267+
, FromSomeType (AsVerificationKey AsVrfKey) AVrfVerificationKey
268+
, FromSomeType (AsVerificationKey AsStakeKey) AStakeVerificationKey
269+
, FromSomeType (AsVerificationKey AsStakeExtendedKey) AStakeExtendedVerificationKey
270+
]
271+
272+
deserialiseAnyVerificationKeyTextEnvelope
273+
:: ByteString -> Either TextEnvelopeError SomeAddressVerificationKey
274+
deserialiseAnyVerificationKeyTextEnvelope bs =
275+
deserialiseFromTextEnvelopeAnyOf allTextEnvelopeCBOR
276+
=<< first TextEnvelopeAesonDecodeError (Aeson.eitherDecodeStrict' bs)
277+
where
278+
allTextEnvelopeCBOR
279+
:: [FromSomeType HasTextEnvelope SomeAddressVerificationKey]
280+
allTextEnvelopeCBOR =
281+
[ FromSomeType (AsVerificationKey AsByronKey) AByronVerificationKey
282+
, FromSomeType (AsVerificationKey AsPaymentKey) APaymentVerificationKey
283+
, FromSomeType (AsVerificationKey AsPaymentExtendedKey) APaymentExtendedVerificationKey
284+
, FromSomeType (AsVerificationKey AsGenesisUTxOKey) AGenesisUTxOVerificationKey
285+
]
286+

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

+1-1
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,7 @@ module Cardano.Api.Key
1111
, AsType(AsVerificationKey, AsSigningKey)
1212
) where
1313

14-
import Prelude
14+
import Prelude
1515

1616
import Data.Kind (Type)
1717

0 commit comments

Comments
 (0)