Skip to content

Commit 4fd4eee

Browse files
Jimbo4350Jimbo4350
committed
Propagate Cardano.Api.DeserialiseAnyOf throughout cardano-cli
1 parent e0c5ac0 commit 4fd4eee

File tree

9 files changed

+95
-308
lines changed

9 files changed

+95
-308
lines changed

Diff for: ‎cardano-cli/src/Cardano/CLI/Shelley/Key.hs

+13-208
Original file line numberDiff line numberDiff line change
@@ -6,13 +6,7 @@
66

77
-- | Shelley CLI option data types and functions for cryptographic keys.
88
module Cardano.CLI.Shelley.Key
9-
( InputFormat (..)
10-
, InputDecodeError (..)
11-
, deserialiseInput
12-
, deserialiseInputAnyOf
13-
, renderInputDecodeError
14-
15-
, readKeyFile
9+
( readKeyFile
1610
, readKeyFileAnyOf
1711
, readKeyFileTextEnvelope
1812

@@ -38,207 +32,21 @@ module Cardano.CLI.Shelley.Key
3832
, generateKeyPair
3933
) where
4034

35+
import Cardano.Api
4136
import Cardano.Prelude
4237

4338
import Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither)
44-
import qualified Data.Aeson as Aeson
4539
import qualified Data.ByteString as BS
46-
import qualified Data.ByteString.Lazy as LBS
4740
import qualified Data.ByteString.Builder as Builder
48-
import qualified Data.ByteString.Char8 as BSC
41+
import qualified Data.ByteString.Lazy as LBS
4942
import qualified Data.List.NonEmpty as NE
5043
import qualified Data.Text as Text
5144
import qualified Data.Text.Encoding as Text
5245
import GHC.IO.Handle (hClose)
5346
import GHC.IO.Handle.FD (openFileBlocking)
5447

55-
import Cardano.Api
56-
5748
import Cardano.CLI.Types
5849

