{-# LANGUAGE GADTs #-} module Network.Haskoin.Crypto.ExtendedKeys ( XPubKey(..) , XPrvKey(..) , ChainCode , KeyIndex , DerivationException(..) , makeXPrvKey , deriveXPubKey , prvSubKey , pubSubKey , hardSubKey , xPrvIsHard , xPubIsHard , xPrvChild , xPubChild , xPubID , xPrvID , xPubFP , xPrvFP , xPubAddr , xPubExport , xPrvExport , xPubImport , xPrvImport , xPrvWif -- Helpers , prvSubKeys , pubSubKeys , hardSubKeys , deriveAddr , deriveAddrs , deriveMSAddr , deriveMSAddrs , cycleIndex -- Custom derivations , DerivPathI(..) , HardOrMixed , MixedOrSoft , DerivPath , HardPath , SoftPath , pathToStr , parsePath , parseHard , parseSoft , toHard , toSoft , toMixed , (++/), (++|) , derivePath , derivePubPath , derivePathE , derivePathAddr , derivePathAddrs , derivePathMSAddr , derivePathMSAddrs ) where import Control.DeepSeq (NFData, rnf) import Control.Monad (mzero, guard, unless, (<=<)) import Control.Exception (Exception, throw) import qualified Crypto.Secp256k1 as EC import Data.Aeson (Value(String), FromJSON, ToJSON, parseJSON, toJSON, withText) import Data.Binary (Binary, get, put) import Data.Binary.Get (Get, getWord8, getWord32be) import Data.Binary.Put (Put, putWord8, putWord32be) import Data.Word (Word8, Word32) import Data.Bits (setBit, testBit, clearBit) import Data.List.Split (splitOn) import Data.Maybe (fromMaybe) import Data.String (IsString, fromString) import Data.String.Conversions (cs) import Data.Typeable (Typeable) import Data.ByteString (ByteString) import qualified Data.ByteString as BS (append, take) import Text.Read (readPrec, parens, lexP, pfail) import qualified Text.Read as Read (Lexeme(Ident, String)) import Network.Haskoin.Util import Network.Haskoin.Constants import Network.Haskoin.Script.Parser import Network.Haskoin.Crypto.Keys import Network.Haskoin.Crypto.Hash import Network.Haskoin.Crypto.Base58 {- See BIP32 for details: https://en.bitcoin.it/wiki/BIP_0032 -} -- | A derivation exception is thrown in the very unlikely event that a -- derivation is invalid. data DerivationException = DerivationException String deriving (Eq, Read, Show, Typeable) instance Exception DerivationException type ChainCode = Hash256 type KeyIndex = Word32 -- | Data type representing an extended BIP32 private key. An extended key -- is a node in a tree of key derivations. It has a depth in the tree, a -- parent node and an index to differentiate it from other siblings. data XPrvKey = XPrvKey { xPrvDepth :: !Word8 -- ^ Depth in the tree of key derivations. , xPrvParent :: !Word32 -- ^ Fingerprint of the parent key. , xPrvIndex :: !KeyIndex -- ^ Key derivation index. , xPrvChain :: !ChainCode -- ^ Chain code. , xPrvKey :: !PrvKeyC -- ^ The private key of this extended key node. } deriving (Eq) -- TODO: Test instance Show XPrvKey where showsPrec d k = showParen (d > 10) $ showString "XPrvKey " . shows (xPrvExport k) -- TODO: Test instance Read XPrvKey where readPrec = parens $ do Read.Ident "XPrvKey" <- lexP Read.String str <- lexP maybe pfail return $ xPrvImport $ cs str -- TODO: Test instance IsString XPrvKey where fromString = fromMaybe e . xPrvImport . cs where e = error "Could not decode extended private key" instance NFData XPrvKey where rnf (XPrvKey d p i c k) = rnf d `seq` rnf p `seq` rnf i `seq` rnf c `seq` rnf k instance ToJSON XPrvKey where toJSON = String . cs . xPrvExport instance FromJSON XPrvKey where parseJSON = withText "xprvkey" $ maybe mzero return . xPrvImport . cs -- | Data type representing an extended BIP32 public key. data XPubKey = XPubKey { xPubDepth :: !Word8 -- ^ Depth in the tree of key derivations. , xPubParent :: !Word32 -- ^ Fingerprint of the parent key. , xPubIndex :: !KeyIndex -- ^ Key derivation index. , xPubChain :: !ChainCode -- ^ Chain code. , xPubKey :: !PubKeyC -- ^ The public key of this extended key node. } deriving (Eq) -- TODO: Test instance Show XPubKey where showsPrec d k = showParen (d > 10) $ showString "XPubKey " . shows (xPubExport k) -- TODO: Test instance Read XPubKey where readPrec = parens $ do Read.Ident "XPubKey" <- lexP Read.String str <- lexP maybe pfail return $ xPubImport $ cs str -- TODO: Test instance IsString XPubKey where fromString = fromMaybe e . xPubImport . cs where e = error "Could not import extended public key" instance NFData XPubKey where rnf (XPubKey d p i c k) = rnf d `seq` rnf p `seq` rnf i `seq` rnf c `seq` rnf k instance ToJSON XPubKey where toJSON = String . cs . xPubExport instance FromJSON XPubKey where parseJSON = withText "xpubkey" $ maybe mzero return . xPubImport . cs -- | Build a BIP32 compatible extended private key from a bytestring. This will -- produce a root node (depth=0 and parent=0). makeXPrvKey :: ByteString -> XPrvKey makeXPrvKey bs = XPrvKey 0 0 0 c k where (p, c) = split512 $ hmac512 "Bitcoin seed" bs k = fromMaybe err $ makePrvKeyC <$> EC.secKey (getHash256 p) err = throw $ DerivationException "Invalid seed" -- | Derive an extended public key from an extended private key. This function -- will preserve the depth, parent, index and chaincode fields of the extended -- private keys. deriveXPubKey :: XPrvKey -> XPubKey deriveXPubKey (XPrvKey d p i c k) = XPubKey d p i c (derivePubKey k) -- | Compute a private, soft child key derivation. A private soft derivation -- will allow the equivalent extended public key to derive the public key for -- this child. Given a parent key /m/ and a derivation index /i/, this function -- will compute m\/i\/. -- -- Soft derivations allow for more flexibility such as read-only wallets. -- However, care must be taken not the leak both the parent extended public key -- and one of the extended child private keys as this would compromise the -- extended parent private key. prvSubKey :: XPrvKey -- ^ Extended parent private key -> KeyIndex -- ^ Child derivation index -> XPrvKey -- ^ Extended child private key prvSubKey xkey child | child >= 0 && child < 0x80000000 = XPrvKey (xPrvDepth xkey + 1) (xPrvFP xkey) child c k | otherwise = error "Invalid child derivation index" where pK = xPubKey $ deriveXPubKey xkey msg = BS.append (encode' pK) (encode' child) (a, c) = split512 $ hmac512 (encode' $ xPrvChain xkey) msg k = fromMaybe err $ tweakPrvKeyC (xPrvKey xkey) a err = throw $ DerivationException "Invalid prvSubKey derivation" -- | Compute a public, soft child key derivation. Given a parent key /M/ -- and a derivation index /i/, this function will compute M\/i\/. pubSubKey :: XPubKey -- ^ Extended Parent public key -> KeyIndex -- ^ Child derivation index -> XPubKey -- ^ Extended child public key pubSubKey xKey child | child >= 0 && child < 0x80000000 = XPubKey (xPubDepth xKey + 1) (xPubFP xKey) child c pK | otherwise = error "Invalid child derivation index" where msg = BS.append (encode' $ xPubKey xKey) (encode' child) (a, c) = split512 $ hmac512 (encode' $ xPubChain xKey) msg pK = fromMaybe err $ tweakPubKeyC (xPubKey xKey) a err = throw $ DerivationException "Invalid pubSubKey derivation" -- | Compute a hard child key derivation. Hard derivations can only be computed -- for private keys. Hard derivations do not allow the parent public key to -- derive the child public keys. However, they are safer as a breach of the -- parent public key and child private keys does not lead to a breach of the -- parent private key. Given a parent key /m/ and a derivation index /i/, this -- function will compute m\/i'\/. hardSubKey :: XPrvKey -- ^ Extended Parent private key -> KeyIndex -- ^ Child derivation index -> XPrvKey -- ^ Extended child private key hardSubKey xkey child | child >= 0 && child < 0x80000000 = XPrvKey (xPrvDepth xkey + 1) (xPrvFP xkey) i c k | otherwise = error "Invalid child derivation index" where i = setBit child 31 msg = BS.append (bsPadPrvKey $ xPrvKey xkey) (encode' i) (a, c) = split512 $ hmac512 (encode' $ xPrvChain xkey) msg k = fromMaybe err $ tweakPrvKeyC (xPrvKey xkey) a err = throw $ DerivationException "Invalid hardSubKey derivation" -- | Returns True if the extended private key was derived through a hard -- derivation. xPrvIsHard :: XPrvKey -> Bool xPrvIsHard k = testBit (xPrvIndex k) 31 -- | Returns True if the extended public key was derived through a hard -- derivation. xPubIsHard :: XPubKey -> Bool xPubIsHard k = testBit (xPubIndex k) 31 -- | Returns the derivation index of this extended private key without the hard -- bit set. xPrvChild :: XPrvKey -> KeyIndex xPrvChild k = clearBit (xPrvIndex k) 31 -- | Returns the derivation index of this extended public key without the hard -- bit set. xPubChild :: XPubKey -> KeyIndex xPubChild k = clearBit (xPubIndex k) 31 -- | Computes the key identifier of an extended private key. xPrvID :: XPrvKey -> Hash160 xPrvID = xPubID . deriveXPubKey -- | Computes the key identifier of an extended public key. xPubID :: XPubKey -> Hash160 xPubID = hash160 . getHash256 . hash256 . encode' . xPubKey -- | Computes the key fingerprint of an extended private key. xPrvFP :: XPrvKey -> Word32 xPrvFP = decode' . BS.take 4 . getHash160 . xPrvID -- | Computes the key fingerprint of an extended public key. xPubFP :: XPubKey -> Word32 xPubFP = decode' . BS.take 4 . getHash160 . xPubID -- | Computer the 'Address' of an extended public key. xPubAddr :: XPubKey -> Address xPubAddr = pubKeyAddr . xPubKey -- | Exports an extended private key to the BIP32 key export format (base 58). xPrvExport :: XPrvKey -> ByteString xPrvExport = encodeBase58Check . encode' -- | Exports an extended public key to the BIP32 key export format (base 58). xPubExport :: XPubKey -> ByteString xPubExport = encodeBase58Check . encode' -- | Decodes a BIP32 encoded extended private key. This function will fail if -- invalid base 58 characters are detected or if the checksum fails. xPrvImport :: ByteString -> Maybe XPrvKey xPrvImport = decodeToMaybe <=< decodeBase58Check -- | Decodes a BIP32 encoded extended public key. This function will fail if -- invalid base 58 characters are detected or if the checksum fails. xPubImport :: ByteString -> Maybe XPubKey xPubImport = decodeToMaybe <=< decodeBase58Check -- | Export an extended private key to WIF (Wallet Import Format). xPrvWif :: XPrvKey -> ByteString xPrvWif = toWif . xPrvKey instance Binary XPrvKey where get = do ver <- getWord32be unless (ver == extSecretPrefix) $ fail $ "Get: Invalid version for extended private key" dep <- getWord8 par <- getWord32be idx <- getWord32be chn <- get prv <- getPadPrvKey return $ XPrvKey dep par idx chn prv put k = do putWord32be extSecretPrefix putWord8 $ xPrvDepth k putWord32be $ xPrvParent k putWord32be $ xPrvIndex k put $ xPrvChain k putPadPrvKey $ xPrvKey k instance Binary XPubKey where get = do ver <- getWord32be unless (ver == extPubKeyPrefix) $ fail $ "Get: Invalid version for extended public key" dep <- getWord8 par <- getWord32be idx <- getWord32be chn <- get pub <- get return $ XPubKey dep par idx chn pub put k = do putWord32be extPubKeyPrefix putWord8 $ xPubDepth k putWord32be $ xPubParent k putWord32be $ xPubIndex k put $ xPubChain k put $ xPubKey k {- Derivation helpers -} -- | Cyclic list of all private soft child key derivations of a parent key -- starting from an offset index. prvSubKeys :: XPrvKey -> KeyIndex -> [(XPrvKey, KeyIndex)] prvSubKeys k = map (\i -> (prvSubKey k i, i)) . cycleIndex -- | Cyclic list of all public soft child key derivations of a parent key -- starting from an offset index. pubSubKeys :: XPubKey -> KeyIndex -> [(XPubKey, KeyIndex)] pubSubKeys k = map (\i -> (pubSubKey k i, i)) . cycleIndex -- | Cyclic list of all hard child key derivations of a parent key starting -- from an offset index. hardSubKeys :: XPrvKey -> KeyIndex -> [(XPrvKey, KeyIndex)] hardSubKeys k = map (\i -> (hardSubKey k i, i)) . cycleIndex -- | Derive an address from a public key and an index. The derivation type -- is a public, soft derivation. deriveAddr :: XPubKey -> KeyIndex -> (Address, PubKeyC) deriveAddr k i = (xPubAddr key, xPubKey key) where key = pubSubKey k i -- | Cyclic list of all addresses derived from a public key starting from an -- offset index. The derivation types are public, soft derivations. deriveAddrs :: XPubKey -> KeyIndex -> [(Address, PubKeyC, KeyIndex)] deriveAddrs k = map f . cycleIndex where f i = let (a, key) = deriveAddr k i in (a, key, i) -- | Derive a multisig address from a list of public keys, the number of -- required signatures (m) and a derivation index. The derivation type is a -- public, soft derivation. deriveMSAddr :: [XPubKey] -> Int -> KeyIndex -> (Address, RedeemScript) deriveMSAddr keys m i = (scriptAddr rdm, rdm) where rdm = sortMulSig $ PayMulSig k m k = map (toPubKeyG . xPubKey . flip pubSubKey i) keys -- | Cyclic list of all multisig addresses derived from a list of public keys, -- a number of required signatures (m) and starting from an offset index. The -- derivation type is a public, soft derivation. deriveMSAddrs :: [XPubKey] -> Int -> KeyIndex -> [(Address, RedeemScript, KeyIndex)] deriveMSAddrs keys m = map f . cycleIndex where f i = let (a, rdm) = deriveMSAddr keys m i in (a, rdm, i) cycleIndex :: KeyIndex -> [KeyIndex] cycleIndex i | i == 0 = cycle [0..0x7fffffff] | i < 0x80000000 = cycle $ [i..0x7fffffff] ++ [0..(i-1)] | otherwise = error $ "cycleIndex: invalid index " ++ (show i) {- Custom derivations -} data Hard data Mixed data Soft type HardPath = DerivPathI Hard type DerivPath = DerivPathI Mixed type SoftPath = DerivPathI Soft class HardOrMixed a instance HardOrMixed Hard instance HardOrMixed Mixed class MixedOrSoft a instance MixedOrSoft Mixed instance MixedOrSoft Soft data DerivPathI t where (:|) :: HardOrMixed t => !HardPath -> !KeyIndex -> DerivPathI t (:/) :: MixedOrSoft t => !(DerivPathI t) -> !KeyIndex -> DerivPathI t Deriv :: DerivPathI t DerivPrv :: DerivPathI t DerivPub :: DerivPathI t instance NFData (DerivPathI t) where rnf p = case p of next :| i -> rnf i `seq` rnf next next :/ i -> rnf i `seq` rnf next Deriv -> () DerivPrv -> () DerivPub -> () instance Eq (DerivPathI t) where (nextA :| iA) == (nextB :| iB) = iA == iB && nextA == nextB (nextA :/ iA) == (nextB :/ iB) = iA == iB && nextA == nextB Deriv == Deriv = True DerivPrv == DerivPrv = True DerivPub == DerivPub = True _ == _ = False -- TODO: Test pathToStr :: DerivPathI t -> String pathToStr p = case p of next :| i -> concat [ pathToStr next, "/", show i, "'" ] next :/ i -> concat [ pathToStr next, "/", show i ] Deriv -> "" DerivPrv -> "m" DerivPub -> "M" -- TODO: Test instance Show DerivPath where showsPrec d p = showParen (d > 10) $ showString "DerivPath " . shows (pathToStr p) -- TODO: Test instance Show HardPath where showsPrec d p = showParen (d > 10) $ showString "HardPath " . shows (pathToStr p) -- TODO: Test instance Show SoftPath where showsPrec d p = showParen (d > 10) $ showString "SoftPath " . shows (pathToStr p) -- TODO: Test instance Read DerivPath where readPrec = parens $ do Read.Ident "DerivPath" <- lexP Read.String str <- lexP maybe pfail return $ parsePath str -- TODO: Test instance Read HardPath where readPrec = parens $ do Read.Ident "HardPath" <- lexP Read.String str <- lexP maybe pfail return $ parseHard str -- TODO: Test instance Read SoftPath where readPrec = parens $ do Read.Ident "SoftPath" <- lexP Read.String str <- lexP maybe pfail return $ parseSoft str -- TODO: Test instance IsString DerivPath where fromString = fromMaybe e . parsePath where e = error "Could not parse derivation path" -- TODO: Test instance IsString HardPath where fromString = fromMaybe e . parseHard where e = error "Could not parse hard derivation path" -- TODO: Test instance IsString SoftPath where fromString = fromMaybe e . parseSoft where e = error "Could not parse soft derivation path" instance FromJSON DerivPath where parseJSON = withText "DerivPath" $ \str -> case parsePath $ cs str of Just p -> return p _ -> mzero instance FromJSON HardPath where parseJSON = withText "HardPath" $ \str -> case parseHard $ cs str of Just p -> return p _ -> mzero instance FromJSON SoftPath where parseJSON = withText "SoftPath" $ \str -> case parseSoft $ cs str of Just p -> return p _ -> mzero instance ToJSON (DerivPathI t) where toJSON = String . cs . pathToStr -- | Parse derivation path string for extended key. -- Forms: “m/0'/2”, “M/2/3/4”. parsePath :: String -> Maybe DerivPath parsePath str = do ds <- reverse <$> mapM f xs let (s,h) = break fst ds -- No soft derivations in the hard branch guard $ null $ filter (not . fst) h hPath <- pHard $ map snd h pSoft hPath $ map snd s where (x:xs) = splitOn "/" str f deriv = case reads deriv of [(i, "" )] -> (,) False <$> g i [(i, "'")] -> (,) True <$> g i _ -> Nothing g i = guard (i >=0 && i < 0x80000000) >> return i pSoft h (i:is) = (:/ i) <$> pSoft h is pSoft h [] = return h pHard :: HardOrMixed t => [KeyIndex] -> Maybe (DerivPathI t) pHard (i:is) = (:| i) <$> pHard is pHard [] = pEnd pEnd :: Maybe (DerivPathI t) pEnd = case x of "" -> Just Deriv "m" -> Just DerivPrv "M" -> Just DerivPub _ -> Nothing parseHard :: String -> Maybe HardPath parseHard = toHard <=< parsePath parseSoft :: String -> Maybe SoftPath parseSoft = toSoft <=< parsePath toHard :: DerivPathI t -> Maybe HardPath toHard p = case p of _ :/ _ -> Nothing next :| i -> Just $ next :| i Deriv -> Just Deriv DerivPrv -> Just DerivPrv DerivPub -> Just DerivPub toSoft :: DerivPathI t -> Maybe SoftPath toSoft p = case p of _ :| _ -> Nothing next :/ i -> (:/ i) <$> toSoft next Deriv -> Just Deriv DerivPrv -> Just DerivPrv DerivPub -> Just DerivPub toMixed :: DerivPathI t -> DerivPath toMixed p = case p of next :/ i -> (toMixed next) :/ i next :| i -> next :| i Deriv -> Deriv DerivPrv -> DerivPrv DerivPub -> DerivPub -- | Append a SoftPath to any derivation path. It is always type-safe to -- append a SoftPath to any derivation path. The result will be a mixed -- derivation path. (++/) :: DerivPathI t -> SoftPath -> DerivPath (++/) p1 p2 = go id p2 $ toMixed p1 where go f p = case p of next :/ i -> go (f . (:/ i)) next _ -> f -- | Append any type of derivation to a HardPath. It is always type-safe to -- append any type of path to a HardPath. The result will be a mixed derivation -- path. (++|) :: HardPath -> DerivPathI t -> DerivPath (++|) p1 p2 = go id (toMixed p2) $ toMixed p1 where go :: (DerivPath -> DerivPath) -> DerivPath -> (DerivPath -> DerivPath) go f p = case p of next :/ i -> go (f . (:/ i)) next next :| i -> go (f . (:| i) . fromMaybe err . toHard) $ toMixed next _ -> f err = error "Error while appending paths" -- | Derive a private key from a derivation path derivePath :: DerivPathI t -> XPrvKey -> XPrvKey derivePath path key = go id path $ key where -- Build the full derivation function starting from the end go :: (XPrvKey -> XPrvKey) -> DerivPathI t -> (XPrvKey -> XPrvKey) go f p = case p of next :| i -> go (f . flip hardSubKey i) next next :/ i -> go (f . flip prvSubKey i) next _ -> f -- | Derive a public key from a soft derivation path derivePubPath :: SoftPath -> XPubKey -> XPubKey derivePubPath path key = go id path $ key where -- Build the full derivation function starting from the end go f p = case p of next :/ i -> go (f . flip pubSubKey i) next _ -> f -- | Derive a key from a derivation path and return either a private or public -- key depending on the initial derivation constructor. If you parsed a string -- as m/ you will get a private key and if you parsed a string as M/ you will -- get a public key. If you used the neutral derivation constructor `Deriv`, a -- private key will be returned. derivePathE :: DerivPathI t -> XPrvKey -> Either XPubKey XPrvKey derivePathE path key = go id path $ key where -- Build the full derivation function starting from the end go :: (XPrvKey -> XPrvKey) -> DerivPathI t -> (XPrvKey -> Either XPubKey XPrvKey) go f p = case p of next :| i -> go (f . flip hardSubKey i) next next :/ i -> go (f . flip prvSubKey i) next -- Derive a public key as the last function DerivPub -> Left . deriveXPubKey . f _ -> Right . f -- | Derive an address from a given parent path. derivePathAddr :: XPubKey -> SoftPath -> KeyIndex -> (Address, PubKeyC) derivePathAddr key path i = deriveAddr (derivePubPath path key) i -- | Cyclic list of all addresses derived from a given parent path and starting -- from the given offset index. derivePathAddrs :: XPubKey -> SoftPath -> KeyIndex -> [(Address, PubKeyC, KeyIndex)] derivePathAddrs key path i = deriveAddrs (derivePubPath path key) i -- | Derive a multisig address from a given parent path. The number of required -- signatures (m in m of n) is also needed. derivePathMSAddr :: [XPubKey] -> SoftPath -> Int -> KeyIndex -> (Address, RedeemScript) derivePathMSAddr keys path m i = deriveMSAddr (map (derivePubPath path) keys) m i -- | Cyclic list of all multisig addresses derived from a given parent path and -- starting from the given offset index. The number of required signatures -- (m in m of n) is also needed. derivePathMSAddrs :: [XPubKey] -> SoftPath -> Int -> KeyIndex -> [(Address, RedeemScript, KeyIndex)] derivePathMSAddrs keys path m i = deriveMSAddrs (map (derivePubPath path) keys) m i {- Utilities for extended keys -} -- De-serialize HDW-specific private key getPadPrvKey :: Get PrvKeyC getPadPrvKey = do pad <- getWord8 unless (pad == 0x00) $ fail $ "Private key must be padded with 0x00" prvKeyGetMonad makePrvKeyC -- Compressed version -- Serialize HDW-specific private key putPadPrvKey :: PrvKeyC -> Put putPadPrvKey p = putWord8 0x00 >> prvKeyPutMonad p bsPadPrvKey :: PrvKeyC -> ByteString bsPadPrvKey = runPut' . putPadPrvKey