Merge pull request #121 from input-output-hk/rvl/adp-847/either-inspe…

…ct-address

Better error handling for inspectAddress

ChangeLog.md

@@ -1,4 +1,34 @@
-## [3.3.0] - 2021-03-30
+## [3.4.0] - UNRELEASED
+
+### Added
+
+- Added `Cardano.Address.Style.Shelley.eitherInspectAddress` function
+  with stronger result and error types.
+
+- Added `Cardano.Address.Style.Shared` module which define a shared wallet style
+  enabling multisig.
+
+### Changed
+
+- The constructors of `Cardano.Address.Style.Shelley.ErrInspectAddress`
+  have changed.
+  Any code which pattern matches on this type will need minor changes.
+
+- A number of Bech32 prefixes were changed to account for CIP changes.
+  The whole family of `*_shared_*` prefixes were introduced to accommodate
+  newly added shared wallet style. In specific, there in no longer `script_vkh`
+  but `addr_shared_vkh` and `stake_shared_vkh` to denote spending and stake
+  verification key hashes, respectively.
+
+- `KeyHash` now needs `KeyRole` values to specify, except binary payload. It was needed
+  change to enable differentiating between spending and stake key hashes.
+
+### Removed
+
+- Multisig related functions were deleted from `Cardano.Address.Style.Shelley` as they
+  found a new place in `Cardano.Address.Style.Shared`.
+
+## [3.3.0] - 2021-04-09
 
 ### Added
 

command-line/cardano-addresses-cli.cabal

@@ -4,10 +4,10 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: f380e56b6b727ea7067da62533485612742dbbe2d3b2d12b134e7c8b0ed87253
+-- hash: 522505cee4e08f04e60c4ef2d817dcf46b5e24c6cd71853db1ba7797ebc822b0
 
 name:           cardano-addresses-cli
-version:        3.3.0
+version:        3.4.0
 synopsis:       Utils for constructing a command-line on top of cardano-addresses.
 description:    Please see the README on GitHub at <https://github.com/input-output-hk/cardano-addresses>
 category:       Cardano

command-line/package.yaml

@@ -1,5 +1,5 @@
 name:                cardano-addresses-cli
-version:             3.3.0
+version:             3.4.0
 github:              input-output-hk/cardano-addresses
 license:             Apache-2.0
 author:              IOHK

command-line/test/Command/Address/InspectSpec.hs

@@ -52,9 +52,9 @@ spec = describeCmd [ "address", "inspect" ] $ do
         "stake1upshvetj09hxjcm9v9jxgunjv4ehxmr0d3hkcmmvdakx7mqcjv83c"
 
     -- reward account: scripthash28
-    specInspectAddress ["Shelley", "by value", "script_hash"] []
+    specInspectAddress ["Shelley", "by value", "stake_shared_hash"] []
         "stake17pshvetj09hxjcm9v9jxgunjv4ehxmr0d3hkcmmvdakx7mq36s8xc"
-    specInspectAddress ["Shelley", "by value", "script_hash_bech32"] []
+    specInspectAddress ["Shelley", "by value", "stake_shared_hash_bech32"] []
         "stake17pshvetj09hxjcm9v9jxgunjv4ehxmr0d3hkcmmvdakx7mq36s8xc"
 
     -- cardano-cli generated --testnet-magic 42 addresses

core/cardano-addresses.cabal

@@ -4,10 +4,10 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 6e0f1378dee76043634d80088e83aec23f994333a41f0060bd0a36b76f6f322c
+-- hash: 544d2e87cc39554e8ef1cf9ed0304a90282254ca43c254e70eb705a079653923
 
 name:           cardano-addresses
-version:        3.3.0
+version:        3.4.0
 synopsis:       Library utilities for mnemonic generation and address derivation.
 description:    Please see the README on GitHub at <https://github.com/input-output-hk/cardano-addresses>
 category:       Cardano

core/lib/Cardano/Address.hs

@@ -6,6 +6,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TypeFamilies #-}
 
 {-# OPTIONS_HADDOCK prune #-}
@@ -50,6 +51,8 @@ import Control.DeepSeq
     ( NFData )
 import Control.Monad
     ( (<=<) )
+import Data.Aeson
+    ( ToJSON (..), Value (..), object, (.=) )
 import Data.Bits
     ( Bits (testBit) )
 import Data.ByteString
@@ -188,6 +191,13 @@ data ChainPointer = ChainPointer
     } deriving stock (Generic, Show, Eq, Ord)
 instance NFData ChainPointer
 
