Merge #809

809: Provide `KeyToAddress` instance for `(Jormungandr n) RndKey` type. r=jonathanknowles a=jonathanknowles

# Issue Number

#808 

# Overview

This PR provides a missing `KeyToAddress` instance for the `(Jormungandr n) RndKey` type.

It's identical to the instance provided within `cardano-http-bridge`, namely for the `(HttpBridge 'Mainnet) RndKey` type.

Co-authored-by: Jonathan Knowles <[email protected]>

lib/jormungandr/src/Cardano/Wallet/Jormungandr/Compatibility.hs

@@ -42,7 +42,9 @@ import Cardano.Wallet.Jormungandr.Primitive.Types
 import Cardano.Wallet.Network.Ports
     ( PortNumber )
 import Cardano.Wallet.Primitive.AddressDerivation
-    ( KeyToAddress (..) )
+    ( KeyToAddress (..), getRawKey )
+import Cardano.Wallet.Primitive.AddressDerivation.Random
+    ( RndKey, derivationPath, payloadPassphrase )
 import Cardano.Wallet.Primitive.AddressDerivation.Sequential
     ( SeqKey (..) )
 import Cardano.Wallet.Primitive.Types
@@ -79,8 +81,10 @@ import Servant.Client.Core
 import System.FilePath
     ( FilePath, (</>) )
 
+import qualified Cardano.Byron.Codec.Cbor as CBOR
 import qualified Cardano.Wallet.Primitive.Types as W
 import qualified Codec.Binary.Bech32 as Bech32
+import qualified Codec.CBOR.Write as CBOR
 import qualified Data.Aeson as Aeson
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Char8 as B8
@@ -118,6 +122,18 @@ instance PersistTx (Jormungandr network) where
             amt
             isJust
 
+instance KeyToAddress (Jormungandr n) RndKey where
+    keyToAddress k = Address
+        $ CBOR.toStrictByteString
+        $ CBOR.encodeAddress (getRawKey k)
+            [ CBOR.encodeDerivationPathAttr pwd acctIx addrIx ]
+            -- Note that we do NOT include a protocol magic attribute here,
+            -- as we do not discriminate between Testnet and Mainnet: we'll
+            -- be using Byron Mainnet addresses on Jormungndr Testnet.
+      where
+        (acctIx, addrIx) = derivationPath k
+        pwd = payloadPassphrase k
+
 instance forall n. KnownNetwork n => KeyToAddress (Jormungandr n) SeqKey where
     keyToAddress key = singleAddressFromKey (Proxy @n) (getKey key)
 

lib/jormungandr/test/unit/Cardano/Wallet/Jormungandr/CompatibilitySpec.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -14,13 +15,33 @@ module Cardano.Wallet.Jormungandr.CompatibilitySpec
 import Prelude
 
 import Cardano.Crypto.Wallet
-    ( ChainCode (..), XPub (..) )
+    ( ChainCode (..), XPrv, XPub (..), unXPrv )
 import Cardano.Wallet.Jormungandr.Binary
     ( signData, singleAddressFromKey )
 import Cardano.Wallet.Jormungandr.Compatibility
     ( BaseUrl (..), Jormungandr, Scheme (..), genConfigFile )
 import Cardano.Wallet.Jormungandr.Environment
     ( KnownNetwork (..), Network (..) )
+import Cardano.Wallet.Primitive.AddressDerivation
+    ( Depth (AccountK, AddressK, RootK)
+    , DerivationType (Hardened)
+    , Index
+    , KeyToAddress (..)
+    , Passphrase (..)
+    , passphraseMaxLength
+    , passphraseMinLength
+    , publicKey
+    )
+import Cardano.Wallet.Primitive.AddressDerivation.Random
+    ( RndKey
+    , generateKeyFromSeed
+    , minSeedLengthBytes
+    , unsafeGenerateKeyFromSeed
+    )
+import Cardano.Wallet.Primitive.AddressDiscovery
+    ( IsOurs (..), knownAddresses )
+import Cardano.Wallet.Primitive.AddressDiscovery.Random
+    ( mkRndState )
 import Cardano.Wallet.Primitive.Types
     ( Address (..)
     , Coin (..)
@@ -33,6 +54,8 @@ import Cardano.Wallet.Primitive.Types
     )
 import Cardano.Wallet.Unsafe
     ( unsafeDecodeAddress, unsafeFromHex )
+import Control.Monad
+    ( replicateM )
 import Data.Aeson.QQ
     ( aesonQQ )
 import Data.ByteArray.Encoding
@@ -50,18 +73,25 @@ import Test.Hspec
 import Test.QuickCheck
     ( Arbitrary (..)
     , Gen
+    , InfiniteList (..)
+    , Property
+    , arbitraryBoundedEnum
+    , arbitraryPrintableChar
     , choose
     , frequency
     , oneof
     , property
     , vectorOf
     , withMaxSuccess
+    , (.&&.)
     , (===)
     )
 
+import qualified Data.ByteArray as BA
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Char8 as B8
 import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
 
 spec :: Spec
 spec = do
@@ -275,6 +305,12 @@ spec = do
                 }
             }|]
 
+    describe "Random Address Discovery Properties" $ do
+        it "isOurs works as expected during key derivation in testnet" $ do
+            property (prop_derivedKeysAreOurs @'Testnet)
+        it "isOurs works as expected during key derivation in mainnet" $ do
+            property (prop_derivedKeysAreOurs @'Mainnet)
+
 negativeTest
     :: DecodeAddress t
     => Proxy t
@@ -330,10 +366,73 @@ goldenTestSignData _ (GoldenTestSignData ins outs expected) =
   where
     hex = convertToBase @ByteString @ByteString Base16
 
+{-------------------------------------------------------------------------------
+                               Properties
+-------------------------------------------------------------------------------}
+
+prop_derivedKeysAreOurs
+    :: forall (n :: Network) t. (KeyToAddress t RndKey, t ~ Jormungandr n)
+    => Passphrase "seed"
+    -> Passphrase "encryption"
+    -> Index 'Hardened 'AccountK
+    -> Index 'Hardened 'AddressK
+    -> RndKey 'RootK XPrv
+    -> Property
+prop_derivedKeysAreOurs seed encPwd accIx addrIx rk' =
+    resPos .&&. addr `elem` knownAddresses stPos' .&&.
+    not resNeg .&&. addr `notElem` knownAddresses stNeg'
+  where
+    (resPos, stPos') = isOurs addr (mkRndState @t rootXPrv 0)
+    (resNeg, stNeg') = isOurs addr (mkRndState @t rk' 0)
+    key = publicKey $ unsafeGenerateKeyFromSeed (accIx, addrIx) seed encPwd
+    rootXPrv = generateKeyFromSeed seed encPwd
+    addr = keyToAddress @t key
+
 {-------------------------------------------------------------------------------
                              Arbitrary Instances
 -------------------------------------------------------------------------------}
 
+instance Arbitrary (Index 'Hardened 'AccountK) where
+    shrink _ = []
+    arbitrary = arbitraryBoundedEnum
+
+instance Arbitrary (Index 'Hardened 'AddressK) where
+    shrink _ = []
+    arbitrary = arbitraryBoundedEnum
+
+instance Arbitrary (RndKey 'RootK XPrv) where
+    shrink _ = []
+    arbitrary = genRootKeys
+
+genRootKeys :: Gen (RndKey 'RootK XPrv)
+genRootKeys = do
+    (s, e) <- (,)
+        <$> genPassphrase @"seed" (16, 32)
+        <*> genPassphrase @"encryption" (0, 16)
+    return $ generateKeyFromSeed s e
+  where
+    genPassphrase :: (Int, Int) -> Gen (Passphrase purpose)
+    genPassphrase range = do
+        n <- choose range
+        InfiniteList bytes _ <- arbitrary
+        return $ Passphrase $ BA.convert $ BS.pack $ take n bytes
+
+instance Show XPrv where
+    show = show . unXPrv
+
+instance {-# OVERLAPS #-} Arbitrary (Passphrase "encryption") where
+    arbitrary = do
+        let p = Proxy :: Proxy "encryption"
+        n <- choose (passphraseMinLength p, passphraseMaxLength p)
+        bytes <- T.encodeUtf8 . T.pack <$> replicateM n arbitraryPrintableChar
+        return $ Passphrase $ BA.convert bytes
+
+instance {-# OVERLAPS #-} Arbitrary (Passphrase "seed") where
+    arbitrary = do
+        n <- choose (minSeedLengthBytes, 64)
+        bytes <- BS.pack <$> vectorOf n arbitrary
+        return $ Passphrase $ BA.convert bytes
+
 instance {-# OVERLAPS #-} KnownNetwork n => Arbitrary (ShowFmt Address, Proxy n) where
     arbitrary = do
         let proxy = Proxy @n