Implicit conversion from seeds to xprv keys

The commands hd-pub hd-to-address and hd-to-wif are affected.
Internally this benefits from a refactoring.

hx.hs

@@ -69,7 +69,8 @@ decodeBase58E :: BS -> BS
 decodeBase58E = fromMaybe (error "invalid base58 encoding") . decodeBase58 . ignoreSpaces
 
 xPrvImportBS :: BS -> Maybe XPrvKey
-xPrvImportBS = xPrvImport . B8.unpack
+xPrvImportBS s | "xprv" `BS.isPrefixOf` s = xPrvImport (B8.unpack s)
+               | otherwise                = makeXPrvKey (decodeHex "seed" s)
 
 xPubImportBS :: BS -> Maybe XPubKey
 xPubImportBS = xPubImport . B8.unpack
@@ -83,16 +84,19 @@ xPubExportBS = B8.pack . xPubExport
 xPrvImportE :: BS -> XPrvKey
 xPrvImportE = fromMaybe (error "invalid extended private key") . xPrvImportBS . ignoreSpaces
 
-xPubImportE :: BS -> XPubKey
-xPubImportE = fromMaybe (error "invalid extended public key") . xPubImportBS . ignoreSpaces
-
 data XKey = XPub XPubKey | XPrv XPrvKey
 
+onXKey :: (XPrvKey -> a) -> (XPubKey -> a) -> XKey -> a
+onXKey onXPrv _      (XPrv k) = onXPrv k
+onXKey _      onXPub (XPub k) = onXPub k
+
+mapXKey :: (XPrvKey -> XPrvKey) -> (XPubKey -> XPubKey) -> XKey -> XKey
+mapXKey onXPrv onXPub = onXKey (XPrv . onXPrv) (XPub . onXPub)
+
 xKeyImport :: BS -> Maybe XKey
 xKeyImport s
-  | "xprv" `BS.isPrefixOf` s = XPrv <$> xPrvImportBS s
   | "xpub" `BS.isPrefixOf` s = XPub <$> xPubImportBS s
-  | otherwise             = Nothing
+  | otherwise                = XPrv <$> xPrvImportBS s
 
 xKeyImportE :: BS -> XKey
 xKeyImportE = fromMaybe (error "invalid extended public or private key") . xKeyImport . ignoreSpaces
@@ -102,28 +106,27 @@ pubXKey (XPub k) = k
 pubXKey (XPrv k) = deriveXPubKey k
 
 xMasterImportE :: Hex s => s -> XPrvKey
-xMasterImportE = fromMaybe (error "failed to derived private root key from seed") . makeXPrvKey
-               . decodeHex "seed"
-
-xPrvExportC :: Char -> XPrvKey -> BS
-xPrvExportC 'A' = addrToBase58BS . xPubAddr . deriveXPubKey
-xPrvExportC 'P' = putHex . xPubKey . deriveXPubKey
-xPrvExportC 'p' = B8.pack . xPrvWIF
-xPrvExportC 'U' = putHex . uncompress . xPubKey . deriveXPubKey
-xPrvExportC 'u' = toWIFBS . uncompress . xPrvKey
-xPrvExportC 'M' = xPubExportBS . deriveXPubKey
-xPrvExportC 'm' = xPrvExportBS
-xPrvExportC  c  = error $ "Root path expected to be m/, M/, A/, P/, p/, U/, or u/ not " ++ c : "/"
-
-xPubExportC :: Char -> XPubKey -> BS
-xPubExportC 'A' = addrToBase58BS . xPubAddr
-xPubExportC 'P' = putHex . xPubKey
-xPubExportC 'U' = putHex . uncompress . xPubKey
-xPubExportC 'M' = xPubExportBS
-xPubExportC 'u' = error "Uncompressed private keys can not be derived from extended public keys (expected P/, U/ or M/ not u/)"
-xPubExportC 'p' = error "Private keys can not be derived from extended public keys (expected P/, U/ or M/ not p/)"
-xPubExportC 'm' = error "Extended private keys can not be derived from extended public keys (expected M/ not m/)"
-xPubExportC  c  = error $ "Root path expected to be M/, A/, or P/ not " ++ c : "/"
+xMasterImportE = fromMaybe (error "failed to derived private root key from seed")
+               . makeXPrvKey . decodeHex "seed"
+
+xKeyExportC :: Char -> XKey -> BS
+xKeyExportC 'A' = addrToBase58BS . xPubAddr . pubXKey
+xKeyExportC 'P' = putHex . xPubKey . pubXKey
+xKeyExportC 'U' = putHex . uncompress . xPubKey . pubXKey
+xKeyExportC 'M' = xPubExportBS . pubXKey
+xKeyExportC 'p' = onXKey (B8.pack . xPrvWIF)
+                         (error "Private keys can not be derived from extended public keys (expected P/, U/ or M/ not p/)")
+xKeyExportC 'u' = onXKey (toWIFBS . uncompress . xPrvKey)
+                         (error "Uncompressed private keys can not be derived from extended public keys (expected P/, U/ or M/ not u/)")
+xKeyExportC 'm' = onXKey xPrvExportBS
+                         (error "Extended private keys can not be derived from extended public keys (expected M/ not m/)")
+xKeyExportC  c  = onXKey (error $ "Root path expected to be m/, M/, A/, P/, p/, U/, or u/ not " ++ c : "/")
+                         (error $ "Root path expected to be M/, A/, or P/ not " ++ c : "/")
+
+{-
+derivePath does not completly subsumes derivePrvPath
+as the type is more precise.
+-}
 
 derivePrvPath :: String -> XPrvKey -> XPrvKey
 derivePrvPath []       = id
