From 9b9df9b1da543286e477e4b2c41edcda42e2ddf8 Mon Sep 17 00:00:00 2001 From: John Ky Date: Sat, 10 Dec 2022 11:43:15 +1100 Subject: [PATCH] Add eitherDeserialiseFromRawBytes method to SerialiseAsRawBytes type class More descriptive error message for decode of AssetName Introduce new SerialiseAsRawBytesError error type --- .github/workflows/haskell.yml | 2 + cardano-api/cardano-api.cabal | 1 + cardano-api/src/Cardano/Api.hs | 2 +- cardano-api/src/Cardano/Api/Address.hs | 49 ++--- cardano-api/src/Cardano/Api/Block.hs | 6 +- cardano-api/src/Cardano/Api/Key.hs | 6 +- cardano-api/src/Cardano/Api/KeysByron.hs | 38 ++-- cardano-api/src/Cardano/Api/KeysPraos.hs | 37 ++-- cardano-api/src/Cardano/Api/KeysShelley.hs | 176 +++++++++++------- .../src/Cardano/Api/ProtocolParameters.hs | 6 +- cardano-api/src/Cardano/Api/Query.hs | 3 +- cardano-api/src/Cardano/Api/Script.hs | 10 +- cardano-api/src/Cardano/Api/ScriptData.hs | 8 +- .../src/Cardano/Api/SerialiseBech32.hs | 12 +- cardano-api/src/Cardano/Api/SerialiseRaw.hs | 24 ++- cardano-api/src/Cardano/Api/SerialiseUsing.hs | 12 +- cardano-api/src/Cardano/Api/SpecialByron.hs | 18 +- .../src/Cardano/Api/StakePoolMetadata.hs | 6 +- cardano-api/src/Cardano/Api/TxIn.hs | 6 +- cardano-api/src/Cardano/Api/Value.hs | 12 +- .../test/Test/Cardano/Api/Typed/RawBytes.hs | 4 +- cardano-cli/src/Cardano/CLI/Byron/Key.hs | 12 +- .../src/Cardano/CLI/Byron/UpdateProposal.hs | 4 +- cardano-cli/src/Cardano/CLI/Byron/Vote.hs | 6 +- .../Cardano/CLI/Shelley/Run/Transaction.hs | 4 +- .../test/Test/Golden/Byron/SigningKeys.hs | 6 +- .../src/Cardano/Node/Protocol/Byron.hs | 8 +- 27 files changed, 276 insertions(+), 202 deletions(-) diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index 3d8f9015adf..ef870a68e37 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -282,6 +282,8 @@ jobs: # - name: Setup tmate session # if: ${{ failure() }} # uses: mxschmitt/action-tmate@v3 + # with: + # limit-access-to-actor: true release: needs: [build] diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index d282b52ed84..1234a744016 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -129,6 +129,7 @@ library , cryptonite , deepseq , directory + , either , filepath , formatting , iproute diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index 1b975c7c258..0a02c39f4f9 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -471,7 +471,7 @@ module Cardano.Api ( -- | Some types have a natural raw binary format. SerialiseAsRawBytes, serialiseToRawBytes, - deserialiseFromRawBytes, + eitherDeserialiseFromRawBytes, serialiseToRawBytesHex, deserialiseFromRawBytesHex, serialiseToRawBytesHexText, diff --git a/cardano-api/src/Cardano/Api/Address.hs b/cardano-api/src/Cardano/Api/Address.hs index 4a181f30171..ada4079cab9 100644 --- a/cardano-api/src/Cardano/Api/Address.hs +++ b/cardano-api/src/Cardano/Api/Address.hs @@ -81,8 +81,10 @@ import Prelude import Control.Applicative ((<|>)) import Data.Aeson (FromJSON (..), ToJSON (..), withText, (.=)) import qualified Data.Aeson as Aeson +import Data.Bifunctor (first) import qualified Data.ByteString.Base58 as Base58 import Data.Char (isAsciiLower, isAsciiUpper, isDigit) +import Data.Either.Combinators (rightToMaybe) import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text @@ -221,22 +223,22 @@ instance SerialiseAsRawBytes (Address ByronAddr) where . Shelley.BootstrapAddress $ addr - deserialiseFromRawBytes (AsAddress AsByronAddr) bs = + eitherDeserialiseFromRawBytes (AsAddress AsByronAddr) bs = case Shelley.deserialiseAddr bs :: Maybe (Shelley.Addr StandardCrypto) of - Nothing -> Nothing - Just Shelley.Addr{} -> Nothing + Nothing -> Left (SerialiseAsRawBytesError "Unable to deserialise Address ByronAddr") + Just Shelley.Addr{} -> Left (SerialiseAsRawBytesError "Unable to deserialise Address ByronAddr") Just (Shelley.AddrBootstrap (Shelley.BootstrapAddress addr)) -> - Just (ByronAddress addr) + Right (ByronAddress addr) instance SerialiseAsRawBytes (Address ShelleyAddr) where serialiseToRawBytes (ShelleyAddress nw pc scr) = Shelley.serialiseAddr (Shelley.Addr nw pc scr) - deserialiseFromRawBytes (AsAddress AsShelleyAddr) bs = + eitherDeserialiseFromRawBytes (AsAddress AsShelleyAddr) bs = case Shelley.deserialiseAddr bs of - Nothing -> Nothing - Just Shelley.AddrBootstrap{} -> Nothing - Just (Shelley.Addr nw pc scr) -> Just (ShelleyAddress nw pc scr) + Nothing -> Left (SerialiseAsRawBytesError "Unable to deserialise bootstrap Address ShelleyAddr") + Just Shelley.AddrBootstrap{} -> Left (SerialiseAsRawBytesError "Unable to deserialise bootstrap Address ShelleyAddr") + Just (Shelley.Addr nw pc scr) -> Right (ShelleyAddress nw pc scr) instance SerialiseAsBech32 (Address ShelleyAddr) where bech32PrefixFor (ShelleyAddress Shelley.Mainnet _ _) = "addr" @@ -254,7 +256,7 @@ instance SerialiseAddress (Address ByronAddr) where deserialiseAddress (AsAddress AsByronAddr) txt = do bs <- Base58.decodeBase58 Base58.bitcoinAlphabet (Text.encodeUtf8 txt) - deserialiseFromRawBytes (AsAddress AsByronAddr) bs + rightToMaybe (eitherDeserialiseFromRawBytes (AsAddress AsByronAddr) bs) instance SerialiseAddress (Address ShelleyAddr) where serialiseAddress addr@ShelleyAddress{} = @@ -327,14 +329,14 @@ instance SerialiseAsRawBytes AddressAny where serialiseToRawBytes (AddressByron addr) = serialiseToRawBytes addr serialiseToRawBytes (AddressShelley addr) = serialiseToRawBytes addr - deserialiseFromRawBytes AsAddressAny bs = + eitherDeserialiseFromRawBytes AsAddressAny bs = case Shelley.deserialiseAddr bs of - Nothing -> Nothing + Nothing -> Left (SerialiseAsRawBytesError "Unable to deserialise AddressAny") Just (Shelley.AddrBootstrap (Shelley.BootstrapAddress addr)) -> - Just (AddressByron (ByronAddress addr)) + Right (AddressByron (ByronAddress addr)) Just (Shelley.Addr nw pc scr) -> - Just (AddressShelley (ShelleyAddress nw pc scr)) + Right (AddressShelley (ShelleyAddress nw pc scr)) instance SerialiseAddress AddressAny where serialiseAddress (AddressByron addr) = serialiseAddress addr @@ -453,8 +455,9 @@ instance (IsCardanoEra era, Typeable era) => SerialiseAsRawBytes (AddressInEra e serialiseToRawBytes (AddressInEra ShelleyAddressInEra{} addr) = serialiseToRawBytes addr - deserialiseFromRawBytes _ bs = - anyAddressInEra cardanoEra =<< deserialiseFromRawBytes AsAddressAny bs + eitherDeserialiseFromRawBytes _ bs = + first (const (SerialiseAsRawBytesError "Unable to deserialise AddressInEra era")) $ + anyAddressInEra cardanoEra =<< first unSerialiseAsRawBytesError (eitherDeserialiseFromRawBytes AsAddressAny bs) instance IsCardanoEra era => SerialiseAddress (AddressInEra era) where serialiseAddress (AddressInEra ByronAddressInAnyEra addr) = @@ -464,7 +467,7 @@ instance IsCardanoEra era => SerialiseAddress (AddressInEra era) where serialiseAddress addr deserialiseAddress _ t = - anyAddressInEra cardanoEra =<< deserialiseAddress AsAddressAny t + rightToMaybe . anyAddressInEra cardanoEra =<< deserialiseAddress AsAddressAny t instance EraCast (AddressTypeInEra addrtype) where eraCast toEra' v = case v of @@ -491,14 +494,14 @@ anyAddressInShelleyBasedEra (AddressShelley addr) = shelleyAddressInEra addr anyAddressInEra :: CardanoEra era -> AddressAny - -> Maybe (AddressInEra era) + -> Either String (AddressInEra era) anyAddressInEra _ (AddressByron addr) = - Just (AddressInEra ByronAddressInAnyEra addr) + Right (AddressInEra ByronAddressInAnyEra addr) anyAddressInEra era (AddressShelley addr) = case cardanoEraStyle era of - LegacyByronEra -> Nothing - ShelleyBasedEra era' -> Just (AddressInEra (ShelleyAddressInEra era') addr) + LegacyByronEra -> Left "Expected Byron based era address" + ShelleyBasedEra era' -> Right (AddressInEra (ShelleyAddressInEra era') addr) toAddressAny :: Address addr -> AddressAny toAddressAny a@ShelleyAddress{} = AddressShelley a @@ -571,10 +574,10 @@ instance SerialiseAsRawBytes StakeAddress where serialiseToRawBytes (StakeAddress nw sc) = Shelley.serialiseRewardAcnt (Shelley.RewardAcnt nw sc) - deserialiseFromRawBytes AsStakeAddress bs = + eitherDeserialiseFromRawBytes AsStakeAddress bs = case Shelley.deserialiseRewardAcnt bs of - Nothing -> Nothing - Just (Shelley.RewardAcnt nw sc) -> Just (StakeAddress nw sc) + Nothing -> Left (SerialiseAsRawBytesError "Unable to deserialise StakeAddress") + Just (Shelley.RewardAcnt nw sc) -> Right (StakeAddress nw sc) instance SerialiseAsBech32 StakeAddress where diff --git a/cardano-api/src/Cardano/Api/Block.hs b/cardano-api/src/Cardano/Api/Block.hs index 29fec61bbba..aa6c9beec0b 100644 --- a/cardano-api/src/Cardano/Api/Block.hs +++ b/cardano-api/src/Cardano/Api/Block.hs @@ -293,9 +293,9 @@ newtype instance Hash BlockHeader = HeaderHash SBS.ShortByteString instance SerialiseAsRawBytes (Hash BlockHeader) where serialiseToRawBytes (HeaderHash bs) = SBS.fromShort bs - deserialiseFromRawBytes (AsHash AsBlockHeader) bs - | BS.length bs == 32 = Just $! HeaderHash (SBS.toShort bs) - | otherwise = Nothing + eitherDeserialiseFromRawBytes (AsHash AsBlockHeader) bs + | BS.length bs == 32 = Right $! HeaderHash (SBS.toShort bs) + | otherwise = Left (SerialiseAsRawBytesError "Unable to deserialise Hash BlockHeader") instance HasTypeProxy BlockHeader where data AsType BlockHeader = AsBlockHeader diff --git a/cardano-api/src/Cardano/Api/Key.hs b/cardano-api/src/Cardano/Api/Key.hs index 1f2dba82147..7184906905b 100644 --- a/cardano-api/src/Cardano/Api/Key.hs +++ b/cardano-api/src/Cardano/Api/Key.hs @@ -77,9 +77,9 @@ generateInsecureSigningKey -> IO (SigningKey keyrole, StdGen) generateInsecureSigningKey g keytype = do let (bs, g') = Random.genByteString (fromIntegral $ deterministicSigningKeySeedSize keytype) g - case deserialiseFromRawBytes (AsSigningKey keytype) bs of - Just key -> return (key, g') - Nothing -> error "generateInsecureSigningKey: Unable to generate insecure key" + case eitherDeserialiseFromRawBytes (AsSigningKey keytype) bs of + Right key -> return (key, g') + Left (SerialiseAsRawBytesError msg) -> error $ "generateInsecureSigningKey: Unable to generate insecure key: " <> msg instance HasTypeProxy a => HasTypeProxy (VerificationKey a) where data AsType (VerificationKey a) = AsVerificationKey (AsType a) diff --git a/cardano-api/src/Cardano/Api/KeysByron.hs b/cardano-api/src/Cardano/Api/KeysByron.hs index 2bd4b465c1c..c6e3cea46f4 100644 --- a/cardano-api/src/Cardano/Api/KeysByron.hs +++ b/cardano-api/src/Cardano/Api/KeysByron.hs @@ -36,7 +36,9 @@ import Prelude import qualified Codec.CBOR.Decoding as CBOR import qualified Codec.CBOR.Read as CBOR import Control.Monad +import Data.Bifunctor import qualified Data.ByteString.Lazy as LB +import Data.Either.Combinators import Data.String (IsString) import Data.Text (Text) import qualified Data.Text as Text @@ -52,8 +54,8 @@ import qualified Cardano.Crypto.Hashing as Byron import qualified Cardano.Crypto.Signing as Byron import qualified Cardano.Crypto.Wallet as Wallet -import Cardano.Api.HasTypeProxy import Cardano.Api.Hash +import Cardano.Api.HasTypeProxy import Cardano.Api.Key import Cardano.Api.KeysShelley import Cardano.Api.SerialiseCBOR @@ -140,17 +142,17 @@ instance SerialiseAsRawBytes (VerificationKey ByronKey) where serialiseToRawBytes (ByronVerificationKey (Byron.VerificationKey xvk)) = Crypto.HD.unXPub xvk - deserialiseFromRawBytes (AsVerificationKey AsByronKey) bs = - either (const Nothing) (Just . ByronVerificationKey . Byron.VerificationKey) - (Crypto.HD.xpub bs) + eitherDeserialiseFromRawBytes (AsVerificationKey AsByronKey) bs = + first (\msg -> SerialiseAsRawBytesError ("Unable to deserialise VerificationKey ByronKey" ++ msg)) $ + ByronVerificationKey . Byron.VerificationKey <$> Crypto.HD.xpub bs instance SerialiseAsRawBytes (SigningKey ByronKey) where serialiseToRawBytes (ByronSigningKey (Byron.SigningKey xsk)) = toStrictByteString $ Crypto.toCBORXPrv xsk - deserialiseFromRawBytes (AsSigningKey AsByronKey) bs = - either (const Nothing) (Just . ByronSigningKey . Byron.SigningKey) - (snd <$> CBOR.deserialiseFromBytes Byron.fromCBORXPrv (LB.fromStrict bs)) + eitherDeserialiseFromRawBytes (AsSigningKey AsByronKey) bs = + first (\e -> SerialiseAsRawBytesError ("Unable to deserialise SigningKey ByronKey" ++ show e)) $ + ByronSigningKey . Byron.SigningKey . snd <$> CBOR.deserialiseFromBytes Byron.fromCBORXPrv (LB.fromStrict bs) newtype instance Hash ByronKey = ByronKeyHash Byron.KeyHash deriving (Eq, Ord) @@ -162,8 +164,9 @@ instance SerialiseAsRawBytes (Hash ByronKey) where serialiseToRawBytes (ByronKeyHash (Byron.KeyHash vkh)) = Byron.abstractHashToBytes vkh - deserialiseFromRawBytes (AsHash AsByronKey) bs = - ByronKeyHash . Byron.KeyHash <$> Byron.abstractHashFromBytes bs + eitherDeserialiseFromRawBytes (AsHash AsByronKey) bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash ByronKey") $ + ByronKeyHash . Byron.KeyHash <$> Byron.abstractHashFromBytes bs instance CastVerificationKeyRole ByronKey PaymentExtendedKey where castVerificationKey (ByronVerificationKey vk) = @@ -233,24 +236,25 @@ instance SerialiseAsRawBytes (Hash ByronKeyLegacy) where serialiseToRawBytes (ByronKeyHashLegacy (Byron.KeyHash vkh)) = Byron.abstractHashToBytes vkh - deserialiseFromRawBytes (AsHash AsByronKeyLegacy) bs = - ByronKeyHashLegacy . Byron.KeyHash <$> Byron.abstractHashFromBytes bs + eitherDeserialiseFromRawBytes (AsHash AsByronKeyLegacy) bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash ByronKeyLegacy") $ + ByronKeyHashLegacy . Byron.KeyHash <$> Byron.abstractHashFromBytes bs instance SerialiseAsRawBytes (VerificationKey ByronKeyLegacy) where serialiseToRawBytes (ByronVerificationKeyLegacy (Byron.VerificationKey xvk)) = Crypto.HD.unXPub xvk - deserialiseFromRawBytes (AsVerificationKey AsByronKeyLegacy) bs = - either (const Nothing) (Just . ByronVerificationKeyLegacy . Byron.VerificationKey) - (Crypto.HD.xpub bs) + eitherDeserialiseFromRawBytes (AsVerificationKey AsByronKeyLegacy) bs = + first (\msg -> SerialiseAsRawBytesError ("Unable to deserialise VerificationKey ByronKeyLegacy" ++ msg)) $ + ByronVerificationKeyLegacy . Byron.VerificationKey <$> Crypto.HD.xpub bs instance SerialiseAsRawBytes (SigningKey ByronKeyLegacy) where serialiseToRawBytes (ByronSigningKeyLegacy (Byron.SigningKey xsk)) = Crypto.HD.unXPrv xsk - deserialiseFromRawBytes (AsSigningKey AsByronKeyLegacy) bs = - either (const Nothing) (Just . ByronSigningKeyLegacy . snd) - (CBOR.deserialiseFromBytes decodeLegacyDelegateKey $ LB.fromStrict bs) + eitherDeserialiseFromRawBytes (AsSigningKey AsByronKeyLegacy) bs = + first (\e -> SerialiseAsRawBytesError ("Unable to deserialise SigningKey ByronKeyLegacy" ++ show e)) $ + ByronSigningKeyLegacy . snd <$> CBOR.deserialiseFromBytes decodeLegacyDelegateKey (LB.fromStrict bs) where -- Stolen from: cardano-sl/binary/src/Pos/Binary/Class/Core.hs -- | Enforces that the input size is the same as the decoded one, failing in diff --git a/cardano-api/src/Cardano/Api/KeysPraos.hs b/cardano-api/src/Cardano/Api/KeysPraos.hs index 80080e78131..9e7fd821333 100644 --- a/cardano-api/src/Cardano/Api/KeysPraos.hs +++ b/cardano-api/src/Cardano/Api/KeysPraos.hs @@ -24,18 +24,19 @@ module Cardano.Api.KeysPraos ( import Prelude +import Data.Either.Combinators (maybeToRight) import Data.String (IsString (..)) import qualified Cardano.Crypto.DSIGN.Class as Crypto import qualified Cardano.Crypto.Hash.Class as Crypto import qualified Cardano.Crypto.KES.Class as Crypto import qualified Cardano.Crypto.VRF.Class as Crypto +import Cardano.Ledger.Crypto (StandardCrypto) import qualified Cardano.Ledger.Crypto as Shelley (KES, VRF) import qualified Cardano.Ledger.Keys as Shelley -import Cardano.Ledger.Crypto (StandardCrypto) -import Cardano.Api.HasTypeProxy import Cardano.Api.Hash +import Cardano.Api.HasTypeProxy import Cardano.Api.Key import Cardano.Api.SerialiseBech32 import Cardano.Api.SerialiseCBOR @@ -43,7 +44,6 @@ import Cardano.Api.SerialiseRaw import Cardano.Api.SerialiseTextEnvelope import Cardano.Api.SerialiseUsing - -- -- KES keys -- @@ -94,16 +94,17 @@ instance SerialiseAsRawBytes (VerificationKey KesKey) where serialiseToRawBytes (KesVerificationKey vk) = Crypto.rawSerialiseVerKeyKES vk - deserialiseFromRawBytes (AsVerificationKey AsKesKey) bs = - KesVerificationKey <$> - Crypto.rawDeserialiseVerKeyKES bs + eitherDeserialiseFromRawBytes (AsVerificationKey AsKesKey) bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise VerificationKey KesKey") $ + KesVerificationKey <$> Crypto.rawDeserialiseVerKeyKES bs instance SerialiseAsRawBytes (SigningKey KesKey) where serialiseToRawBytes (KesSigningKey sk) = Crypto.rawSerialiseSignKeyKES sk - deserialiseFromRawBytes (AsSigningKey AsKesKey) bs = - KesSigningKey <$> Crypto.rawDeserialiseSignKeyKES bs + eitherDeserialiseFromRawBytes (AsSigningKey AsKesKey) bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise SigningKey KesKey") $ + KesSigningKey <$> Crypto.rawDeserialiseSignKeyKES bs instance SerialiseAsBech32 (VerificationKey KesKey) where bech32PrefixFor _ = "kes_vk" @@ -126,8 +127,9 @@ instance SerialiseAsRawBytes (Hash KesKey) where serialiseToRawBytes (KesKeyHash vkh) = Crypto.hashToBytes vkh - deserialiseFromRawBytes (AsHash AsKesKey) bs = - KesKeyHash <$> Crypto.hashFromBytes bs + eitherDeserialiseFromRawBytes (AsHash AsKesKey) bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash KesKey") $ + KesKeyHash <$> Crypto.hashFromBytes bs instance HasTextEnvelope (VerificationKey KesKey) where textEnvelopeType _ = "KesVerificationKey_" @@ -192,15 +194,17 @@ instance SerialiseAsRawBytes (VerificationKey VrfKey) where serialiseToRawBytes (VrfVerificationKey vk) = Crypto.rawSerialiseVerKeyVRF vk - deserialiseFromRawBytes (AsVerificationKey AsVrfKey) bs = - VrfVerificationKey <$> Crypto.rawDeserialiseVerKeyVRF bs + eitherDeserialiseFromRawBytes (AsVerificationKey AsVrfKey) bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise VerificationKey VrfKey") $ + VrfVerificationKey <$> Crypto.rawDeserialiseVerKeyVRF bs instance SerialiseAsRawBytes (SigningKey VrfKey) where serialiseToRawBytes (VrfSigningKey sk) = Crypto.rawSerialiseSignKeyVRF sk - deserialiseFromRawBytes (AsSigningKey AsVrfKey) bs = - VrfSigningKey <$> Crypto.rawDeserialiseSignKeyVRF bs + eitherDeserialiseFromRawBytes (AsSigningKey AsVrfKey) bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise SigningKey VrfKey") $ + VrfSigningKey <$> Crypto.rawDeserialiseSignKeyVRF bs instance SerialiseAsBech32 (VerificationKey VrfKey) where bech32PrefixFor _ = "vrf_vk" @@ -222,8 +226,9 @@ instance SerialiseAsRawBytes (Hash VrfKey) where serialiseToRawBytes (VrfKeyHash vkh) = Crypto.hashToBytes vkh - deserialiseFromRawBytes (AsHash AsVrfKey) bs = - VrfKeyHash <$> Crypto.hashFromBytes bs + eitherDeserialiseFromRawBytes (AsHash AsVrfKey) bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash VrfKey") $ + VrfKeyHash <$> Crypto.hashFromBytes bs instance HasTextEnvelope (VerificationKey VrfKey) where textEnvelopeType _ = "VrfVerificationKey_" <> fromString (Crypto.algorithmNameVRF proxy) diff --git a/cardano-api/src/Cardano/Api/KeysShelley.hs b/cardano-api/src/Cardano/Api/KeysShelley.hs index 2adc11b1626..cf51e04c709 100644 --- a/cardano-api/src/Cardano/Api/KeysShelley.hs +++ b/cardano-api/src/Cardano/Api/KeysShelley.hs @@ -38,8 +38,10 @@ module Cardano.Api.KeysShelley ( import Prelude import Data.Aeson.Types (ToJSONKey (..), toJSONKeyText, withText) +import Data.Bifunctor (first) import Data.ByteString (ByteString) import qualified Data.ByteString as BS +import Data.Either.Combinators (maybeToRight) import Data.Maybe import Data.String (IsString (..)) import qualified Data.Text as Text @@ -117,16 +119,21 @@ instance SerialiseAsRawBytes (VerificationKey PaymentKey) where serialiseToRawBytes (PaymentVerificationKey (Shelley.VKey vk)) = Crypto.rawSerialiseVerKeyDSIGN vk - deserialiseFromRawBytes (AsVerificationKey AsPaymentKey) bs = - PaymentVerificationKey . Shelley.VKey <$> - Crypto.rawDeserialiseVerKeyDSIGN bs + eitherDeserialiseFromRawBytes (AsVerificationKey AsPaymentKey) bs = + maybe + (Left (SerialiseAsRawBytesError "Unable to deserialise VerificationKey PaymentKey")) + (Right . PaymentVerificationKey . Shelley.VKey) + (Crypto.rawDeserialiseVerKeyDSIGN bs) instance SerialiseAsRawBytes (SigningKey PaymentKey) where serialiseToRawBytes (PaymentSigningKey sk) = Crypto.rawSerialiseSignKeyDSIGN sk - deserialiseFromRawBytes (AsSigningKey AsPaymentKey) bs = - PaymentSigningKey <$> Crypto.rawDeserialiseSignKeyDSIGN bs + eitherDeserialiseFromRawBytes (AsSigningKey AsPaymentKey) bs = + maybe + (Left (SerialiseAsRawBytesError "Unable to serialise AsSigningKey AsPaymentKey")) + (Right . PaymentSigningKey) + (Crypto.rawDeserialiseSignKeyDSIGN bs) instance SerialiseAsBech32 (VerificationKey PaymentKey) where bech32PrefixFor _ = "addr_vk" @@ -147,8 +154,10 @@ instance SerialiseAsRawBytes (Hash PaymentKey) where serialiseToRawBytes (PaymentKeyHash (Shelley.KeyHash vkh)) = Crypto.hashToBytes vkh - deserialiseFromRawBytes (AsHash AsPaymentKey) bs = - PaymentKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs + eitherDeserialiseFromRawBytes (AsHash AsPaymentKey) bs = + maybeToRight + (SerialiseAsRawBytesError "Unable to deserialise Hash PaymentKey") + (PaymentKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs) instance HasTextEnvelope (VerificationKey PaymentKey) where textEnvelopeType _ = "PaymentVerificationKeyShelley_" @@ -257,17 +266,19 @@ instance SerialiseAsRawBytes (VerificationKey PaymentExtendedKey) where serialiseToRawBytes (PaymentExtendedVerificationKey xpub) = Crypto.HD.unXPub xpub - deserialiseFromRawBytes (AsVerificationKey AsPaymentExtendedKey) bs = - either (const Nothing) (Just . PaymentExtendedVerificationKey) - (Crypto.HD.xpub bs) + eitherDeserialiseFromRawBytes (AsVerificationKey AsPaymentExtendedKey) bs = + first + (const (SerialiseAsRawBytesError "Unable to deserialise VerificationKey PaymentExtendedKey")) + (PaymentExtendedVerificationKey <$> Crypto.HD.xpub bs) instance SerialiseAsRawBytes (SigningKey PaymentExtendedKey) where serialiseToRawBytes (PaymentExtendedSigningKey xprv) = Crypto.HD.unXPrv xprv - deserialiseFromRawBytes (AsSigningKey AsPaymentExtendedKey) bs = - either (const Nothing) (Just . PaymentExtendedSigningKey) - (Crypto.HD.xprv bs) + eitherDeserialiseFromRawBytes (AsSigningKey AsPaymentExtendedKey) bs = + first + (const (SerialiseAsRawBytesError "Unable to deserialise SigningKey PaymentExtendedKey")) + (PaymentExtendedSigningKey <$> Crypto.HD.xprv bs) instance SerialiseAsBech32 (VerificationKey PaymentExtendedKey) where bech32PrefixFor _ = "addr_xvk" @@ -289,8 +300,9 @@ instance SerialiseAsRawBytes (Hash PaymentExtendedKey) where serialiseToRawBytes (PaymentExtendedKeyHash (Shelley.KeyHash vkh)) = Crypto.hashToBytes vkh - deserialiseFromRawBytes (AsHash AsPaymentExtendedKey) bs = - PaymentExtendedKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs + eitherDeserialiseFromRawBytes (AsHash AsPaymentExtendedKey) bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash PaymentExtendedKey") $ + PaymentExtendedKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs instance HasTextEnvelope (VerificationKey PaymentExtendedKey) where textEnvelopeType _ = "PaymentExtendedVerificationKeyShelley_ed25519_bip32" @@ -361,16 +373,18 @@ instance SerialiseAsRawBytes (VerificationKey StakeKey) where serialiseToRawBytes (StakeVerificationKey (Shelley.VKey vk)) = Crypto.rawSerialiseVerKeyDSIGN vk - deserialiseFromRawBytes (AsVerificationKey AsStakeKey) bs = - StakeVerificationKey . Shelley.VKey <$> - Crypto.rawDeserialiseVerKeyDSIGN bs + eitherDeserialiseFromRawBytes (AsVerificationKey AsStakeKey) bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise VerificationKey StakeKey") $ + StakeVerificationKey . Shelley.VKey <$> + Crypto.rawDeserialiseVerKeyDSIGN bs instance SerialiseAsRawBytes (SigningKey StakeKey) where serialiseToRawBytes (StakeSigningKey sk) = Crypto.rawSerialiseSignKeyDSIGN sk - deserialiseFromRawBytes (AsSigningKey AsStakeKey) bs = - StakeSigningKey <$> Crypto.rawDeserialiseSignKeyDSIGN bs + eitherDeserialiseFromRawBytes (AsSigningKey AsStakeKey) bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise SigningKey StakeKey") $ + StakeSigningKey <$> Crypto.rawDeserialiseSignKeyDSIGN bs instance SerialiseAsBech32 (VerificationKey StakeKey) where bech32PrefixFor _ = "stake_vk" @@ -392,8 +406,9 @@ instance SerialiseAsRawBytes (Hash StakeKey) where serialiseToRawBytes (StakeKeyHash (Shelley.KeyHash vkh)) = Crypto.hashToBytes vkh - deserialiseFromRawBytes (AsHash AsStakeKey) bs = - StakeKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs + eitherDeserialiseFromRawBytes (AsHash AsStakeKey) bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash StakeKey") $ + StakeKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs instance HasTextEnvelope (VerificationKey StakeKey) where textEnvelopeType _ = "StakeVerificationKeyShelley_" @@ -502,17 +517,17 @@ instance SerialiseAsRawBytes (VerificationKey StakeExtendedKey) where serialiseToRawBytes (StakeExtendedVerificationKey xpub) = Crypto.HD.unXPub xpub - deserialiseFromRawBytes (AsVerificationKey AsStakeExtendedKey) bs = - either (const Nothing) (Just . StakeExtendedVerificationKey) - (Crypto.HD.xpub bs) + eitherDeserialiseFromRawBytes (AsVerificationKey AsStakeExtendedKey) bs = + first (\msg -> SerialiseAsRawBytesError ("Unable to deserialise VerificationKey StakeExtendedKey: " ++ msg)) $ + StakeExtendedVerificationKey <$> Crypto.HD.xpub bs instance SerialiseAsRawBytes (SigningKey StakeExtendedKey) where serialiseToRawBytes (StakeExtendedSigningKey xprv) = Crypto.HD.unXPrv xprv - deserialiseFromRawBytes (AsSigningKey AsStakeExtendedKey) bs = - either (const Nothing) (Just . StakeExtendedSigningKey) - (Crypto.HD.xprv bs) + eitherDeserialiseFromRawBytes (AsSigningKey AsStakeExtendedKey) bs = + first (\msg -> SerialiseAsRawBytesError ("Unable to deserialise SigningKey StakeExtendedKey: " ++ msg)) $ + StakeExtendedSigningKey <$> Crypto.HD.xprv bs instance SerialiseAsBech32 (VerificationKey StakeExtendedKey) where bech32PrefixFor _ = "stake_xvk" @@ -534,8 +549,9 @@ instance SerialiseAsRawBytes (Hash StakeExtendedKey) where serialiseToRawBytes (StakeExtendedKeyHash (Shelley.KeyHash vkh)) = Crypto.hashToBytes vkh - deserialiseFromRawBytes (AsHash AsStakeExtendedKey) bs = - StakeExtendedKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs + eitherDeserialiseFromRawBytes (AsHash AsStakeExtendedKey) bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash StakeExtendedKey") $ + StakeExtendedKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs instance HasTextEnvelope (VerificationKey StakeExtendedKey) where textEnvelopeType _ = "StakeExtendedVerificationKeyShelley_ed25519_bip32" @@ -605,16 +621,18 @@ instance SerialiseAsRawBytes (VerificationKey GenesisKey) where serialiseToRawBytes (GenesisVerificationKey (Shelley.VKey vk)) = Crypto.rawSerialiseVerKeyDSIGN vk - deserialiseFromRawBytes (AsVerificationKey AsGenesisKey) bs = - GenesisVerificationKey . Shelley.VKey <$> - Crypto.rawDeserialiseVerKeyDSIGN bs + eitherDeserialiseFromRawBytes (AsVerificationKey AsGenesisKey) bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise VerificationKey GenesisKey") $ + GenesisVerificationKey . Shelley.VKey <$> + Crypto.rawDeserialiseVerKeyDSIGN bs instance SerialiseAsRawBytes (SigningKey GenesisKey) where serialiseToRawBytes (GenesisSigningKey sk) = Crypto.rawSerialiseSignKeyDSIGN sk - deserialiseFromRawBytes (AsSigningKey AsGenesisKey) bs = - GenesisSigningKey <$> Crypto.rawDeserialiseSignKeyDSIGN bs + eitherDeserialiseFromRawBytes (AsSigningKey AsGenesisKey) bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise SigningKey GenesisKey") $ + GenesisSigningKey <$> Crypto.rawDeserialiseSignKeyDSIGN bs newtype instance Hash GenesisKey = @@ -628,8 +646,9 @@ instance SerialiseAsRawBytes (Hash GenesisKey) where serialiseToRawBytes (GenesisKeyHash (Shelley.KeyHash vkh)) = Crypto.hashToBytes vkh - deserialiseFromRawBytes (AsHash AsGenesisKey) bs = - GenesisKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs + eitherDeserialiseFromRawBytes (AsHash AsGenesisKey) bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash GenesisKey") $ + GenesisKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs instance HasTextEnvelope (VerificationKey GenesisKey) where textEnvelopeType _ = "GenesisVerificationKey_" @@ -739,17 +758,17 @@ instance SerialiseAsRawBytes (VerificationKey GenesisExtendedKey) where serialiseToRawBytes (GenesisExtendedVerificationKey xpub) = Crypto.HD.unXPub xpub - deserialiseFromRawBytes (AsVerificationKey AsGenesisExtendedKey) bs = - either (const Nothing) (Just . GenesisExtendedVerificationKey) - (Crypto.HD.xpub bs) + eitherDeserialiseFromRawBytes (AsVerificationKey AsGenesisExtendedKey) bs = + first (const (SerialiseAsRawBytesError "Unable to deserialise VerificationKey GenesisExtendedKey")) $ + GenesisExtendedVerificationKey<$> Crypto.HD.xpub bs instance SerialiseAsRawBytes (SigningKey GenesisExtendedKey) where serialiseToRawBytes (GenesisExtendedSigningKey xprv) = Crypto.HD.unXPrv xprv - deserialiseFromRawBytes (AsSigningKey AsGenesisExtendedKey) bs = - either (const Nothing) (Just . GenesisExtendedSigningKey) - (Crypto.HD.xprv bs) + eitherDeserialiseFromRawBytes (AsSigningKey AsGenesisExtendedKey) bs = + first (\msg -> SerialiseAsRawBytesError ("Unable to deserialise SigningKey GenesisExtendedKey" ++ msg)) $ + GenesisExtendedSigningKey <$> Crypto.HD.xprv bs newtype instance Hash GenesisExtendedKey = @@ -763,8 +782,9 @@ instance SerialiseAsRawBytes (Hash GenesisExtendedKey) where serialiseToRawBytes (GenesisExtendedKeyHash (Shelley.KeyHash vkh)) = Crypto.hashToBytes vkh - deserialiseFromRawBytes (AsHash AsGenesisExtendedKey) bs = - GenesisExtendedKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs + eitherDeserialiseFromRawBytes (AsHash AsGenesisExtendedKey) bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash GenesisExtendedKey") $ + GenesisExtendedKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs instance HasTextEnvelope (VerificationKey GenesisExtendedKey) where textEnvelopeType _ = "GenesisExtendedVerificationKey_ed25519_bip32" @@ -835,7 +855,8 @@ instance SerialiseAsRawBytes (VerificationKey GenesisDelegateKey) where serialiseToRawBytes (GenesisDelegateVerificationKey (Shelley.VKey vk)) = Crypto.rawSerialiseVerKeyDSIGN vk - deserialiseFromRawBytes (AsVerificationKey AsGenesisDelegateKey) bs = + eitherDeserialiseFromRawBytes (AsVerificationKey AsGenesisDelegateKey) bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise VerificationKey GenesisDelegateKey") $ GenesisDelegateVerificationKey . Shelley.VKey <$> Crypto.rawDeserialiseVerKeyDSIGN bs @@ -843,8 +864,9 @@ instance SerialiseAsRawBytes (SigningKey GenesisDelegateKey) where serialiseToRawBytes (GenesisDelegateSigningKey sk) = Crypto.rawSerialiseSignKeyDSIGN sk - deserialiseFromRawBytes (AsSigningKey AsGenesisDelegateKey) bs = - GenesisDelegateSigningKey <$> Crypto.rawDeserialiseSignKeyDSIGN bs + eitherDeserialiseFromRawBytes (AsSigningKey AsGenesisDelegateKey) bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise SigningKey GenesisDelegateKey") $ + GenesisDelegateSigningKey <$> Crypto.rawDeserialiseSignKeyDSIGN bs newtype instance Hash GenesisDelegateKey = @@ -858,8 +880,9 @@ instance SerialiseAsRawBytes (Hash GenesisDelegateKey) where serialiseToRawBytes (GenesisDelegateKeyHash (Shelley.KeyHash vkh)) = Crypto.hashToBytes vkh - deserialiseFromRawBytes (AsHash AsGenesisDelegateKey) bs = - GenesisDelegateKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs + eitherDeserialiseFromRawBytes (AsHash AsGenesisDelegateKey) bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash GenesisDelegateKey") $ + GenesisDelegateKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs instance HasTextEnvelope (VerificationKey GenesisDelegateKey) where textEnvelopeType _ = "GenesisDelegateVerificationKey_" @@ -973,17 +996,17 @@ instance SerialiseAsRawBytes (VerificationKey GenesisDelegateExtendedKey) where serialiseToRawBytes (GenesisDelegateExtendedVerificationKey xpub) = Crypto.HD.unXPub xpub - deserialiseFromRawBytes (AsVerificationKey AsGenesisDelegateExtendedKey) bs = - either (const Nothing) (Just . GenesisDelegateExtendedVerificationKey) - (Crypto.HD.xpub bs) + eitherDeserialiseFromRawBytes (AsVerificationKey AsGenesisDelegateExtendedKey) bs = + first (\msg -> SerialiseAsRawBytesError ("Unable to deserialise VerificationKey GenesisDelegateExtendedKey: " ++ msg)) $ + GenesisDelegateExtendedVerificationKey <$> Crypto.HD.xpub bs instance SerialiseAsRawBytes (SigningKey GenesisDelegateExtendedKey) where serialiseToRawBytes (GenesisDelegateExtendedSigningKey xprv) = Crypto.HD.unXPrv xprv - deserialiseFromRawBytes (AsSigningKey AsGenesisDelegateExtendedKey) bs = - either (const Nothing) (Just . GenesisDelegateExtendedSigningKey) - (Crypto.HD.xprv bs) + eitherDeserialiseFromRawBytes (AsSigningKey AsGenesisDelegateExtendedKey) bs = + first (\msg -> SerialiseAsRawBytesError ("Unable to deserialise SigningKey GenesisDelegateExtendedKey: " ++ msg)) $ + GenesisDelegateExtendedSigningKey <$> Crypto.HD.xprv bs newtype instance Hash GenesisDelegateExtendedKey = @@ -997,8 +1020,9 @@ instance SerialiseAsRawBytes (Hash GenesisDelegateExtendedKey) where serialiseToRawBytes (GenesisDelegateExtendedKeyHash (Shelley.KeyHash vkh)) = Crypto.hashToBytes vkh - deserialiseFromRawBytes (AsHash AsGenesisDelegateExtendedKey) bs = - GenesisDelegateExtendedKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs + eitherDeserialiseFromRawBytes (AsHash AsGenesisDelegateExtendedKey) bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash GenesisDelegateExtendedKey: ") $ + GenesisDelegateExtendedKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs instance HasTextEnvelope (VerificationKey GenesisDelegateExtendedKey) where textEnvelopeType _ = "GenesisDelegateExtendedVerificationKey_ed25519_bip32" @@ -1069,16 +1093,17 @@ instance SerialiseAsRawBytes (VerificationKey GenesisUTxOKey) where serialiseToRawBytes (GenesisUTxOVerificationKey (Shelley.VKey vk)) = Crypto.rawSerialiseVerKeyDSIGN vk - deserialiseFromRawBytes (AsVerificationKey AsGenesisUTxOKey) bs = - GenesisUTxOVerificationKey . Shelley.VKey <$> - Crypto.rawDeserialiseVerKeyDSIGN bs + eitherDeserialiseFromRawBytes (AsVerificationKey AsGenesisUTxOKey) bs = + maybeToRight (SerialiseAsRawBytesError "Enable to deserialise VerificationKey GenesisUTxOKey") $ + GenesisUTxOVerificationKey . Shelley.VKey <$> Crypto.rawDeserialiseVerKeyDSIGN bs instance SerialiseAsRawBytes (SigningKey GenesisUTxOKey) where serialiseToRawBytes (GenesisUTxOSigningKey sk) = Crypto.rawSerialiseSignKeyDSIGN sk - deserialiseFromRawBytes (AsSigningKey AsGenesisUTxOKey) bs = - GenesisUTxOSigningKey <$> Crypto.rawDeserialiseSignKeyDSIGN bs + eitherDeserialiseFromRawBytes (AsSigningKey AsGenesisUTxOKey) bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise SigningKey GenesisUTxOKey") $ + GenesisUTxOSigningKey <$> Crypto.rawDeserialiseSignKeyDSIGN bs newtype instance Hash GenesisUTxOKey = @@ -1092,8 +1117,9 @@ instance SerialiseAsRawBytes (Hash GenesisUTxOKey) where serialiseToRawBytes (GenesisUTxOKeyHash (Shelley.KeyHash vkh)) = Crypto.hashToBytes vkh - deserialiseFromRawBytes (AsHash AsGenesisUTxOKey) bs = - GenesisUTxOKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs + eitherDeserialiseFromRawBytes (AsHash AsGenesisUTxOKey) bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash GenesisUTxOKey") $ + GenesisUTxOKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs instance HasTextEnvelope (VerificationKey GenesisUTxOKey) where textEnvelopeType _ = "GenesisUTxOVerificationKey_" @@ -1168,16 +1194,20 @@ instance SerialiseAsRawBytes (VerificationKey StakePoolKey) where serialiseToRawBytes (StakePoolVerificationKey (Shelley.VKey vk)) = Crypto.rawSerialiseVerKeyDSIGN vk - deserialiseFromRawBytes (AsVerificationKey AsStakePoolKey) bs = - StakePoolVerificationKey . Shelley.VKey <$> - Crypto.rawDeserialiseVerKeyDSIGN bs + eitherDeserialiseFromRawBytes (AsVerificationKey AsStakePoolKey) bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise VerificationKey StakePoolKey") $ + StakePoolVerificationKey . Shelley.VKey <$> + Crypto.rawDeserialiseVerKeyDSIGN bs instance SerialiseAsRawBytes (SigningKey StakePoolKey) where serialiseToRawBytes (StakePoolSigningKey sk) = Crypto.rawSerialiseSignKeyDSIGN sk - deserialiseFromRawBytes (AsSigningKey AsStakePoolKey) bs = - StakePoolSigningKey <$> Crypto.rawDeserialiseSignKeyDSIGN bs + eitherDeserialiseFromRawBytes (AsSigningKey AsStakePoolKey) bs = + maybe + (Left (SerialiseAsRawBytesError "Unable to deserialise SigningKey StakePoolKey")) + (Right . StakePoolSigningKey) + (Crypto.rawDeserialiseSignKeyDSIGN bs) instance SerialiseAsBech32 (VerificationKey StakePoolKey) where bech32PrefixFor _ = "pool_vk" @@ -1198,8 +1228,10 @@ instance SerialiseAsRawBytes (Hash StakePoolKey) where serialiseToRawBytes (StakePoolKeyHash (Shelley.KeyHash vkh)) = Crypto.hashToBytes vkh - deserialiseFromRawBytes (AsHash AsStakePoolKey) bs = - StakePoolKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs + eitherDeserialiseFromRawBytes (AsHash AsStakePoolKey) bs = + maybeToRight + (SerialiseAsRawBytesError "Unable to deserialise Hash StakePoolKey") + (StakePoolKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs) instance SerialiseAsBech32 (Hash StakePoolKey) where bech32PrefixFor _ = "pool" diff --git a/cardano-api/src/Cardano/Api/ProtocolParameters.hs b/cardano-api/src/Cardano/Api/ProtocolParameters.hs index ced0c41ab60..dedd8d3edaa 100644 --- a/cardano-api/src/Cardano/Api/ProtocolParameters.hs +++ b/cardano-api/src/Cardano/Api/ProtocolParameters.hs @@ -71,6 +71,7 @@ import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, (.! (.=)) import Data.Bifunctor (bimap, first) import Data.ByteString (ByteString) +import Data.Either.Combinators (maybeToRight) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.Maybe (fromMaybe, isJust) @@ -688,8 +689,9 @@ instance SerialiseAsRawBytes PraosNonce where serialiseToRawBytes (PraosNonce h) = Crypto.hashToBytes h - deserialiseFromRawBytes AsPraosNonce bs = - PraosNonce <$> Crypto.hashFromBytes bs + eitherDeserialiseFromRawBytes AsPraosNonce bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise PraosNonce") $ + PraosNonce <$> Crypto.hashFromBytes bs makePraosNonce :: ByteString -> PraosNonce diff --git a/cardano-api/src/Cardano/Api/Query.hs b/cardano-api/src/Cardano/Api/Query.hs index 18220658572..7f993250491 100644 --- a/cardano-api/src/Cardano/Api/Query.hs +++ b/cardano-api/src/Cardano/Api/Query.hs @@ -72,6 +72,7 @@ import qualified Data.Aeson as Aeson import Data.Aeson.Types (Parser) import Data.Bifunctor (bimap, first) import qualified Data.ByteString.Lazy as LBS +import Data.Either.Combinators (rightToMaybe) import qualified Data.HashMap.Strict as HMS import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map @@ -415,7 +416,7 @@ toShelleyAddrSet era = -- Ignore any addresses that are not appropriate for the era, -- e.g. Shelley addresses in the Byron era, as these would not -- appear in the UTxO anyway. - . mapMaybe (anyAddressInEra era) + . mapMaybe (rightToMaybe . anyAddressInEra era) . Set.toList diff --git a/cardano-api/src/Cardano/Api/Script.hs b/cardano-api/src/Cardano/Api/Script.hs index 61617dee343..35522bb6ca8 100644 --- a/cardano-api/src/Cardano/Api/Script.hs +++ b/cardano-api/src/Cardano/Api/Script.hs @@ -115,6 +115,7 @@ import Prelude import qualified Data.ByteString.Lazy as LBS import Data.ByteString.Short (ShortByteString) import qualified Data.ByteString.Short as SBS +import Data.Either.Combinators (maybeToRight) import Data.Foldable (toList) import Data.Scientific (toBoundedInteger) import Data.String (IsString) @@ -936,8 +937,9 @@ instance SerialiseAsRawBytes ScriptHash where serialiseToRawBytes (ScriptHash (Shelley.ScriptHash h)) = Crypto.hashToBytes h - deserialiseFromRawBytes AsScriptHash bs = - ScriptHash . Shelley.ScriptHash <$> Crypto.hashFromBytes bs + eitherDeserialiseFromRawBytes AsScriptHash bs = + maybeToRight (SerialiseAsRawBytesError "Enable to deserialise ScriptHash") $ + ScriptHash . Shelley.ScriptHash <$> Crypto.hashFromBytes bs hashScript :: Script lang -> ScriptHash @@ -1076,9 +1078,9 @@ instance HasTypeProxy lang => HasTypeProxy (PlutusScript lang) where instance (HasTypeProxy lang, Typeable lang) => SerialiseAsRawBytes (PlutusScript lang) where serialiseToRawBytes (PlutusScriptSerialised sbs) = SBS.fromShort sbs - deserialiseFromRawBytes (AsPlutusScript _) bs = + eitherDeserialiseFromRawBytes (AsPlutusScript _) bs = -- TODO alonzo: validate the script syntax and fail decoding if invalid - Just (PlutusScriptSerialised (SBS.toShort bs)) + Right (PlutusScriptSerialised (SBS.toShort bs)) instance (IsPlutusScriptLanguage lang, Typeable lang) => HasTextEnvelope (PlutusScript lang) where diff --git a/cardano-api/src/Cardano/Api/ScriptData.hs b/cardano-api/src/Cardano/Api/ScriptData.hs index 12a2115069e..54cfa2d0ced 100644 --- a/cardano-api/src/Cardano/Api/ScriptData.hs +++ b/cardano-api/src/Cardano/Api/ScriptData.hs @@ -43,6 +43,7 @@ import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Char8 as BSC import qualified Data.ByteString.Lazy.Char8 as LBS import qualified Data.Char as Char +import Data.Either.Combinators import qualified Data.List as List import Data.Maybe (fromMaybe) import qualified Data.Scientific as Scientific @@ -70,8 +71,8 @@ import qualified Plutus.V1.Ledger.Api as Plutus import Cardano.Api.Eras import Cardano.Api.Error -import Cardano.Api.HasTypeProxy import Cardano.Api.Hash +import Cardano.Api.HasTypeProxy import Cardano.Api.KeysShelley import Cardano.Api.SerialiseCBOR import Cardano.Api.SerialiseJSON @@ -117,8 +118,9 @@ instance SerialiseAsRawBytes (Hash ScriptData) where serialiseToRawBytes (ScriptDataHash dh) = Crypto.hashToBytes (Ledger.extractHash dh) - deserialiseFromRawBytes (AsHash AsScriptData) bs = - ScriptDataHash . Ledger.unsafeMakeSafeHash <$> Crypto.hashFromBytes bs + eitherDeserialiseFromRawBytes (AsHash AsScriptData) bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash ScriptData") $ + ScriptDataHash . Ledger.unsafeMakeSafeHash <$> Crypto.hashFromBytes bs instance SerialiseAsCBOR ScriptData where serialiseToCBOR = CBOR.serialize' diff --git a/cardano-api/src/Cardano/Api/SerialiseBech32.hs b/cardano-api/src/Cardano/Api/SerialiseBech32.hs index 66eb8b912e9..ade606b180b 100644 --- a/cardano-api/src/Cardano/Api/SerialiseBech32.hs +++ b/cardano-api/src/Cardano/Api/SerialiseBech32.hs @@ -16,8 +16,8 @@ import Data.ByteString (ByteString) import Data.Text (Text) import qualified Data.List as List -import qualified Data.Set as Set import Data.Set (Set) +import qualified Data.Set as Set import Control.Monad (guard) @@ -68,8 +68,9 @@ deserialiseFromBech32 asType bech32Str = do payload <- Bech32.dataPartToBytes dataPart ?! Bech32DataPartToBytesError (Bech32.dataPartToText dataPart) - value <- deserialiseFromRawBytes asType payload - ?! Bech32DeserialiseFromBytesError payload + value <- case eitherDeserialiseFromRawBytes asType payload of + Right a -> Right a + Left _ -> Left $ Bech32DeserialiseFromBytesError payload let expectedPrefix = bech32PrefixFor value guard (actualPrefix == expectedPrefix) @@ -96,8 +97,9 @@ deserialiseAnyOfFromBech32 types bech32Str = do payload <- Bech32.dataPartToBytes dataPart ?! Bech32DataPartToBytesError (Bech32.dataPartToText dataPart) - value <- deserialiseFromRawBytes actualType payload - ?! Bech32DeserialiseFromBytesError payload + value <- case eitherDeserialiseFromRawBytes actualType payload of + Right a -> Right a + Left _ -> Left $ Bech32DeserialiseFromBytesError payload let expectedPrefix = bech32PrefixFor value guard (actualPrefix == expectedPrefix) diff --git a/cardano-api/src/Cardano/Api/SerialiseRaw.hs b/cardano-api/src/Cardano/Api/SerialiseRaw.hs index bc02e5d5dd1..eec2b53dbc8 100644 --- a/cardano-api/src/Cardano/Api/SerialiseRaw.hs +++ b/cardano-api/src/Cardano/Api/SerialiseRaw.hs @@ -6,6 +6,7 @@ module Cardano.Api.SerialiseRaw ( RawBytesHexError(..) , SerialiseAsRawBytes(..) + , SerialiseAsRawBytesError(..) , serialiseToRawBytesHex , deserialiseFromRawBytesHex , serialiseToRawBytesHexText @@ -21,11 +22,20 @@ import qualified Data.Text.Encoding as Text import Cardano.Api.Error (Error, displayError) import Cardano.Api.HasTypeProxy +newtype SerialiseAsRawBytesError = SerialiseAsRawBytesError + -- TODO We can do better than use String to carry the error message + { unSerialiseAsRawBytesError :: String + } + deriving (Eq, Show) + class (HasTypeProxy a, Typeable a) => SerialiseAsRawBytes a where serialiseToRawBytes :: a -> ByteString deserialiseFromRawBytes :: AsType a -> ByteString -> Maybe a + deserialiseFromRawBytes asType bs = rightToMaybe $ eitherDeserialiseFromRawBytes asType bs + + eitherDeserialiseFromRawBytes :: AsType a -> ByteString -> Either SerialiseAsRawBytesError a serialiseToRawBytesHex :: SerialiseAsRawBytes a => a -> ByteString serialiseToRawBytesHex = Base16.encode . serialiseToRawBytes @@ -39,8 +49,9 @@ data RawBytesHexError ByteString -- ^ original input String -- ^ error message | RawBytesHexErrorRawBytesDecodeFail - ByteString -- ^ original input - TypeRep -- ^ expected type + ByteString -- ^ original input + TypeRep -- ^ expected type + SerialiseAsRawBytesError -- ^ error message deriving (Show) instance Error RawBytesHexError where @@ -48,8 +59,8 @@ instance Error RawBytesHexError where RawBytesHexErrorBase16DecodeFail input message -> "Expected Base16-encoded bytestring, but got " ++ pretty input ++ "; " ++ message - RawBytesHexErrorRawBytesDecodeFail input asType -> - "Failed to deserialise " ++ pretty input ++ " as " ++ show asType + RawBytesHexErrorRawBytesDecodeFail input asType (SerialiseAsRawBytesError e) -> + "Failed to deserialise " ++ pretty input ++ " as " ++ show asType ++ ". " ++ e where pretty bs = case Text.decodeUtf8' bs of Right t -> Text.unpack t @@ -60,5 +71,6 @@ deserialiseFromRawBytesHex => AsType a -> ByteString -> Either RawBytesHexError a deserialiseFromRawBytesHex proxy hex = do raw <- first (RawBytesHexErrorBase16DecodeFail hex) $ Base16.decode hex - maybe (Left $ RawBytesHexErrorRawBytesDecodeFail hex $ typeRep proxy) Right $ - deserialiseFromRawBytes proxy raw + case eitherDeserialiseFromRawBytes proxy raw of + Left e -> Left $ RawBytesHexErrorRawBytesDecodeFail hex (typeRep proxy) e + Right a -> Right a diff --git a/cardano-api/src/Cardano/Api/SerialiseUsing.hs b/cardano-api/src/Cardano/Api/SerialiseUsing.hs index 9855b36fd77..513e7457ba5 100644 --- a/cardano-api/src/Cardano/Api/SerialiseUsing.hs +++ b/cardano-api/src/Cardano/Api/SerialiseUsing.hs @@ -41,9 +41,9 @@ instance (SerialiseAsRawBytes a, Typeable a) => ToCBOR (UsingRawBytes a) where instance (SerialiseAsRawBytes a, Typeable a) => FromCBOR (UsingRawBytes a) where fromCBOR = do bs <- fromCBOR - case deserialiseFromRawBytes ttoken bs of - Just x -> return (UsingRawBytes x) - Nothing -> fail ("cannot deserialise as a " ++ tname) + case eitherDeserialiseFromRawBytes ttoken bs of + Right x -> return (UsingRawBytes x) + Left (SerialiseAsRawBytesError msg) -> fail ("cannot deserialise as a " ++ tname ++ ". The error was: " ++ msg) where ttoken = proxyToAsType (Proxy :: Proxy a) tname = (tyConName . typeRepTyCon . typeRep) (Proxy :: Proxy a) @@ -90,9 +90,9 @@ deserialiseFromRawBytesBase16 :: SerialiseAsRawBytes a => ByteString -> Either String (UsingRawBytesHex a) deserialiseFromRawBytesBase16 str = case Base16.decode str of - Right raw -> case deserialiseFromRawBytes ttoken raw of - Just x -> Right (UsingRawBytesHex x) - Nothing -> Left ("cannot deserialise " ++ show str) + Right raw -> case eitherDeserialiseFromRawBytes ttoken raw of + Right x -> Right (UsingRawBytesHex x) + Left (SerialiseAsRawBytesError msg) -> Left ("cannot deserialise " ++ show str ++ ". The error was: " <> msg) Left msg -> Left ("invalid hex " ++ show str ++ ", " ++ msg) where ttoken = proxyToAsType (Proxy :: Proxy a) diff --git a/cardano-api/src/Cardano/Api/SpecialByron.hs b/cardano-api/src/Cardano/Api/SpecialByron.hs index fe5a6f0008d..bbccee64c11 100644 --- a/cardano-api/src/Cardano/Api/SpecialByron.hs +++ b/cardano-api/src/Cardano/Api/SpecialByron.hs @@ -32,9 +32,9 @@ import qualified Cardano.Binary as Binary import Cardano.Chain.Common (LovelacePortion, TxFeePolicy) import Cardano.Chain.Slotting import Cardano.Chain.Update (AProposal (aBody, annotation), InstallerHash, - ProposalBody (ProposalBody), ProtocolParametersUpdate (..), ProtocolVersion, - SoftforkRule, SoftwareVersion, SystemTag, UpId, mkVote, recoverUpId, - recoverVoteId, signProposal) + ProposalBody (ProposalBody), ProtocolParametersUpdate (..), ProtocolVersion, + SoftforkRule, SoftwareVersion, SystemTag, UpId, mkVote, recoverUpId, + recoverVoteId, signProposal) import qualified Cardano.Chain.Update.Vote as ByronVote import Cardano.Crypto (SafeSigner, noPassSafeSigner) @@ -55,11 +55,11 @@ instance HasTypeProxy ByronUpdateProposal where instance SerialiseAsRawBytes ByronUpdateProposal where serialiseToRawBytes (ByronUpdateProposal proposal) = annotation proposal - deserialiseFromRawBytes AsByronUpdateProposal bs = + eitherDeserialiseFromRawBytes AsByronUpdateProposal bs = let lBs = LB.fromStrict bs in case Binary.decodeFull lBs of - Left _deserFail -> Nothing - Right proposal -> Just (ByronUpdateProposal proposal') + Left e -> Left $ SerialiseAsRawBytesError $ "Unable to deserialise ByronUpdateProposal: " <> show e + Right proposal -> Right (ByronUpdateProposal proposal') where proposal' :: AProposal ByteString proposal' = Binary.annotationBytes lBs proposal @@ -168,11 +168,11 @@ instance HasTypeProxy ByronVote where instance SerialiseAsRawBytes ByronVote where serialiseToRawBytes (ByronVote vote) = Binary.serialize' $ fmap (const ()) vote - deserialiseFromRawBytes AsByronVote bs = + eitherDeserialiseFromRawBytes AsByronVote bs = let lBs = LB.fromStrict bs in case Binary.decodeFull lBs of - Left _deserFail -> Nothing - Right vote -> Just . ByronVote $ annotateVote vote lBs + Left e -> Left $ SerialiseAsRawBytesError $ "Unable to deserialise ByronVote: " <> show e + Right vote -> Right . ByronVote $ annotateVote vote lBs where annotateVote :: ByronVote.AVote Binary.ByteSpan -> LB.ByteString -> ByronVote.AVote ByteString annotateVote vote bs' = Binary.annotationBytes bs' vote diff --git a/cardano-api/src/Cardano/Api/StakePoolMetadata.hs b/cardano-api/src/Cardano/Api/StakePoolMetadata.hs index 8c214e8c73a..fbac4335b0a 100644 --- a/cardano-api/src/Cardano/Api/StakePoolMetadata.hs +++ b/cardano-api/src/Cardano/Api/StakePoolMetadata.hs @@ -19,6 +19,7 @@ import Prelude import Data.Bifunctor (first) import Data.ByteString (ByteString) import qualified Data.ByteString as BS +import Data.Either.Combinators (maybeToRight) import Data.Text (Text) import qualified Data.Text as Text @@ -79,8 +80,9 @@ instance HasTypeProxy StakePoolMetadata where instance SerialiseAsRawBytes (Hash StakePoolMetadata) where serialiseToRawBytes (StakePoolMetadataHash h) = Crypto.hashToBytes h - deserialiseFromRawBytes (AsHash AsStakePoolMetadata) bs = - StakePoolMetadataHash <$> Crypto.hashFromBytes bs + eitherDeserialiseFromRawBytes (AsHash AsStakePoolMetadata) bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash StakePoolMetadata") $ + StakePoolMetadataHash <$> Crypto.hashFromBytes bs --TODO: instance ToJSON StakePoolMetadata where diff --git a/cardano-api/src/Cardano/Api/TxIn.hs b/cardano-api/src/Cardano/Api/TxIn.hs index 54ed950703f..f28b01ad870 100644 --- a/cardano-api/src/Cardano/Api/TxIn.hs +++ b/cardano-api/src/Cardano/Api/TxIn.hs @@ -46,8 +46,8 @@ import qualified Data.ByteString.Char8 as BSC import Data.String import Data.Text (Text) import qualified Data.Text as Text -import Text.Parsec (()) import qualified Text.Parsec as Parsec +import Text.Parsec (()) import qualified Text.Parsec.Language as Parsec import qualified Text.Parsec.String as Parsec import qualified Text.Parsec.Token as Parsec @@ -92,7 +92,9 @@ instance HasTypeProxy TxId where instance SerialiseAsRawBytes TxId where serialiseToRawBytes (TxId h) = Crypto.hashToBytes h - deserialiseFromRawBytes AsTxId bs = TxId <$> Crypto.hashFromBytes bs + eitherDeserialiseFromRawBytes AsTxId bs = case Crypto.hashFromBytes bs of + Just a -> Right (TxId a) + Nothing -> Left $ SerialiseAsRawBytesError "Unable to deserialise TxId" toByronTxId :: TxId -> Byron.TxId toByronTxId (TxId h) = diff --git a/cardano-api/src/Cardano/Api/Value.hs b/cardano-api/src/Cardano/Api/Value.hs index 379b19dcdd2..0316b653d72 100644 --- a/cardano-api/src/Cardano/Api/Value.hs +++ b/cardano-api/src/Cardano/Api/Value.hs @@ -154,8 +154,8 @@ instance HasTypeProxy PolicyId where instance SerialiseAsRawBytes PolicyId where serialiseToRawBytes (PolicyId sh) = serialiseToRawBytes sh - deserialiseFromRawBytes AsPolicyId bs = - PolicyId <$> deserialiseFromRawBytes AsScriptHash bs + eitherDeserialiseFromRawBytes AsPolicyId bs = + PolicyId <$> eitherDeserialiseFromRawBytes AsScriptHash bs scriptPolicyId :: Script lang -> PolicyId scriptPolicyId = PolicyId . hashScript @@ -179,9 +179,11 @@ instance HasTypeProxy AssetName where instance SerialiseAsRawBytes AssetName where serialiseToRawBytes (AssetName bs) = bs - deserialiseFromRawBytes AsAssetName bs - | BS.length bs <= 32 = Just (AssetName bs) - | otherwise = Nothing + eitherDeserialiseFromRawBytes AsAssetName bs + | BS.length bs <= 32 = Right (AssetName bs) + | otherwise = Left $ SerialiseAsRawBytesError $ + "Unable to deserialise AssetName (the bytestring should be no longer than 32 bytes long " <> + "which corresponds to a hex representation of 64 characters)" data AssetId = AdaAssetId diff --git a/cardano-api/test/Test/Cardano/Api/Typed/RawBytes.hs b/cardano-api/test/Test/Cardano/Api/Typed/RawBytes.hs index e7904bb4857..3556984f4ee 100644 --- a/cardano-api/test/Test/Cardano/Api/Typed/RawBytes.hs +++ b/cardano-api/test/Test/Cardano/Api/Typed/RawBytes.hs @@ -80,7 +80,7 @@ roundtrip_raw_bytes roundtrip_raw_bytes asType g = H.property $ do v <- H.forAll g - H.tripping v serialiseToRawBytes (deserialiseFromRawBytes asType) + H.tripping v serialiseToRawBytes (eitherDeserialiseFromRawBytes asType) roundtrip_verification_key_hash_raw :: (Key keyrole, Eq (Hash keyrole), Show (Hash keyrole)) @@ -89,7 +89,7 @@ roundtrip_verification_key_hash_raw roletoken = H.property $ do vKey <- H.forAll $ genVerificationKey roletoken let vKeyHash = verificationKeyHash vKey - H.tripping vKeyHash serialiseToRawBytes (deserialiseFromRawBytes (AsHash roletoken)) + H.tripping vKeyHash serialiseToRawBytes (eitherDeserialiseFromRawBytes (AsHash roletoken)) -- ----------------------------------------------------------------------------- diff --git a/cardano-cli/src/Cardano/CLI/Byron/Key.hs b/cardano-cli/src/Cardano/CLI/Byron/Key.hs index 1db5bb4c997..0fef29da98b 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Key.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Key.hs @@ -86,13 +86,13 @@ readByronSigningKey bKeyFormat (SigningKeyFile fp) = do sK <- handleIOExceptT (ReadSigningKeyFailure fp . T.pack . displayException) $ SB.readFile fp case bKeyFormat of LegacyByronKeyFormat -> - case deserialiseFromRawBytes (AsSigningKey AsByronKeyLegacy) sK of - Just legKey -> right $ AByronSigningKeyLegacy legKey - Nothing -> left $ LegacySigningKeyDeserialisationFailed fp + case eitherDeserialiseFromRawBytes (AsSigningKey AsByronKeyLegacy) sK of + Right legKey -> right $ AByronSigningKeyLegacy legKey + Left _ -> left $ LegacySigningKeyDeserialisationFailed fp NonLegacyByronKeyFormat -> - case deserialiseFromRawBytes (AsSigningKey AsByronKey) sK of - Just nonLegSKey -> right $ AByronSigningKey nonLegSKey - Nothing -> left $ SigningKeyDeserialisationFailed fp + case eitherDeserialiseFromRawBytes (AsSigningKey AsByronKey) sK of + Right nonLegSKey -> right $ AByronSigningKey nonLegSKey + Left _ -> left $ SigningKeyDeserialisationFailed fp -- | Read verification key from a file. Throw an error if the file can't be read -- or the key fails to deserialise. diff --git a/cardano-cli/src/Cardano/CLI/Byron/UpdateProposal.hs b/cardano-cli/src/Cardano/CLI/Byron/UpdateProposal.hs index c77f3c6db12..70a134bfc02 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/UpdateProposal.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/UpdateProposal.hs @@ -77,8 +77,8 @@ readByronUpdateProposal :: FilePath -> ExceptT ByronUpdateProposalError IO Byron readByronUpdateProposal fp = do proposalBs <- handleIOExceptT (ByronReadUpdateProposalFileFailure fp . toS . displayException) $ BS.readFile fp - let mProposal = deserialiseFromRawBytes AsByronUpdateProposal proposalBs - hoistEither $ maybe (Left $ UpdateProposalDecodingError fp) Right mProposal + let proposalResult = eitherDeserialiseFromRawBytes AsByronUpdateProposal proposalBs + hoistEither $ first (const (UpdateProposalDecodingError fp)) proposalResult submitByronUpdateProposal :: NetworkId diff --git a/cardano-cli/src/Cardano/CLI/Byron/Vote.hs b/cardano-cli/src/Cardano/CLI/Byron/Vote.hs index cfe42c92788..e578987ae81 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Vote.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Vote.hs @@ -18,7 +18,7 @@ import qualified Data.Text as Text import qualified Cardano.Binary as Binary import Cardano.CLI.Byron.UpdateProposal (ByronUpdateProposalError, - readByronUpdateProposal) + readByronUpdateProposal) import Ouroboros.Consensus.Ledger.SupportsMempool (txId) import Ouroboros.Consensus.Util.Condense (condense) @@ -83,5 +83,5 @@ submitByronVote network voteFp = do readByronVote :: FilePath -> ExceptT ByronVoteError IO ByronVote readByronVote fp = do voteBs <- liftIO $ BS.readFile fp - let mVote = deserialiseFromRawBytes AsByronVote voteBs - hoistEither $ maybe (Left $ ByronVoteDecodingError fp) Right mVote + let voteResult = eitherDeserialiseFromRawBytes AsByronVote voteBs + hoistEither $ first (const (ByronVoteDecodingError fp)) voteResult diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs index a48d56682b1..eeeee81ddeb 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs @@ -726,8 +726,8 @@ runTxBuild era (AnyConsensusModeParams cModeParams) networkId mScriptValidity . hoistEither $ notScriptLockedTxIns txinsc nodeEraUTxO let cAddr = case anyAddressInEra era changeAddr of - Just addr -> addr - Nothing -> error $ "runTxBuild: Byron address used: " <> show changeAddr + Right addr -> addr + Left _ -> error $ "runTxBuild: Byron address used: " <> show changeAddr -- Why do we cast the era? The user can specify an era prior to the era that the node is currently in. -- We cannot use the user specified era to construct a query against a node because it may differ diff --git a/cardano-cli/test/Test/Golden/Byron/SigningKeys.hs b/cardano-cli/test/Test/Golden/Byron/SigningKeys.hs index 0987e859a40..5188eaf36c0 100644 --- a/cardano-cli/test/Test/Golden/Byron/SigningKeys.hs +++ b/cardano-cli/test/Test/Golden/Byron/SigningKeys.hs @@ -72,9 +72,9 @@ prop_print_nonLegacy_signing_key_address = propertyOnce $ do prop_generate_and_read_nonlegacy_signingkeys :: Property prop_generate_and_read_nonlegacy_signingkeys = property $ do byronSkey <- liftIO $ generateSigningKey AsByronKey - case deserialiseFromRawBytes (AsSigningKey AsByronKey) (serialiseToRawBytes byronSkey ) of - Nothing -> failWith Nothing "Failed to deserialise non-legacy Byron signing key." - Just _ -> success + case eitherDeserialiseFromRawBytes (AsSigningKey AsByronKey) (serialiseToRawBytes byronSkey) of + Left _ -> failWith Nothing "Failed to deserialise non-legacy Byron signing key. " + Right _ -> success prop_migrate_legacy_to_nonlegacy_signingkeys :: Property prop_migrate_legacy_to_nonlegacy_signingkeys = diff --git a/cardano-node/src/Cardano/Node/Protocol/Byron.hs b/cardano-node/src/Cardano/Node/Protocol/Byron.hs index 140e324f041..75d77eec7ef 100644 --- a/cardano-node/src/Cardano/Node/Protocol/Byron.hs +++ b/cardano-node/src/Cardano/Node/Protocol/Byron.hs @@ -14,8 +14,7 @@ module Cardano.Node.Protocol.Byron import Cardano.Prelude -import Control.Monad.Trans.Except.Extra (bimapExceptT, firstExceptT, hoistEither, - hoistMaybe, left) +import Control.Monad.Trans.Except.Extra (bimapExceptT, firstExceptT, hoistEither, left) import qualified Data.ByteString.Lazy as LB import qualified Data.Text as Text @@ -157,8 +156,9 @@ readLeaderCredentials genesisConfig signingKeyFileBytes <- liftIO $ LB.readFile signingKeyFile delegCertFileBytes <- liftIO $ LB.readFile delegCertFile - ByronSigningKey signingKey <- hoistMaybe (SigningKeyDeserialiseFailure signingKeyFile) - $ deserialiseFromRawBytes (AsSigningKey AsByronKey) $ LB.toStrict signingKeyFileBytes + ByronSigningKey signingKey <- firstExceptT (const (SigningKeyDeserialiseFailure signingKeyFile)) + . hoistEither + $ eitherDeserialiseFromRawBytes (AsSigningKey AsByronKey) $ LB.toStrict signingKeyFileBytes delegCert <- firstExceptT (CanonicalDecodeFailure delegCertFile) . hoistEither $ canonicalDecodePretty delegCertFileBytes