diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation.hs index cbb9c1b09d4..a93fc8a15f6 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation.hs @@ -55,8 +55,14 @@ module Cardano.Wallet.Primitive.AddressDerivation , unXPrv , xprv , xpub + + -- * Helpers , hex , fromHex + , unXPrvStripPub + , xPrvFromStrippedPubXPrv + , ErrXPrvFromStrippedPubXPrv (..) + , ErrUnXPrvStripPub (..) -- * Network Discrimination , NetworkDiscriminant (..) @@ -107,7 +113,7 @@ import Control.Arrow import Control.DeepSeq ( NFData ) import Control.Monad - ( unless ) + ( unless, when ) import Crypto.Hash ( Digest, HashAlgorithm ) import Crypto.KDF.PBKDF2 @@ -153,6 +159,7 @@ import GHC.TypeLits import Type.Reflection ( typeOf ) +import qualified Cardano.Crypto.Wallet.Encrypted as CC import qualified Data.ByteArray as BA import qualified Data.ByteString as BS import qualified Data.Text as T @@ -720,3 +727,67 @@ hex = convertToBase Base16 -- | Decode a 'ByteString' from base16 fromHex :: ByteArray bout => ByteString -> Either String bout fromHex = convertFromBase Base16 + +data ErrUnXPrvStripPub + = ErrCannotRoundtrip + -- ^ The resulting bytestring would have been unable to roundtrip using + -- @xPrvFromStrippedPubXPrv@. Most likely because the input @XPrv@ was + -- encrypted, or because it was an old (Byron) key. + deriving (Eq, Show) + +-- | Convert a @XPrv@ to a 96-byte long extended private key that does /not/ +-- include the public key. +-- +-- The format is: +-- > Extended Private Key (64 bytes) <> ChainCode (32 bytes) +-- +-- Returns @Left@ if the resulting bytestring fails to roundtrip back to the +-- original @XPrv@. This can happen: +-- - If the @XPrv@ was encrypted +-- - If a DerivationScheme1 (Byron) key was used (that does not conform to the +-- "tweak") +unXPrvStripPub :: XPrv -> Either ErrUnXPrvStripPub ByteString +unXPrvStripPub k = do + let res = stripPub . unXPrv $ k + + -- Check that it roundtrips. + case (fmap unXPrv . xPrvFromStrippedPubXPrv $ res) of + Right bytes + | bytes == unXPrv k -> Right res + | otherwise -> Left ErrCannotRoundtrip + Left _ -> error "unXPrvStripPub: this state cannot be \ + \reached from a rightfully crafted XPrv" + where + -- Converts xprv <> pub <> cc + -- To xprv <> cc + stripPub :: ByteString -> ByteString + stripPub xprv' = prv <> chainCode + where + (prv, rest) = BS.splitAt 64 xprv' + (_pub, chainCode) = BS.splitAt 32 rest + +data ErrXPrvFromStrippedPubXPrv + = ErrInputLengthMismatch Int Int -- ^ Expected, Actual + | ErrInternalError String + deriving (Eq, Show) + +-- | Create a @XPrv@ from a 96-byte long extended private key +-- +-- The format is: +-- +-- > Extended Private Key (64 bytes) <> ChainCode (32 bytes) +xPrvFromStrippedPubXPrv :: ByteString -> Either ErrXPrvFromStrippedPubXPrv XPrv +xPrvFromStrippedPubXPrv x = do + when (BS.length x /= expectedInputLength) $ + Left $ ErrInputLengthMismatch expectedInputLength (BS.length x) + toXPrv $ CC.encryptedCreateDirectWithTweak x pass + where + pass :: ByteString + pass = "" + + expectedInputLength = 96 + + -- @xprv@ can fail. But because it is calling @encryptedKey@ internally, + -- and we are feeding it the output of @unEncryptedKey@, it really shouldn't. + toXPrv :: CC.EncryptedKey -> Either ErrXPrvFromStrippedPubXPrv XPrv + toXPrv = left ErrInternalError . xprv . CC.unEncryptedKey diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDerivationSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDerivationSpec.hs index 0f10eccea48..cf9eb876ef9 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDerivationSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDerivationSpec.hs @@ -25,6 +25,7 @@ import Cardano.Wallet.Gen import Cardano.Wallet.Primitive.AddressDerivation ( Depth (..) , DerivationType (..) + , ErrUnXPrvStripPub (..) , ErrWrongPassphrase (..) , FromMnemonic (..) , FromMnemonicError (..) @@ -42,6 +43,8 @@ import Cardano.Wallet.Primitive.AddressDerivation , checkPassphrase , encryptPassphrase , getIndex + , unXPrvStripPub + , xPrvFromStrippedPubXPrv ) import Cardano.Wallet.Primitive.AddressDerivation.Byron ( ByronKey (..) ) @@ -51,12 +54,16 @@ import Cardano.Wallet.Primitive.AddressDerivation.Shelley ( KnownNetwork (..), ShelleyKey (..) ) import Cardano.Wallet.Primitive.Types ( Address (..), Hash (..) ) +import Control.Arrow + ( left ) import Control.Monad - ( replicateM ) + ( replicateM, (>=>) ) import Control.Monad.IO.Class ( liftIO ) import Data.Either - ( isRight ) + ( isLeft, isRight ) +import Data.Function + ( (&) ) import Data.Proxy ( Proxy (..) ) import Test.Hspec @@ -65,12 +72,16 @@ import Test.QuickCheck ( Arbitrary (..) , Gen , InfiniteList (..) + , NonNegative (..) , Property , arbitraryBoundedEnum , arbitraryPrintableChar , choose + , classify + , counterexample , expectFailure , genericShrink + , label , oneof , property , vectorOf @@ -213,6 +224,13 @@ spec = do it "XPub IcarusKey" (property $ prop_roundtripXPub @IcarusKey) + describe "unXPrvStripPub & xPrvFromStrippedPubXPrv" $ do + it "either roundtrips or fails (if xprv is encrypted)" + (property prop_unXPrvStripRoundtrip) + + it "(xPrvFromStrippedPubXPrv bs) fails if (BS.length bs) /= 96" + (property prop_xPrvFromStrippedPubXPrvLengthRequirement) + {------------------------------------------------------------------------------- Properties -------------------------------------------------------------------------------} @@ -281,6 +299,44 @@ prop_passphraseHashMalformed prop_passphraseHashMalformed pwd = monadicIO $ liftIO $ do checkPassphrase pwd (Hash mempty) `shouldBe` Left ErrWrongPassphrase +-- NOTE: Instead of testing +-- > encrypted => fails +-- we are testing +-- > fails => encrypted +-- +-- This /should/ be enough. If a key were to be encrypted, but still roundtrip, +-- we would not care. +prop_unXPrvStripRoundtrip :: XPrvWithPass -> Property +prop_unXPrvStripRoundtrip (XPrvWithPass k enc) = do + let res = unXPrvStripPub k + case res of + Right k' -> + xPrvFromStrippedPubXPrv k' === Right k + & label "roundtrip" + Left ErrCannotRoundtrip -> + enc /= Passphrase "" + & label "mismatch" + & counterexample "XPrv should be encrypted for the roundtrip to\ + \fail" +prop_xPrvFromStrippedPubXPrvLengthRequirement + :: Unencrypted XPrv + -> NonNegative Int + -> Property +prop_xPrvFromStrippedPubXPrvLengthRequirement (Unencrypted k) (NonNegative n) = do + let f = toStripped >=> (return . BS.take n) >=> fromStripped + let k' = f k + -- A reason for writing the test using BS.take n instead of say vectorOf + -- was guarding against + -- https://github.com/input-output-hk/cardano-crypto/issues/67 + n < 96 ==> property $ isLeft k' + & counterexample ("n = " ++ show n) + & counterexample ("result = " ++ show k') + & classify (n == 96) "== 96" + & classify (n < 96) "< 96" + where + toStripped = left show . unXPrvStripPub + fromStripped = left show . xPrvFromStrippedPubXPrv + {------------------------------------------------------------------------------- Arbitrary Instances -------------------------------------------------------------------------------} @@ -342,11 +398,11 @@ instance Eq XPrv where instance Arbitrary (ShelleyKey 'RootK XPrv) where shrink _ = [] - arbitrary = genRootKeysSeq + arbitrary = genRootKeysSeqWithPass =<< genPassphrase (0, 16) instance Arbitrary (ShelleyKey 'AccountK XPub) where shrink _ = [] - arbitrary = publicKey <$> genRootKeysSeq + arbitrary = publicKey <$> (genRootKeysSeqWithPass =<< genPassphrase (0, 16)) instance Arbitrary (ShelleyKey 'RootK XPub) where shrink _ = [] @@ -354,37 +410,72 @@ instance Arbitrary (ShelleyKey 'RootK XPub) where instance Arbitrary (ByronKey 'RootK XPrv) where shrink _ = [] - arbitrary = genRootKeysRnd + arbitrary = genRootKeysRndWithPass =<< genPassphrase (0, 16) instance Arbitrary (IcarusKey 'RootK XPrv) where shrink _ = [] - arbitrary = genRootKeysIca + arbitrary = genRootKeysIcaWithPass =<< genPassphrase (0, 16) instance Arbitrary (IcarusKey 'AccountK XPub) where shrink _ = [] - arbitrary = publicKey <$> genRootKeysIca + arbitrary = publicKey <$> (genRootKeysIcaWithPass =<< genPassphrase (0, 16)) instance Arbitrary NetworkDiscriminant where arbitrary = arbitraryBoundedEnum shrink = genericShrink -genRootKeysSeq :: Gen (ShelleyKey depth XPrv) -genRootKeysSeq = do - (s, g, e) <- (,,) - <$> (SomeMnemonic <$> genMnemonic @15) - <*> (Just . SomeMnemonic <$> genMnemonic @12) - <*> genPassphrase @"encryption" (0, 16) - return $ Seq.unsafeGenerateKeyFromSeed (s, g) e +newtype Unencrypted a = Unencrypted { getUnencrypted :: a } + deriving (Eq, Show) + +instance Arbitrary (Unencrypted XPrv) where + shrink _ = [] + arbitrary = Unencrypted <$> genAnyKeyWithPass mempty + +data XPrvWithPass = XPrvWithPass XPrv (Passphrase "encryption") + deriving (Eq, Show) + +instance Arbitrary XPrvWithPass where + shrink _ = [] + arbitrary = do + pwd <- oneof + [ genPassphrase (0, 16) + , return $ Passphrase "" + ] + flip XPrvWithPass pwd <$> genAnyKeyWithPass pwd + +genAnyKeyWithPass + :: Passphrase "encryption" + -> Gen XPrv +genAnyKeyWithPass pwd = oneof + [ getRawKey + <$> genRootKeysSeqWithPass pwd + , getRawKey + <$> genRootKeysRndWithPass pwd + , getRawKey + <$> genRootKeysIcaWithPass pwd + ] -genRootKeysRnd :: Gen (ByronKey 'RootK XPrv) -genRootKeysRnd = Rnd.generateKeyFromSeed +genRootKeysSeqWithPass + :: Passphrase "encryption" + -> Gen (ShelleyKey depth XPrv) +genRootKeysSeqWithPass encryptionPass = do + s <- SomeMnemonic <$> genMnemonic @15 + g <- Just . SomeMnemonic <$> genMnemonic @12 + return $ Seq.unsafeGenerateKeyFromSeed (s, g) encryptionPass + +genRootKeysRndWithPass + :: Passphrase "encryption" + -> Gen (ByronKey 'RootK XPrv) +genRootKeysRndWithPass encryptionPass = Rnd.generateKeyFromSeed <$> (SomeMnemonic <$> genMnemonic @12) - <*> genPassphrase @"encryption" (0, 16) + <*> (pure encryptionPass) -genRootKeysIca :: Gen (IcarusKey depth XPrv) -genRootKeysIca = Ica.unsafeGenerateKeyFromSeed +genRootKeysIcaWithPass + :: Passphrase "encryption" + -> Gen (IcarusKey depth XPrv) +genRootKeysIcaWithPass encryptionPass = Ica.unsafeGenerateKeyFromSeed <$> (SomeMnemonic <$> genMnemonic @15) - <*> genPassphrase @"encryption" (0, 16) + <*> (pure encryptionPass) genPassphrase :: (Int, Int) -> Gen (Passphrase purpose) genPassphrase range = do diff --git a/lib/jormungandr/cardano-wallet-jormungandr.cabal b/lib/jormungandr/cardano-wallet-jormungandr.cabal index d67ff3e7b78..9c8a90990d1 100644 --- a/lib/jormungandr/cardano-wallet-jormungandr.cabal +++ b/lib/jormungandr/cardano-wallet-jormungandr.cabal @@ -251,10 +251,11 @@ test-suite integration Test.Integration.Jormungandr.Scenario.API.StakePools Test.Integration.Jormungandr.Scenario.API.Transactions Test.Integration.Jormungandr.Scenario.CLI.Launcher + Test.Integration.Jormungandr.Scenario.CLI.Keys + Test.Integration.Jormungandr.Scenario.CLI.Mnemonics Test.Integration.Jormungandr.Scenario.CLI.Server Test.Integration.Jormungandr.Scenario.CLI.StakePools Test.Integration.Jormungandr.Scenario.CLI.Transactions - Test.Integration.Jormungandr.Scenario.CLI.Mnemonics Test.Utils.Ports benchmark latency diff --git a/lib/jormungandr/test/integration/Main.hs b/lib/jormungandr/test/integration/Main.hs index 9cf515a17a5..34d482d5a61 100644 --- a/lib/jormungandr/test/integration/Main.hs +++ b/lib/jormungandr/test/integration/Main.hs @@ -84,6 +84,7 @@ import qualified Cardano.Wallet.Jormungandr.NetworkSpec as NetworkLayer import qualified Data.Text as T import qualified Test.Integration.Jormungandr.Scenario.API.StakePools as StakePoolsApiJormungandr import qualified Test.Integration.Jormungandr.Scenario.API.Transactions as TransactionsApiJormungandr +import qualified Test.Integration.Jormungandr.Scenario.CLI.Keys as KeysCLI import qualified Test.Integration.Jormungandr.Scenario.CLI.Launcher as LauncherCLI import qualified Test.Integration.Jormungandr.Scenario.CLI.Mnemonics as MnemonicsJormungandr import qualified Test.Integration.Jormungandr.Scenario.CLI.Server as ServerCLI @@ -117,6 +118,7 @@ main = withUtf8Encoding $ withLogging Nothing Info $ \(_, tr) -> do describe "Miscellaneous CLI tests" $ parallel (MiscellaneousCLI.spec @t) describe "Launcher CLI tests" $ parallel (LauncherCLI.spec @t) describe "Stake Pool Metrics" MetricsSpec.spec + describe "Key CLI tests" KeysCLI.spec describe "API Specifications" $ specWithServer tr $ do Addresses.spec diff --git a/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Keys.hs b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Keys.hs new file mode 100644 index 00000000000..2d6079866f2 --- /dev/null +++ b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Keys.hs @@ -0,0 +1,133 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Test.Integration.Jormungandr.Scenario.CLI.Keys + ( spec + ) where + +import Prelude + +import Cardano.Wallet.Primitive.AddressDerivation + ( Depth (..) + , Passphrase (..) + , SomeMnemonic (..) + , WalletKey (..) + , XPrv + , hex + , unXPrv + , unXPrvStripPub + ) +import Cardano.Wallet.Primitive.AddressDerivation.Byron + ( ByronKey ) +import Cardano.Wallet.Primitive.AddressDerivation.Icarus + ( IcarusKey ) +import Cardano.Wallet.Primitive.AddressDerivation.Shelley + ( ShelleyKey ) +import Cardano.Wallet.Primitive.Mnemonic + ( ConsistentEntropy, EntropySize, Mnemonic, entropyToMnemonic ) +import Cardano.Wallet.Unsafe + ( unsafeMkEntropy ) +import Data.Proxy + ( Proxy (..) ) +import GHC.TypeLits + ( natVal ) +import System.Process + ( readProcessWithExitCode ) +import Test.Hspec + ( Spec, describe, it ) +import Test.QuickCheck + ( Arbitrary (..) + , Gen + , Property + , counterexample + , frequency + , property + , vectorOf + ) +import Test.QuickCheck.Monadic + ( assert, monadicIO, monitor, run ) + +import qualified Cardano.Wallet.Primitive.AddressDerivation.Byron as Byron +import qualified Cardano.Wallet.Primitive.AddressDerivation.Icarus as Icarus +import qualified Cardano.Wallet.Primitive.AddressDerivation.Shelley as Shelley +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as B8 + +spec :: Spec +spec = + describe "unXPrvStripPub" $ do + it "is compatible with jcli (Shelley)" $ + property $ prop_keyToHexTextJcliCompatible @ShelleyKey + it "is compatible with jcli (Icarus)" $ + property $ prop_keyToHexTextJcliCompatible @IcarusKey + it "is compatible with jcli (Byron)" $ + property $ prop_keyToHexTextJcliCompatible @ByronKey + +prop_keyToHexTextJcliCompatible + :: WalletKey k + => k 'RootK XPrv + -> Property +prop_keyToHexTextJcliCompatible k = monadicIO $ do + let Right hexXPrv = fmap (B8.unpack . hex) . unXPrvStripPub . getRawKey $ k + monitor (counterexample $ "\nkey bytes = " ++ hexXPrv) + (code, stdout, stderr) <- run $ jcliKeyFromHex hexXPrv + monitor (counterexample $ "\n" ++ show code) + monitor (counterexample $ "Stdout: " ++ show stdout) + monitor (counterexample $ "Stderr: " ++ show stderr) + assert (stderr == "") + where + jcliKeyFromHex = readProcessWithExitCode + "jcli" + ["key", "from-bytes", "--type", "ed25519bip32"] + +instance Arbitrary (ShelleyKey 'RootK XPrv) where + shrink _ = [] + arbitrary = do + s <- SomeMnemonic <$> genMnemonic @15 + g <- fmap SomeMnemonic <$> genSecondFactor + return $ Shelley.unsafeGenerateKeyFromSeed (s, g) encryptionPass + where + encryptionPass = Passphrase "" + genSecondFactor = frequency + [ (30, return Nothing) + , (70, Just <$> genMnemonic @12) + ] + +instance Arbitrary (ByronKey 'RootK XPrv) where + shrink _ = [] + arbitrary = Byron.unsafeGenerateKeyFromSeed () + <$> (SomeMnemonic <$> genMnemonic @12) + <*> (pure mempty) + +instance Arbitrary (IcarusKey 'RootK XPrv) where + shrink _ = [] + arbitrary = Icarus.unsafeGenerateKeyFromSeed + <$> (SomeMnemonic <$> genMnemonic @12) + <*> (pure mempty) + +instance Show XPrv where + show = show . unXPrv + +instance Eq XPrv where + a == b = unXPrv a == unXPrv b + +-- | Generates an arbitrary mnemonic of a size according to the type parameter. +-- +-- E.g: +-- >>> arbitrary = SomeMnemonic <$> genMnemonic @12 +-- +-- NOTE: Duplicated with "Cardano.Wallet.Gen". +genMnemonic + :: forall mw ent csz. + ( ConsistentEntropy ent mw csz + , EntropySize mw ~ ent + ) + => Gen (Mnemonic mw) +genMnemonic = do + let n = fromIntegral (natVal $ Proxy @(EntropySize mw)) `div` 8 + bytes <- BS.pack <$> vectorOf n arbitrary + let ent = unsafeMkEntropy @(EntropySize mw) bytes + return $ entropyToMnemonic ent