@@ -146,6 +149,9 @@ derivePubPath ('/':xs) = goIndex $ span isDigit xs
                         {- This read works because (all isDigit ys && not (null ys)) holds -}
 derivePubPath _ = error "malformed path"
 
+derivePath :: String -> XKey -> XKey
+derivePath p = mapXKey (derivePrvPath p) (derivePubPath p)
+
 fromWIFE :: BS -> PrvKey
 fromWIFE = fromMaybe (error "invalid WIF private key") . fromWIF . B8.unpack . ignoreSpaces
 
@@ -261,7 +267,6 @@ hx_secret_to_wif = toWIFBS . fromMaybe (error "invalid private key")
 hx_hd_to_wif :: BS -> BS
 hx_hd_to_wif = B8.pack . xPrvWIF . xPrvImportE
 
--- TODO support private keys as well
 hx_hd_to_address :: BS -> BS
 hx_hd_to_address = addrToBase58BS . xPubAddr . pubXKey . xKeyImportE
 
@@ -273,17 +278,14 @@ hx_hd_priv Nothing         = xPrvExportBS . xMasterImportE
 hx_hd_priv (Just (sub, i)) = xPrvExportBS . flip sub i . xPrvImportE
 
 hx_hd_pub :: Maybe Word32 -> BS -> BS
-hx_hd_pub Nothing  = xPubExportBS . deriveXPubKey     . xPrvImportE
-hx_hd_pub (Just i) = xPubExportBS . flip pubSubKeyE i . pubXKey . xKeyImportE
+hx_hd_pub mi = xPubExportBS . f . pubXKey . xKeyImportE
+  where f = maybe id (flip pubSubKeyE) mi
 
 hx_hd_path :: BS -> BS -> BS
-hx_hd_path mp i =
+hx_hd_path mp =
   case B8.unpack mp of
-    [] -> error "Empty path"
-    (m:p)
-      | "xpub" `BS.isPrefixOf` i -> xPubExportC m . derivePubPath p $ xPubImportE    i
-      | "xprv" `BS.isPrefixOf` i -> xPrvExportC m . derivePrvPath p $ xPrvImportE    i
-      | otherwise                -> xPrvExportC m . derivePrvPath p $ xMasterImportE i
+    []    -> error "Empty path"
+    (m:p) -> xKeyExportC m . derivePath p . xKeyImportE
 
 hx_bip39_mnemonic :: Hex s => s -> BS
 hx_bip39_mnemonic = either error B8.pack . toMnemonic . decodeHex "seed"

tests/hd-pub-from-seed-test-vector1.t/TESTRECIPE

@@ -0,0 +1,42 @@
+#!/bin/bash
+
+testname=hd-pub-from-seed-test-vector1.t
+command=hx
+args=( hd-pub )
+exit_code=0
+stdin_file=stdin
+stdout_file=stdout
+stderr_file=/dev/null
+sources=( )
+products=( )
+
+# Environment variables:
+env_vars=( )
+
+setup(){
+  : Perform here actions to be run before the tested program
+}
+
+munge(){
+  : Munge here the results of the tested program to ease the check
+}
+
+check(){
+  check_exit_code &&
+  check_stderr &&
+  check_stdout &&
+  check_products &&
+  : Perform here extra checks on the tested program
+}
+
+explain(){
+  explain_exit_code
+  explain_stdout
+  explain_stderr
+  explain_products
+  : Explain here more potential differences
+}
+
+teardown(){
+  : Undo here the actions of setup
+}

tests/hd-pub-from-seed-test-vector1.t/stdin

@@ -0,0 +1 @@
+000102030405060708090a0b0c0d0e0f

tests/hd-pub-from-seed-test-vector1.t/stdout