59-
------------------------------------------------------------------------------
60-
-- Formatted/encoded input deserialisation
61-
------------------------------------------------------------------------------
62-
63-
-- | Input format/encoding.
64-
data InputFormat a where
65-
-- | Bech32 encoding.
66-
InputFormatBech32 :: SerialiseAsBech32 a => InputFormat a
67-
68-
-- | Hex/Base16 encoding.
69-
InputFormatHex :: SerialiseAsRawBytes a => InputFormat a
70-
71-
-- | Text envelope format.
72-
InputFormatTextEnvelope :: HasTextEnvelope a => InputFormat a
73-
74-
-- | Input decoding error.
75-
data InputDecodeError
76-
= InputTextEnvelopeError !TextEnvelopeError
77-
-- ^ The provided data seems to be a valid text envelope, but some error
78-
-- occurred in deserialising it.
79-
| InputBech32DecodeError !Bech32DecodeError
80-
-- ^ The provided data is valid Bech32, but some error occurred in
81-
-- deserialising it.
82-
| InputInvalidError
83-
-- ^ The provided data does not represent a valid value of the provided
84-
-- type.
85-
deriving (Eq, Show)
86-
87-
instance Error InputDecodeError where
88-
displayError = Text.unpack . renderInputDecodeError
89-
90-
-- | Render an error message for a 'InputDecodeError'.
91-
renderInputDecodeError :: InputDecodeError -> Text
92-
renderInputDecodeError err =
93-
case err of
94-
InputTextEnvelopeError textEnvErr ->
95-
Text.pack (displayError textEnvErr)
96-
InputBech32DecodeError decodeErr ->
97-
Text.pack (displayError decodeErr)
98-
InputInvalidError -> "Invalid key."
99-
100-
-- | The result of a deserialisation function.
101-
--
102-
-- Note that this type isn't intended to be exported, but only used as a
103-
-- helper within the 'deserialiseInput' function.
104-
data DeserialiseInputResult a
105-
= DeserialiseInputSuccess !a
106-
-- ^ Input successfully deserialised.
107-
| DeserialiseInputError !InputDecodeError
108-
-- ^ The provided data is of the expected format/encoding, but an error
109-
-- occurred in deserialising it.
110-
| DeserialiseInputErrorFormatMismatch
111-
-- ^ The provided data's formatting/encoding does not match that which was
112-
-- expected. This error is an indication that one could attempt to
113-
-- deserialise the input again, but instead expecting a different format.
114-
115-
-- | Deserialise an input of some type that is formatted in some way.
116-
deserialiseInput
117-
:: forall a.
118-
AsType a
119-
-> NonEmpty (InputFormat a)
120-
-> ByteString
121-
-> Either InputDecodeError a
122-
deserialiseInput asType acceptedFormats inputBs =
123-
go (NE.toList acceptedFormats)
124-
where
125-
inputText :: Text
126-
inputText = Text.decodeUtf8 inputBs
127-
128-
go :: [InputFormat a] -> Either InputDecodeError a
129-
go [] = Left InputInvalidError
130-
go (kf:kfs) =
131-
let res =
132-
case kf of
133-
InputFormatBech32 -> deserialiseBech32
134-
InputFormatHex -> deserialiseHex
135-
InputFormatTextEnvelope -> deserialiseTextEnvelope
136-
in case res of
137-
DeserialiseInputSuccess a -> Right a
138-
DeserialiseInputError err -> Left err
139-
DeserialiseInputErrorFormatMismatch -> go kfs
140-
141-
deserialiseTextEnvelope :: HasTextEnvelope a => DeserialiseInputResult a
142-
deserialiseTextEnvelope = do
143-
let textEnvRes :: Either TextEnvelopeError a
144-
textEnvRes =
145-
deserialiseFromTextEnvelope asType
146-
=<< first TextEnvelopeAesonDecodeError (Aeson.eitherDecodeStrict' inputBs)
147-
case textEnvRes of
148-
Right res -> DeserialiseInputSuccess res
149-
150-
-- The input was valid a text envelope, but there was a type mismatch
151-
-- error.
152-
Left err@TextEnvelopeTypeError{} ->
153-
DeserialiseInputError (InputTextEnvelopeError err)
154-
155-
-- The input was not valid a text envelope.
156-
Left _ -> DeserialiseInputErrorFormatMismatch
157-
158-
deserialiseBech32 :: SerialiseAsBech32 a => DeserialiseInputResult a
159-
deserialiseBech32 =
160-
case deserialiseFromBech32 asType inputText of
161-
Right res -> DeserialiseInputSuccess res
162-
163-
-- The input was not valid Bech32.
164-
Left (Bech32DecodingError _) -> DeserialiseInputErrorFormatMismatch
165-
166-
-- The input was valid Bech32, but some other error occurred.
167-
Left err -> DeserialiseInputError $ InputBech32DecodeError err
168-
169-
deserialiseHex :: SerialiseAsRawBytes a => DeserialiseInputResult a
170-
deserialiseHex
171-
| isValidHex inputBs =
172-
case deserialiseFromRawBytesHex asType inputBs of
173-
Left _ -> DeserialiseInputError InputInvalidError
174-
Right x -> DeserialiseInputSuccess x
175-
| otherwise = DeserialiseInputErrorFormatMismatch
176-
177-
isValidHex :: ByteString -> Bool
178-
isValidHex x =
179-
all (`elem` hexAlpha) (toLower <$> BSC.unpack x)
180-
&& even (BSC.length x)
181-
where
182-
hexAlpha :: [Char]
183-
hexAlpha = "0123456789abcdef"
184-
185-
-- | Deserialise an input of some type that is formatted in some way.
186-
--
187-
-- The provided 'ByteString' can either be Bech32-encoded or in the text
188-
-- envelope format.
189-
deserialiseInputAnyOf
190-
:: forall b.
191-
[FromSomeType SerialiseAsBech32 b]
192-
-> [FromSomeType HasTextEnvelope b]
193-
-> ByteString
194-
-> Either InputDecodeError b
195-
deserialiseInputAnyOf bech32Types textEnvTypes inputBs =
196-
case deserialiseBech32 `orTry` deserialiseTextEnvelope of
197-
DeserialiseInputSuccess res -> Right res
198-
DeserialiseInputError err -> Left err
199-
DeserialiseInputErrorFormatMismatch -> Left InputInvalidError
200-
where
201-
inputText :: Text
202-
inputText = Text.decodeUtf8 inputBs
203-
204-
orTry
205-
:: DeserialiseInputResult b
206-
-> DeserialiseInputResult b
207-
-> DeserialiseInputResult b
208-
orTry x y =
209-
case x of
210-
DeserialiseInputSuccess _ -> x
211-
DeserialiseInputError _ -> x
212-
DeserialiseInputErrorFormatMismatch -> y
213-
214-
deserialiseTextEnvelope :: DeserialiseInputResult b
215-
deserialiseTextEnvelope = do
216-
let textEnvRes :: Either TextEnvelopeError b
217-
textEnvRes =
218-
deserialiseFromTextEnvelopeAnyOf textEnvTypes
219-
=<< first TextEnvelopeAesonDecodeError (Aeson.eitherDecodeStrict' inputBs)
220-
case textEnvRes of
221-
Right res -> DeserialiseInputSuccess res
222-
223-
-- The input was valid a text envelope, but there was a type mismatch
224-
-- error.
225-
Left err@TextEnvelopeTypeError{} ->
226-
DeserialiseInputError (InputTextEnvelopeError err)
227-
228-
-- The input was not valid a text envelope.
229-
Left _ -> DeserialiseInputErrorFormatMismatch
230-
231-
deserialiseBech32 :: DeserialiseInputResult b
232-
deserialiseBech32 =
233-
case deserialiseAnyOfFromBech32 bech32Types inputText of
234-
Right res -> DeserialiseInputSuccess res
235-
236-
-- The input was not valid Bech32.
237-
Left (Bech32DecodingError _) -> DeserialiseInputErrorFormatMismatch
238-
239-
-- The input was valid Bech32, but some other error occurred.
240-
Left err -> DeserialiseInputError $ InputBech32DecodeError err
241-
24250
------------------------------------------------------------------------------
24351
-- Cryptographic key deserialisation
24452
------------------------------------------------------------------------------
@@ -438,25 +246,22 @@ renderVerificationKeyTextOrFileError vkTextOrFileErr =
438246
VerificationKeyTextError err -> renderInputDecodeError err
439247
VerificationKeyFileError err -> Text.pack (displayError err)
440248

441-
-- | Deserialise a verification key from text or a verification key file given
442-
-- that it is one of the provided types.
443-
--
249+
-- | Deserialise a verification key from text or a verification key file.
444250
-- If a filepath is provided, the file can either be formatted as Bech32, hex,
445251
-- or text envelope.
446252
readVerificationKeyTextOrFileAnyOf
447-
:: forall b.
448-
[FromSomeType SerialiseAsBech32 b]
449-
-> [FromSomeType HasTextEnvelope b]
450-
-> VerificationKeyTextOrFile
451-
-> IO (Either VerificationKeyTextOrFileError b)
452-
readVerificationKeyTextOrFileAnyOf bech32Types textEnvTypes verKeyTextOrFile =
253+
:: VerificationKeyTextOrFile
254+
-> IO (Either VerificationKeyTextOrFileError SomeAddressVerificationKey)
255+
readVerificationKeyTextOrFileAnyOf verKeyTextOrFile =
453256
case verKeyTextOrFile of
454257
VktofVerificationKeyText vkText ->
455258
pure $ first VerificationKeyTextError $
456-
deserialiseInputAnyOf bech32Types textEnvTypes (Text.encodeUtf8 vkText)
457-
VktofVerificationKeyFile (VerificationKeyFile fp) ->
458-
first VerificationKeyFileError
459-
<$> readKeyFileAnyOf bech32Types textEnvTypes fp
259+
deserialiseAnyVerificationKey (Text.encodeUtf8 vkText)
260+
VktofVerificationKeyFile (VerificationKeyFile fp) -> do
261+
vkBs <- liftIO $ BS.readFile fp
262+
pure $ first VerificationKeyTextError $
263+
deserialiseAnyVerificationKey vkBs
264+
460265

461266
-- | Verification key, verification key hash, or path to a verification key
462267
-- file.

Diff for: ‎cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs

+3-3
Original file line numberDiff line numberDiff line change
@@ -50,9 +50,9 @@ import Cardano.Api.Shelley
5050

5151
import Cardano.Chain.Common (BlockCount (BlockCount))
5252
import Cardano.CLI.Shelley.Commands
53-
import Cardano.CLI.Shelley.Key (InputFormat (..), PaymentVerifier (..),
54-
StakeVerifier (..), VerificationKeyOrFile (..), VerificationKeyOrHashOrFile (..),
55-
VerificationKeyTextOrFile (..), deserialiseInput, renderInputDecodeError)
53+
import Cardano.CLI.Shelley.Key (PaymentVerifier (..), StakeVerifier (..),
54+
VerificationKeyOrFile (..), VerificationKeyOrHashOrFile (..),
55+
VerificationKeyTextOrFile (..))
5656
import Cardano.CLI.Types
5757

5858
{- HLINT ignore "Use <$>" -}

0 commit comments

Comments
 (0)