~zinigor/cardano-node/trunk

« back to all changes in this revision

Viewing changes to cardano-cli/src/Cardano/CLI/Shelley/Key.hs

  • Committer: Igor Zinovyev
  • Date: 2021-08-13 19:12:27 UTC
  • Revision ID: zinigor@gmail.com-20210813191227-stlnsj3mc5ypwn0c
Tags: upstream-1.27.0
ImportĀ upstreamĀ versionĀ 1.27.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
{-# LANGUAGE FlexibleContexts #-}
 
2
{-# LANGUAGE GADTs #-}
 
3
{-# LANGUAGE ScopedTypeVariables #-}
 
4
{-# LANGUAGE StandaloneDeriving #-}
 
5
{-# LANGUAGE UndecidableInstances #-}
 
6
 
 
7
-- | Shelley CLI option data types and functions for cryptographic keys.
 
8
module Cardano.CLI.Shelley.Key
 
9
  ( InputFormat (..)
 
10
  , InputDecodeError (..)
 
11
  , deserialiseInput
 
12
  , deserialiseInputAnyOf
 
13
  , renderInputDecodeError
 
14
 
 
15
  , readKeyFile
 
16
  , readKeyFileAnyOf
 
17
  , readKeyFileTextEnvelope
 
18
 
 
19
  , readSigningKeyFile
 
20
  , readSigningKeyFileAnyOf
 
21
 
 
22
  , VerificationKeyOrFile (..)
 
23
  , readVerificationKeyOrFile
 
24
  , readVerificationKeyOrTextEnvFile
 
25
 
 
26
  , VerificationKeyTextOrFile (..)
 
27
  , VerificationKeyTextOrFileError (..)
 
28
  , readVerificationKeyTextOrFileAnyOf
 
29
  , renderVerificationKeyTextOrFileError
 
30
 
 
31
  , VerificationKeyOrHashOrFile (..)
 
32
  , readVerificationKeyOrHashOrFile
 
33
  , readVerificationKeyOrHashOrTextEnvFile
 
34
 
 
35
  , PaymentVerifier(..)
 
36
  , StakeVerifier(..)
 
37
  ) where
 
38
 
 
39
import           Cardano.Prelude
 
40
 
 
41
import           Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither)
 
42
import qualified Data.Aeson as Aeson
 
43
import qualified Data.ByteString as BS
 
44
import qualified Data.ByteString.Char8 as BSC
 
45
import qualified Data.List.NonEmpty as NE
 
46
import qualified Data.Text as Text
 
47
import qualified Data.Text.Encoding as Text
 
48
 
 
49
import           Cardano.Api
 
50
 
 
51
import           Cardano.CLI.Types
 
52
 
 
53
------------------------------------------------------------------------------
 
54
-- Formatted/encoded input deserialisation
 
55
------------------------------------------------------------------------------
 
56
 
 
57
-- | Input format/encoding.
 
58
data InputFormat a where
 
59
  -- | Bech32 encoding.
 
60
  InputFormatBech32 :: SerialiseAsBech32 a => InputFormat a
 
61
 
 
62
  -- | Hex/Base16 encoding.
 
63
  InputFormatHex :: SerialiseAsRawBytes a => InputFormat a
 
64
 
 
65
  -- | Text envelope format.
 
66
  InputFormatTextEnvelope :: HasTextEnvelope a => InputFormat a
 
67
 
 
68
-- | Input decoding error.
 
69
data InputDecodeError
 
70
  = InputTextEnvelopeError !TextEnvelopeError
 
71
  -- ^ The provided data seems to be a valid text envelope, but some error
 
72
  -- occurred in deserialising it.
 
73
  | InputBech32DecodeError !Bech32DecodeError
 
74
  -- ^ The provided data is valid Bech32, but some error occurred in
 
75
  -- deserialising it.
 
76
  | InputInvalidError
 
77
  -- ^ The provided data does not represent a valid value of the provided
 
78
  -- type.
 
79
  deriving (Eq, Show)
 
80
 
 
81
instance Error InputDecodeError where
 
82
  displayError = Text.unpack . renderInputDecodeError
 
83
 
 
84
-- | Render an error message for a 'InputDecodeError'.
 
85
renderInputDecodeError :: InputDecodeError -> Text
 
86
renderInputDecodeError err =
 
87
  case err of
 
88
    InputTextEnvelopeError textEnvErr ->
 
89
      Text.pack (displayError textEnvErr)
 
90
    InputBech32DecodeError decodeErr ->
 
91
      Text.pack (displayError decodeErr)
 
92
    InputInvalidError -> "Invalid key."
 
93
 
 
94
-- | The result of a deserialisation function.
 
95
--
 
96
-- Note that this type isn't intended to be exported, but only used as a
 
97
-- helper within the 'deserialiseInput' function.
 
98
data DeserialiseInputResult a
 
99
  = DeserialiseInputSuccess !a
 
100
  -- ^ Input successfully deserialised.
 
101
  | DeserialiseInputError !InputDecodeError
 
102
  -- ^ The provided data is of the expected format/encoding, but an error
 
103
  -- occurred in deserialising it.
 
104
  | DeserialiseInputErrorFormatMismatch
 
105
  -- ^ The provided data's formatting/encoding does not match that which was
 
106
  -- expected. This error is an indication that one could attempt to
 
107
  -- deserialise the input again, but instead expecting a different format.
 
108
 
 
109
-- | Deserialise an input of some type that is formatted in some way.
 
110
deserialiseInput
 
111
  :: forall a.
 
112
     AsType a
 
113
  -> NonEmpty (InputFormat a)
 
114
  -> ByteString
 
115
  -> Either InputDecodeError a
 
116
deserialiseInput asType acceptedFormats inputBs =
 
117
    go (NE.toList acceptedFormats)
 
118
  where
 
119
    inputText :: Text
 
120
    inputText = Text.decodeUtf8 inputBs
 
121
 
 
122
    go :: [InputFormat a] -> Either InputDecodeError a
 
123
    go [] = Left InputInvalidError
 
124
    go (kf:kfs) =
 
125
      let res =
 
126
            case kf of
 
127
              InputFormatBech32 -> deserialiseBech32
 
128
              InputFormatHex -> deserialiseHex
 
129
              InputFormatTextEnvelope -> deserialiseTextEnvelope
 
130
      in case res of
 
131
        DeserialiseInputSuccess a -> Right a
 
132
        DeserialiseInputError err -> Left err
 
133
        DeserialiseInputErrorFormatMismatch -> go kfs
 
134
 
 
135
    deserialiseTextEnvelope :: HasTextEnvelope a => DeserialiseInputResult a
 
136
    deserialiseTextEnvelope = do
 
137
      let textEnvRes :: Either TextEnvelopeError a
 
138
          textEnvRes =
 
139
            deserialiseFromTextEnvelope asType
 
140
              =<< first TextEnvelopeAesonDecodeError (Aeson.eitherDecodeStrict' inputBs)
 
141
      case textEnvRes of
 
142
        Right res -> DeserialiseInputSuccess res
 
143
 
 
144
        -- The input was valid a text envelope, but there was a type mismatch
 
145
        -- error.
 
146
        Left err@TextEnvelopeTypeError{} ->
 
147
          DeserialiseInputError (InputTextEnvelopeError err)
 
148
 
 
149
        -- The input was not valid a text envelope.
 
150
        Left _ -> DeserialiseInputErrorFormatMismatch
 
151
 
 
152
    deserialiseBech32 :: SerialiseAsBech32 a => DeserialiseInputResult a
 
153
    deserialiseBech32 =
 
154
      case deserialiseFromBech32 asType inputText of
 
155
        Right res -> DeserialiseInputSuccess res
 
156
 
 
157
        -- The input was not valid Bech32.
 
158
        Left (Bech32DecodingError _) -> DeserialiseInputErrorFormatMismatch
 
159
 
 
160
        -- The input was valid Bech32, but some other error occurred.
 
161
        Left err -> DeserialiseInputError $ InputBech32DecodeError err
 
162
 
 
163
    deserialiseHex :: SerialiseAsRawBytes a => DeserialiseInputResult a
 
164
    deserialiseHex
 
165
      | isValidHex inputBs =
 
166
          maybe
 
167
            (DeserialiseInputError InputInvalidError)
 
168
            DeserialiseInputSuccess
 
169
            (deserialiseFromRawBytesHex asType inputBs)
 
170
      | otherwise = DeserialiseInputErrorFormatMismatch
 
171
 
 
172
    isValidHex :: ByteString -> Bool
 
173
    isValidHex x =
 
174
      all (`elem` hexAlpha) (toLower <$> BSC.unpack x)
 
175
        && even (BSC.length x)
 
176
      where
 
177
        hexAlpha :: [Char]
 
178
        hexAlpha = "0123456789abcdef"
 
179
 
 
180
-- | Deserialise an input of some type that is formatted in some way.
 
181
--
 
182
-- The provided 'ByteString' can either be Bech32-encoded or in the text
 
183
-- envelope format.
 
184
deserialiseInputAnyOf
 
185
  :: forall b.
 
186
     [FromSomeType SerialiseAsBech32 b]
 
187
  -> [FromSomeType HasTextEnvelope b]
 
188
  -> ByteString
 
189
  -> Either InputDecodeError b
 
190
deserialiseInputAnyOf bech32Types textEnvTypes inputBs =
 
191
    case deserialiseBech32 `orTry` deserialiseTextEnvelope of
 
192
      DeserialiseInputSuccess res -> Right res
 
193
      DeserialiseInputError err -> Left err
 
194
      DeserialiseInputErrorFormatMismatch -> Left InputInvalidError
 
195
  where
 
196
    inputText :: Text
 
197
    inputText = Text.decodeUtf8 inputBs
 
198
 
 
199
    orTry
 
200
      :: DeserialiseInputResult b
 
201
      -> DeserialiseInputResult b
 
202
      -> DeserialiseInputResult b
 
203
    orTry x y =
 
204
      case x of
 
205
        DeserialiseInputSuccess _ -> x
 
206
        DeserialiseInputError _ -> x
 
207
        DeserialiseInputErrorFormatMismatch -> y
 
208
 
 
209
    deserialiseTextEnvelope :: DeserialiseInputResult b
 
210
    deserialiseTextEnvelope = do
 
211
      let textEnvRes :: Either TextEnvelopeError b
 
212
          textEnvRes =
 
213
            deserialiseFromTextEnvelopeAnyOf textEnvTypes
 
214
              =<< first TextEnvelopeAesonDecodeError (Aeson.eitherDecodeStrict' inputBs)
 
215
      case textEnvRes of
 
216
        Right res -> DeserialiseInputSuccess res
 
217
 
 
218
        -- The input was valid a text envelope, but there was a type mismatch
 
219
        -- error.
 
220
        Left err@TextEnvelopeTypeError{} ->
 
221
          DeserialiseInputError (InputTextEnvelopeError err)
 
222
 
 
223
        -- The input was not valid a text envelope.
 
224
        Left _ -> DeserialiseInputErrorFormatMismatch
 
225
 
 
226
    deserialiseBech32 :: DeserialiseInputResult b
 
227
    deserialiseBech32 =
 
228
      case deserialiseAnyOfFromBech32 bech32Types inputText of
 
229
        Right res -> DeserialiseInputSuccess res
 
230
 
 
231
        -- The input was not valid Bech32.
 
232
        Left (Bech32DecodingError _) -> DeserialiseInputErrorFormatMismatch
 
233
 
 
234
        -- The input was valid Bech32, but some other error occurred.
 
235
        Left err -> DeserialiseInputError $ InputBech32DecodeError err
 
236
 
 
237
------------------------------------------------------------------------------
 
238
-- Cryptographic key deserialisation
 
239
------------------------------------------------------------------------------
 
240
 
 
241
-- | Read a cryptographic key from a file.
 
242
--
 
243
-- The contents of the file can either be Bech32-encoded, hex-encoded, or in
 
244
-- the text envelope format.
 
245
readKeyFile
 
246
  :: AsType a
 
247
  -> NonEmpty (InputFormat a)
 
248
  -> FilePath
 
249
  -> IO (Either (FileError InputDecodeError) a)
 
250
readKeyFile asType acceptedFormats path =
 
251
  runExceptT $ do
 
252
    content <- handleIOExceptT (FileIOError path) $ BS.readFile path
 
253
    firstExceptT (FileError path) $ hoistEither $
 
254
      deserialiseInput asType acceptedFormats content
 
255
 
 
256
-- | Read a cryptographic key from a file.
 
257
--
 
258
-- The contents of the file must be in the text envelope format.
 
259
readKeyFileTextEnvelope
 
260
  :: HasTextEnvelope a
 
261
  => AsType a
 
262
  -> FilePath
 
263
  -> IO (Either (FileError InputDecodeError) a)
 
264
readKeyFileTextEnvelope asType fp =
 
265
    first toInputDecodeError <$> readFileTextEnvelope asType fp
 
266
  where
 
267
    toInputDecodeError
 
268
      :: FileError TextEnvelopeError
 
269
      -> FileError InputDecodeError
 
270
    toInputDecodeError err =
 
271
      case err of
 
272
        FileIOError path ex -> FileIOError path ex
 
273
        FileError path textEnvErr ->
 
274
          FileError path (InputTextEnvelopeError textEnvErr)
 
275
        FileErrorTempFile targetP tempP h ->
 
276
          FileErrorTempFile targetP tempP h
 
277
 
 
278
-- | Read a cryptographic key from a file given that it is one of the provided
 
279
-- types.
 
280
--
 
281
-- The contents of the file can either be Bech32-encoded or in the text
 
282
-- envelope format.
 
283
readKeyFileAnyOf
 
284
  :: forall b.
 
285
     [FromSomeType SerialiseAsBech32 b]
 
286
  -> [FromSomeType HasTextEnvelope b]
 
287
  -> FilePath
 
288
  -> IO (Either (FileError InputDecodeError) b)
 
289
readKeyFileAnyOf bech32Types textEnvTypes path =
 
290
  runExceptT $ do
 
291
    content <- handleIOExceptT (FileIOError path) $ BS.readFile path
 
292
    firstExceptT (FileError path) $ hoistEither $
 
293
      deserialiseInputAnyOf bech32Types textEnvTypes content
 
294
 
 
295
------------------------------------------------------------------------------
 
296
-- Signing key deserialisation
 
297
------------------------------------------------------------------------------
 
298
 
 
299
-- | Read a signing key from a file.
 
300
--
 
301
-- The contents of the file can either be Bech32-encoded, hex-encoded, or in
 
302
-- the text envelope format.
 
303
readSigningKeyFile
 
304
  :: forall keyrole.
 
305
     ( HasTextEnvelope (SigningKey keyrole)
 
306
     , SerialiseAsBech32 (SigningKey keyrole)
 
307
     )
 
308
  => AsType keyrole
 
309
  -> SigningKeyFile
 
310
  -> IO (Either (FileError InputDecodeError) (SigningKey keyrole))
 
311
readSigningKeyFile asType (SigningKeyFile fp) =
 
312
  readKeyFile
 
313
    (AsSigningKey asType)
 
314
    (NE.fromList [InputFormatBech32, InputFormatHex, InputFormatTextEnvelope])
 
315
    fp
 
316
 
 
317
-- | Read a signing key from a file given that it is one of the provided types
 
318
-- of signing key.
 
319
--
 
320
-- The contents of the file can either be Bech32-encoded or in the text
 
321
-- envelope format.
 
322
readSigningKeyFileAnyOf
 
323
  :: forall b.
 
324
     [FromSomeType SerialiseAsBech32 b]
 
325
  -> [FromSomeType HasTextEnvelope b]
 
326
  -> SigningKeyFile
 
327
  -> IO (Either (FileError InputDecodeError) b)
 
328
readSigningKeyFileAnyOf bech32Types textEnvTypes (SigningKeyFile fp) =
 
329
  readKeyFileAnyOf bech32Types textEnvTypes fp
 
330
 
 
331
------------------------------------------------------------------------------
 
332
-- Verification key deserialisation
 
333
------------------------------------------------------------------------------
 
334
 
 
335
-- | Either a verification key or path to a verification key file.
 
336
data VerificationKeyOrFile keyrole
 
337
  = VerificationKeyValue !(VerificationKey keyrole)
 
338
  -- ^ A verification key.
 
339
  | VerificationKeyFilePath !VerificationKeyFile
 
340
  -- ^ A path to a verification key file.
 
341
  -- Note that this file hasn't been validated at all (whether it exists,
 
342
  -- contains a key of the correct type, etc.)
 
343
 
 
344
deriving instance Show (VerificationKey keyrole)
 
345
  => Show (VerificationKeyOrFile keyrole)
 
346
 
 
347
deriving instance Eq (VerificationKey keyrole)
 
348
  => Eq (VerificationKeyOrFile keyrole)
 
349
 
 
350
-- | Read a verification key or verification key file and return a
 
351
-- verification key.
 
352
--
 
353
-- If a filepath is provided, the file can either be formatted as Bech32, hex,
 
354
-- or text envelope.
 
355
readVerificationKeyOrFile
 
356
  :: ( HasTextEnvelope (VerificationKey keyrole)
 
357
     , SerialiseAsBech32 (VerificationKey keyrole)
 
358
     )
 
359
  => AsType keyrole
 
360
  -> VerificationKeyOrFile keyrole
 
361
  -> IO (Either (FileError InputDecodeError) (VerificationKey keyrole))
 
362
readVerificationKeyOrFile asType verKeyOrFile =
 
363
  case verKeyOrFile of
 
364
    VerificationKeyValue vk -> pure (Right vk)
 
365
    VerificationKeyFilePath (VerificationKeyFile fp) ->
 
366
      readKeyFile
 
367
        (AsVerificationKey asType)
 
368
        (NE.fromList [InputFormatBech32, InputFormatHex, InputFormatTextEnvelope])
 
369
        fp
 
370
 
 
371
-- | Read a verification key or verification key file and return a
 
372
-- verification key.
 
373
--
 
374
-- If a filepath is provided, it will be interpreted as a text envelope
 
375
-- formatted file.
 
376
readVerificationKeyOrTextEnvFile
 
377
  :: HasTextEnvelope (VerificationKey keyrole)
 
378
  => AsType keyrole
 
379
  -> VerificationKeyOrFile keyrole
 
380
  -> IO (Either (FileError InputDecodeError) (VerificationKey keyrole))
 
381
readVerificationKeyOrTextEnvFile asType verKeyOrFile =
 
382
  case verKeyOrFile of
 
383
    VerificationKeyValue vk -> pure (Right vk)
 
384
    VerificationKeyFilePath (VerificationKeyFile fp) ->
 
385
      readKeyFileTextEnvelope (AsVerificationKey asType) fp
 
386
 
 
387
data PaymentVerifier
 
388
  = PaymentVerifierKey VerificationKeyTextOrFile
 
389
  | PaymentVerifierScriptFile ScriptFile
 
390
  deriving (Eq, Show)
 
391
 
 
392
data StakeVerifier
 
393
  = StakeVerifierKey (VerificationKeyOrFile StakeKey)
 
394
  | StakeVerifierScriptFile ScriptFile
 
395
  deriving (Eq, Show)
 
396
 
 
397
-- | Either an unvalidated text representation of a verification key or a path
 
398
-- to a verification key file.
 
399
data VerificationKeyTextOrFile
 
400
  = VktofVerificationKeyText !Text
 
401
  | VktofVerificationKeyFile !VerificationKeyFile
 
402
  deriving (Eq, Show)
 
403
 
 
404
-- | An error in deserialising a 'VerificationKeyTextOrFile' to a
 
405
-- 'VerificationKey'.
 
406
data VerificationKeyTextOrFileError
 
407
  = VerificationKeyTextError !InputDecodeError
 
408
  | VerificationKeyFileError !(FileError InputDecodeError)
 
409
  deriving Show
 
410
 
 
411
-- | Render an error message for a 'VerificationKeyTextOrFileError'.
 
412
renderVerificationKeyTextOrFileError :: VerificationKeyTextOrFileError -> Text
 
413
renderVerificationKeyTextOrFileError vkTextOrFileErr =
 
414
  case vkTextOrFileErr of
 
415
    VerificationKeyTextError err -> renderInputDecodeError err
 
416
    VerificationKeyFileError err -> Text.pack (displayError err)
 
417
 
 
418
-- | Deserialise a verification key from text or a verification key file given
 
419
-- that it is one of the provided types.
 
420
--
 
421
-- If a filepath is provided, the file can either be formatted as Bech32, hex,
 
422
-- or text envelope.
 
423
readVerificationKeyTextOrFileAnyOf
 
424
  :: forall b.
 
425
     [FromSomeType SerialiseAsBech32 b]
 
426
  -> [FromSomeType HasTextEnvelope b]
 
427
  -> VerificationKeyTextOrFile
 
428
  -> IO (Either VerificationKeyTextOrFileError b)
 
429
readVerificationKeyTextOrFileAnyOf bech32Types textEnvTypes verKeyTextOrFile =
 
430
  case verKeyTextOrFile of
 
431
    VktofVerificationKeyText vkText ->
 
432
      pure $ first VerificationKeyTextError $
 
433
        deserialiseInputAnyOf bech32Types textEnvTypes (Text.encodeUtf8 vkText)
 
434
    VktofVerificationKeyFile (VerificationKeyFile fp) ->
 
435
      first VerificationKeyFileError
 
436
        <$> readKeyFileAnyOf bech32Types textEnvTypes fp
 
437
 
 
438
-- | Verification key, verification key hash, or path to a verification key
 
439
-- file.
 
440
data VerificationKeyOrHashOrFile keyrole
 
441
  = VerificationKeyOrFile !(VerificationKeyOrFile keyrole)
 
442
  -- ^ Either a verification key or path to a verification key file.
 
443
  | VerificationKeyHash !(Hash keyrole)
 
444
  -- ^ A verification key hash.
 
445
 
 
446
deriving instance (Show (VerificationKeyOrFile keyrole), Show (Hash keyrole))
 
447
  => Show (VerificationKeyOrHashOrFile keyrole)
 
448
 
 
449
deriving instance (Eq (VerificationKeyOrFile keyrole), Eq (Hash keyrole))
 
450
  => Eq (VerificationKeyOrHashOrFile keyrole)
 
451
 
 
452
-- | Read a verification key or verification key hash or verification key file
 
453
-- and return a verification key hash.
 
454
--
 
455
-- If a filepath is provided, the file can either be formatted as Bech32, hex,
 
456
-- or text envelope.
 
457
readVerificationKeyOrHashOrFile
 
458
  :: (Key keyrole, SerialiseAsBech32 (VerificationKey keyrole))
 
459
  => AsType keyrole
 
460
  -> VerificationKeyOrHashOrFile keyrole
 
461
  -> IO (Either (FileError InputDecodeError) (Hash keyrole))
 
462
readVerificationKeyOrHashOrFile asType verKeyOrHashOrFile =
 
463
  case verKeyOrHashOrFile of
 
464
    VerificationKeyOrFile vkOrFile -> do
 
465
      eitherVk <- readVerificationKeyOrFile asType vkOrFile
 
466
      pure (verificationKeyHash <$> eitherVk)
 
467
    VerificationKeyHash vkHash -> pure (Right vkHash)
 
468
 
 
469
-- | Read a verification key or verification key hash or verification key file
 
470
-- and return a verification key hash.
 
471
--
 
472
-- If a filepath is provided, it will be interpreted as a text envelope
 
473
-- formatted file.
 
474
readVerificationKeyOrHashOrTextEnvFile
 
475
  :: Key keyrole
 
476
  => AsType keyrole
 
477
  -> VerificationKeyOrHashOrFile keyrole
 
478
  -> IO (Either (FileError InputDecodeError) (Hash keyrole))
 
479
readVerificationKeyOrHashOrTextEnvFile asType verKeyOrHashOrFile =
 
480
  case verKeyOrHashOrFile of
 
481
    VerificationKeyOrFile vkOrFile -> do
 
482
      eitherVk <- readVerificationKeyOrTextEnvFile asType vkOrFile
 
483
      pure (verificationKeyHash <$> eitherVk)
 
484
    VerificationKeyHash vkHash -> pure (Right vkHash)