From d127f1b9da2573697b8f5444c10260dd5eb5a69c Mon Sep 17 00:00:00 2001 From: Luke Nadur <19835357+intricate@users.noreply.github.com> Date: Thu, 12 Nov 2020 11:44:33 -0500 Subject: [PATCH] Split up Cardano.CLI.Shelley.Key and introduce Cardano.Api.DeserialiseAnyOf --- cardano-api/cardano-api.cabal | 3 +- .../src/Cardano/Api/DeserialiseAnyOf.hs | 81 ++++++++++++++++++- cardano-cli/cardano-cli.cabal | 10 +++ cardano-cli/src/Cardano/CLI/Shelley/Key.hs | 14 ++-- 4 files changed, 98 insertions(+), 10 deletions(-) diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 7ed7681015f..49ed7f7ebe8 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -45,6 +45,7 @@ library Cardano.Api.ChainSync.Client Cardano.Api.ChainSync.ClientPipelined Cardano.Api.Crypto.Ed25519Bip32 + Cardano.Api.DeserialiseAnyOf Cardano.Api.Shelley -- TODO: Eliminate in the future when -- we create wrapper types for the ledger types @@ -59,7 +60,7 @@ library Cardano.Api.Convenience.Constraints Cardano.Api.Convenience.Construction Cardano.Api.Convenience.Query - Cardano.Api.DeserialiseAnyOf + Cardano.Api.Protocol Cardano.Api.Environment Cardano.Api.EraCast Cardano.Api.Eras diff --git a/cardano-api/src/Cardano/Api/DeserialiseAnyOf.hs b/cardano-api/src/Cardano/Api/DeserialiseAnyOf.hs index 7584ee49eea..1ea54413036 100644 --- a/cardano-api/src/Cardano/Api/DeserialiseAnyOf.hs +++ b/cardano-api/src/Cardano/Api/DeserialiseAnyOf.hs @@ -1,8 +1,10 @@ +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE UndecidableInstances #-} --- | Class of errors used in the Api. --- +-- | Deserialisation of input that may be formatted/encoded in one of several specified +-- ways. module Cardano.Api.DeserialiseAnyOf ( InputFormat (..) , InputDecodeError (..) @@ -16,11 +18,18 @@ module Cardano.Api.DeserialiseAnyOf , deserialiseAnyVerificationKeyBech32 , deserialiseAnyVerificationKeyTextEnvelope , renderSomeAddressVerificationKey + + , readFileAnyOfInputFormats + , readFileBech32OrTextEnvAnyOf + , readFileTextEnvelope' ) where +import Control.Monad.Trans.Except +import Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither) import qualified Data.Aeson as Aeson import Data.Bifunctor (first) import Data.ByteString (ByteString) +import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC import Data.Char (toLower) import Data.List.NonEmpty (NonEmpty) @@ -74,7 +83,13 @@ data InputDecodeError | InputInvalidError -- ^ The provided data does not represent a valid value of the provided -- type. + | InputHexDecodeError + -- ^ The provided data is valid hex, but some error occurred in + -- deserialising it. + -- + -- TODO: Add parameter for list of possible input formats. deriving (Eq, Show) + instance Error InputDecodeError where displayError = Text.unpack . renderInputDecodeError @@ -87,6 +102,9 @@ renderInputDecodeError err = InputBech32DecodeError decodeErr -> Text.pack (displayError decodeErr) InputInvalidError -> "Invalid key." + InputHexDecodeError -> + "There was an error in deserialising the hex-encoded string into a " + <> "value of the expected type." -- | The result of a deserialisation function. -- @@ -229,6 +247,7 @@ deserialiseInputAnyOf bech32Types textEnvTypes inputBs = -- The input was valid Bech32, but some other error occurred. Left err -> DeserialiseInputError $ InputBech32DecodeError err + data SomeAddressVerificationKey = AByronVerificationKey (VerificationKey ByronKey) | APaymentVerificationKey (VerificationKey PaymentKey) @@ -315,3 +334,61 @@ deserialiseAnyVerificationKeyTextEnvelope bs = , FromSomeType (AsVerificationKey AsGenesisExtendedKey) AGenesisExtendedVerificationKey ] + +------------------------------------------------------------------------------ +-- Encoded file deserialisation +------------------------------------------------------------------------------ + +-- | Read and decode input from a file. +-- +-- The contents of the file can either be Bech32-encoded, hex-encoded, or in +-- the text envelope format. +readFileAnyOfInputFormats + :: AsType a + -> NonEmpty (InputFormat a) + -> FilePath + -> IO (Either (FileError InputDecodeError) a) +readFileAnyOfInputFormats asType acceptedFormats path = + runExceptT $ do + content <- handleIOExceptT (FileIOError path) $ BS.readFile path + firstExceptT (FileError path) $ hoistEither $ + deserialiseInput asType acceptedFormats content + +-- | Read and decode input from a text envelope file. +-- +-- The contents of the file must be in the text envelope format. +readFileTextEnvelope' + :: HasTextEnvelope a + => AsType a + -> FilePath + -> IO (Either (FileError InputDecodeError) a) +readFileTextEnvelope' asType fp = + first toInputDecodeError <$> readFileTextEnvelope asType fp + where + toInputDecodeError + :: FileError TextEnvelopeError + -> FileError InputDecodeError + toInputDecodeError err = + case err of + FileIOError path ex -> FileIOError path ex + FileError path textEnvErr -> + FileError path (InputTextEnvelopeError textEnvErr) + FileErrorTempFile targetP tempP h -> + FileErrorTempFile targetP tempP h + +-- | Read and decode input from a file given that it is one of the provided +-- types. +-- +-- The contents of the file can either be Bech32-encoded or in the text +-- envelope format. +readFileBech32OrTextEnvAnyOf + :: forall b. + [FromSomeType SerialiseAsBech32 b] + -> [FromSomeType HasTextEnvelope b] + -> FilePath + -> IO (Either (FileError InputDecodeError) b) +readFileBech32OrTextEnvAnyOf bech32Types textEnvTypes path = + runExceptT $ do + content <- handleIOExceptT (FileIOError path) $ BS.readFile path + firstExceptT (FileError path) $ hoistEither $ + deserialiseInputAnyOf bech32Types textEnvTypes content diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index d6ecdade916..24eca5b8b58 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -279,9 +279,19 @@ test-suite cardano-cli-golden Test.Golden.Shelley.TextEnvelope.Certificates.OperationalCertificate Test.Golden.Shelley.TextEnvelope.Certificates.StakeAddressCertificates Test.Golden.Shelley.TextEnvelope.Certificates.StakePoolCertificates + -- TODO intricate DELETE + Test.Golden.Shelley.TextEnvelope.Keys.ExtendedPaymentKeys Test.Golden.Shelley.TextEnvelope.Keys.GenesisDelegateKeys Test.Golden.Shelley.TextEnvelope.Keys.GenesisKeys Test.Golden.Shelley.TextEnvelope.Keys.GenesisUTxOKeys + -- TODO intricate DELETE + Test.Golden.Shelley.TextEnvelope.Keys.KESKeys + -- TODO intricate DELETE + Test.Golden.Shelley.TextEnvelope.Keys.PaymentKeys + -- TODO intricate DELETE + Test.Golden.Shelley.TextEnvelope.Keys.StakeKeys + -- TODO intricate DELETE + Test.Golden.Shelley.TextEnvelope.Keys.VRFKeys Test.Golden.Shelley.TextEnvelope.Tx.Tx Test.Golden.Shelley.TextEnvelope.Tx.TxBody Test.Golden.Shelley.TextEnvelope.Tx.Witness diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Key.hs b/cardano-cli/src/Cardano/CLI/Shelley/Key.hs index 87095701666..eafe3d6d136 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Key.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Key.hs @@ -1,5 +1,4 @@ {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE UndecidableInstances #-} @@ -40,8 +39,6 @@ module Cardano.CLI.Shelley.Key , generateKeyPair ) where -import Cardano.Api - import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Trans.Except (runExceptT) import Control.Monad.Trans.Except.Extra (handleIOExceptT) @@ -54,6 +51,9 @@ import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text +import Cardano.Api +import Cardano.Api.DeserialiseAnyOf + import Cardano.CLI.Types ------------------------------------------------------------------------------ @@ -104,7 +104,7 @@ readSigningKeyFile -> SigningKeyFile -> IO (Either (FileError InputDecodeError) (SigningKey keyrole)) readSigningKeyFile asType (SigningKeyFile fp) = - readKeyFile + readFileAnyOfInputFormats (AsSigningKey asType) (NE.fromList [InputFormatBech32, InputFormatHex, InputFormatTextEnvelope]) fp @@ -121,7 +121,7 @@ readSigningKeyFileAnyOf -> SigningKeyFile -> IO (Either (FileError InputDecodeError) b) readSigningKeyFileAnyOf bech32Types textEnvTypes (SigningKeyFile fp) = - readKeyFileAnyOf bech32Types textEnvTypes fp + readFileBech32OrTextEnvAnyOf bech32Types textEnvTypes fp ------------------------------------------------------------------------------ -- Verification key deserialisation @@ -158,7 +158,7 @@ readVerificationKeyOrFile asType verKeyOrFile = case verKeyOrFile of VerificationKeyValue vk -> pure (Right vk) VerificationKeyFilePath (VerificationKeyFile fp) -> - readKeyFile + readFileAnyOfInputFormats (AsVerificationKey asType) (NE.fromList [InputFormatBech32, InputFormatHex, InputFormatTextEnvelope]) fp @@ -177,7 +177,7 @@ readVerificationKeyOrTextEnvFile asType verKeyOrFile = case verKeyOrFile of VerificationKeyValue vk -> pure (Right vk) VerificationKeyFilePath (VerificationKeyFile fp) -> - readKeyFileTextEnvelope (AsVerificationKey asType) fp + readFileTextEnvelope' (AsVerificationKey asType) fp data PaymentVerifier = PaymentVerifierKey VerificationKeyTextOrFile