@@ -0,0 +1 @@
+xpub661MyMwAqRbcFtXgS5sYJABqqG9YLmC4Q1Rdap9gSE8NqtwybGhePY2gZ29ESFjqJoCu1Rupje8YtGqsefD265TMg7usUDFdp6W1EGMcet8

tests/hd-pub-from-seed-test-vector2.t/TESTRECIPE

@@ -0,0 +1,42 @@
+#!/bin/bash
+
+testname=hd-pub-from-seed-test-vector2.t
+command=hx
+args=( hd-pub )
+exit_code=0
+stdin_file=stdin
+stdout_file=stdout
+stderr_file=/dev/null
+sources=( )
+products=( )
+
+# Environment variables:
+env_vars=( )
+
+setup(){
+  : Perform here actions to be run before the tested program
+}
+
+munge(){
+  : Munge here the results of the tested program to ease the check
+}
+
+check(){
+  check_exit_code &&
+  check_stderr &&
+  check_stdout &&
+  check_products &&
+  : Perform here extra checks on the tested program
+}
+
+explain(){
+  explain_exit_code
+  explain_stdout
+  explain_stderr
+  explain_products
+  : Explain here more potential differences
+}
+
+teardown(){
+  : Undo here the actions of setup
+}

tests/hd-pub-from-seed-test-vector2.t/stdin

@@ -0,0 +1 @@
+fffcf9f6f3f0edeae7e4e1dedbd8d5d2cfccc9c6c3c0bdbab7b4b1aeaba8a5a29f9c999693908d8a8784817e7b7875726f6c696663605d5a5754514e4b484542

tests/hd-pub-from-seed-test-vector2.t/stdout

@@ -0,0 +1 @@
+xpub661MyMwAqRbcFW31YEwpkMuc5THy2PSt5bDMsktWQcFF8syAmRUapSCGu8ED9W6oDMSgv6Zz8idoc4a6mr8BDzTJY47LJhkJ8UB7WEGuduB

tests/hd-to-address-from-seed-test-vector1.t/TESTRECIPE

@@ -0,0 +1,42 @@
+#!/bin/bash
+
+testname=hd-to-address-from-seed-test-vector1.t
+command=hx
+args=( hd-to-address )
+exit_code=0
+stdin_file=stdin
+stdout_file=stdout
+stderr_file=/dev/null
+sources=( )
+products=( )
+
+# Environment variables:
+env_vars=( )
+
+setup(){
+  : Perform here actions to be run before the tested program
+}
+
+munge(){
+  : Munge here the results of the tested program to ease the check
+}
+
+check(){
+  check_exit_code &&
+  check_stderr &&
+  check_stdout &&
+  check_products &&
+  : Perform here extra checks on the tested program
+}
+
+explain(){
+  explain_exit_code
+  explain_stdout
+  explain_stderr
+  explain_products
+  : Explain here more potential differences
+}
+
+teardown(){
+  : Undo here the actions of setup
+}

tests/hd-to-address-from-seed-test-vector1.t/stdin

@@ -0,0 +1 @@
+000102030405060708090a0b0c0d0e0f

tests/hd-to-address-from-seed-test-vector1.t/stdout

@@ -0,0 +1 @@
+15mKKb2eos1hWa6tisdPwwDC1a5J1y9nma

tests/hd-to-wif-from-seed-test-vector1.t/TESTRECIPE

@@ -0,0 +1,42 @@
+#!/bin/bash
+
+testname=hd-to-wif-from-seed-test-vector1.t
+command=hx
+args=( hd-to-wif )
+exit_code=0
+stdin_file=stdin
+stdout_file=stdout
+stderr_file=/dev/null
+sources=( )
+products=( )
+
+# Environment variables:
+env_vars=( )
+
+setup(){
+  : Perform here actions to be run before the tested program
+}
+
+munge(){
+  : Munge here the results of the tested program to ease the check
+}
+
+check(){
+  check_exit_code &&
+  check_stderr &&
+  check_stdout &&
+  check_products &&
+  : Perform here extra checks on the tested program
+}
+
+explain(){
+  explain_exit_code
+  explain_stdout
+  explain_stderr
+  explain_products
+  : Explain here more potential differences
+}
+
+teardown(){
+  : Undo here the actions of setup
+}

tests/hd-to-wif-from-seed-test-vector1.t/stdin

@@ -0,0 +1 @@
+000102030405060708090a0b0c0d0e0f

tests/hd-to-wif-from-seed-test-vector1.t/stdout

@@ -0,0 +1 @@
+L52XzL2cMkHxqxBXRyEpnPQZGUs3uKiL3R11XbAdHigRzDozKZeW