+instance ToJSON ChainPointer where
+    toJSON ChainPointer{..} = object
+        [ "slot_num" .= slotNum
+        , "transaction_index" .= transactionIndex
+        , "output_index" .= outputIndex
+        ]
+
 -- | Encoding of pointer addresses for payment key type, pointer to delegation
 -- certificate in the blockchain and backend targets.
 --
@@ -225,6 +235,9 @@ newtype NetworkTag
     deriving (Generic, Show, Eq)
 instance NFData NetworkTag
 
+instance ToJSON NetworkTag where
+    toJSON (NetworkTag net) = Number (fromIntegral net)
+
 -- Describe requirements for address discrimination on the Byron era.
 data AddressDiscrimination
     = RequiresNetworkTag

core/lib/Cardano/Address/Style/Byron.hs

@@ -2,13 +2,15 @@
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TupleSections #-}
@@ -41,6 +43,8 @@ module Cardano.Address.Style.Byron
 
       -- * Addresses
       -- $addresses
+    , AddressInfo (..)
+    , eitherInspectAddress
     , inspectAddress
     , inspectByronAddress
     , paymentAddress
@@ -99,9 +103,9 @@ import Crypto.Hash
 import Crypto.Hash.Algorithms
     ( Blake2b_256, SHA512 (..) )
 import Data.Aeson
-    ( toJSON, (.=) )
+    ( ToJSON (..), (.=) )
 import Data.Bifunctor
-    ( bimap )
+    ( bimap, first )
 import Data.ByteArray
     ( ScrubbedBytes )
 import Data.ByteString
@@ -122,7 +126,6 @@ import qualified Codec.CBOR.Decoding as CBOR
 import qualified Crypto.KDF.PBKDF2 as PBKDF2
 import qualified Data.Aeson as Json
 import qualified Data.ByteArray as BA
-import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 
 -- $overview
@@ -311,6 +314,9 @@ data ErrInspectAddress
 
 deriving instance Show ErrInspectAddress
 
+instance Eq ErrInspectAddress where
+    a == b = show a == show b
+
 instance Exception ErrInspectAddress where
   displayException = prettyErrInspectAddress
 
@@ -326,47 +332,55 @@ prettyErrInspectAddress = \case
     FailedToDecryptPath ->
         "Failed to decrypt derivation path"
 
--- Analyze an 'Address' to know whether it's a Byron address or not.
--- Throws 'ByronAddrError' if the address isn't a byron address, or return a
--- structured JSON that gives information about an address.
+-- Determines whether an 'Address' is a Byron address.
+--
+-- Returns a JSON object with information about the address, or throws
+-- 'ErrInspectAddress' if the address isn't a byron address.
 --
 -- @since 2.0.0
 inspectByronAddress :: forall m. MonadThrow m => Maybe XPub -> Address -> m Json.Value
 inspectByronAddress = inspectAddress
 {-# DEPRECATED inspectByronAddress "use qualified 'inspectAddress' instead." #-}
 
--- | Analyze an 'Address' to know whether it's a Byron address or not.
--- Throws 'ByronAddrError' if the address isn't a byron address, or return a
--- structured JSON that gives information about an address.
+-- | Determines whether an 'Address' is a Byron address.
+--
+-- Returns a JSON object with information about the address, or throws
+-- 'ErrInspectAddress' if the address isn't a byron address.
 --
 -- @since 3.0.0
 inspectAddress :: forall m. MonadThrow m => Maybe XPub -> Address -> m Json.Value
-inspectAddress mRootPub addr = do
-    payload <- either (throwM . DeserialiseError) pure
-        $ CBOR.deserialiseCbor CBOR.decodeAddressPayload bytes
+inspectAddress mRootPub addr = either throwM (pure . toJSON) $
+    eitherInspectAddress mRootPub addr
+
+-- | Determines whether an 'Address' is a Byron address.
+--
+-- Returns either details about the 'Address', or 'ErrInspectAddress' if it's
+-- not a valid address.
+--
+-- @since 3.4.0
+eitherInspectAddress :: Maybe XPub -> Address -> Either ErrInspectAddress AddressInfo
+eitherInspectAddress mRootPub addr = do
+    payload <- first DeserialiseError $
+        CBOR.deserialiseCbor CBOR.decodeAddressPayload bytes
 
-    (root, attrs) <- either (throwM . DeserialiseError) pure
-        $ CBOR.deserialiseCbor decodePayload payload
+    (root, attrs) <- first DeserialiseError $
+        CBOR.deserialiseCbor decodePayload payload
 
     path <- do
-        attr <- maybe (throwM MissingExpectedDerivationPath) pure
-            (find ((== 1) . fst) attrs)
+        attr <- maybe (Left MissingExpectedDerivationPath) Right $
+            find ((== 1) . fst) attrs
         case mRootPub of
-            Nothing ->
-                pure $ toJSON $ T.unpack $ T.decodeUtf8 $ encode EBase16 $ snd attr
-            Just rootPub ->
-                decryptPath rootPub attr
-
-    ntwrk <- either (throwM . DeserialiseError) pure
-        $ CBOR.deserialiseCbor CBOR.decodeProtocolMagicAttr payload
-
-    pure $ Json.object
-        [ "address_style"   .= Json.String "Byron"
-        , "stake_reference" .= Json.String "none"
-        , "address_root"    .= T.unpack (T.decodeUtf8 $ encode EBase16 root)
-        , "derivation_path" .= path
-        , "network_tag"     .= maybe Json.Null toJSON ntwrk
-        ]
+            Nothing -> Right $ EncryptedDerivationPath $ snd attr
+            Just rootPub -> decryptPath attr rootPub
+
+    ntwrk <- bimap DeserialiseError (fmap NetworkTag) $
+        CBOR.deserialiseCbor CBOR.decodeProtocolMagicAttr payload
+
+    pure AddressInfo
+        { infoAddressRoot = root
+        , infoPayload = path
+        , infoNetworkTag = ntwrk
+        }
   where
     bytes :: ByteString
     bytes = unAddress addr
@@ -377,24 +391,58 @@ inspectAddress mRootPub addr = do
         root <- CBOR.decodeBytes
         (root,) <$> CBOR.decodeAllAttributes
 
-    decryptPath :: XPub -> (Word8, ByteString) -> m Json.Value
-    decryptPath rootPub attr = do
+    decryptPath :: (Word8, ByteString) -> XPub -> Either ErrInspectAddress PayloadInfo
+    decryptPath attr rootPub = do
         let pwd = hdPassphrase rootPub
-        path <- either (const (throwM FailedToDecryptPath)) pure
-            $ CBOR.deserialiseCbor (CBOR.decodeDerivationPathAttr pwd [attr]) mempty
+        path <- first (const FailedToDecryptPath) $
+            CBOR.deserialiseCbor (CBOR.decodeDerivationPathAttr pwd [attr]) mempty
         case path of
-            Nothing -> throwM FailedToDecryptPath
-            Just (acctIx, addrIx) -> pure $ Json.object
-                [ "account_index" .= prettyIndex acctIx
-                , "address_index" .= prettyIndex addrIx
-                ]
+            Nothing -> Left FailedToDecryptPath
+            Just (accountIndex, addressIndex) -> Right PayloadDerivationPath{..}
+
+-- | The result of 'eitherInspectAddress' for Byron addresses.
+--
+-- @since 3.4.0
+data AddressInfo = AddressInfo
+    { infoAddressRoot :: !ByteString
+    , infoPayload :: !PayloadInfo
+    , infoNetworkTag :: !(Maybe NetworkTag)
+    } deriving (Generic, Show, Eq)
+
+-- | The derivation path in a Byron address payload.
+--
+-- @since 3.4.0
+data PayloadInfo
+    = PayloadDerivationPath
+        { accountIndex :: !Word32
+        , addressIndex :: !Word32
+        }
+    | EncryptedDerivationPath
+        { encryptedDerivationPath :: !ByteString
+        }
+    deriving (Generic, Show, Eq)
 
-    prettyIndex :: Word32 -> String
-    prettyIndex ix
-        | ix >= firstHardened = show (ix - firstHardened) <> "H"
-        | otherwise = show ix
+instance ToJSON AddressInfo where
+    toJSON AddressInfo{..} = Json.object
+        [ "address_root"    .= T.decodeUtf8 (encode EBase16 infoAddressRoot)
+        , "derivation_path" .= infoPayload
+        , "network_tag"     .= maybe Json.Null toJSON infoNetworkTag
+        ]
+
+instance ToJSON PayloadInfo where
+    toJSON PayloadDerivationPath{..} = Json.object
+        [ "account_index" .= prettyIndex accountIndex
+        , "address_index" .= prettyIndex addressIndex
+        ]
       where
-        firstHardened = 0x80000000
+        prettyIndex :: Word32 -> String
+        prettyIndex ix
+            | ix >= firstHardened = show (ix - firstHardened) <> "H"
+            | otherwise = show ix
+          where
+            firstHardened = 0x80000000
+    toJSON EncryptedDerivationPath{..} = Json.String $
+        T.decodeUtf8 $ encode EBase16 encryptedDerivationPath
 
 instance Internal.PaymentAddress Byron where
     paymentAddress discrimination k = unsafeMkAddress