{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveGeneric #-} module Bitcoin.BIP32.Types ( -- * Key types RootPrv , RootPub , RootKeyId , External , Internal , ChildPair , ChildPub , ExtPub , ExtPrv , createRootPrv , fromRootPrv -- * Child key operations , IsChildKey(..) , HasKey(..) , KeyDeriveIndex , HasKeyIndex(..) -- * Util , keyId , fromExternalPair --, word32Index --, word31Index --, mkKeyIndex ) where import Bitcoin.Internal.Orphans () import Bitcoin.Internal.Util import qualified Network.Haskoin.Crypto as HC import qualified Network.Haskoin.Node as HN import Network.Haskoin.Crypto (DerivPathI(..)) import qualified Data.ByteString.Char8 as C8 import qualified Data.Serialize as Bin createRootPrv :: ByteString -> RootPrv createRootPrv = RootPrv . HC.makeXPrvKey -- | Source of all other key types newtype RootPrv = RootPrv HC.XPrvKey deriving (Generic, NFData, Serialize, FromJSON, ToJSON) -- | The public counterpart of a 'RootPrv' newtype RootPub = RootPub HC.XPubKey deriving (Eq, Show, Generic, NFData, Serialize, FromJSON, ToJSON) -- | Unique ID for a 'RootPrv'/'RootPub' pair newtype RootKeyId = RootKeyId HC.Hash256 deriving (Eq, Show, Generic, NFData, Serialize, FromJSON, ToJSON) class HasKeyId rk where keyId :: rk -> RootKeyId instance HasKeyId RootPub where keyId (RootPub xPub) = RootKeyId . HC.hash256 . Bin.encode $ xPub instance HasKeyId RootPrv where keyId = keyId . fromRootPrv fromRootPrv :: RootPrv -> RootPub fromRootPrv (RootPrv xPrv) = RootPub . HC.deriveXPubKey $ xPrv -- | A child key derived from a 'RootPrv' or 'RootPub' data ChildKey a = ChildKey a RootKeyId deriving (Eq, Show, Functor, Generic) -- | A key pair where the public part can be derived without knowledge of the private part -- (not safe if a single derived private key is exposed) data External a = External (ChildKey a) HC.SoftPath deriving (Eq, Show, Functor, Generic) -- | A key pair where the public part cannot be derived without knowledge of the private part -- (safe if a single derived private key is exposed) data Internal a = Internal (ChildKey a) HC.HardPath deriving (Eq, Show, Functor, Generic) -- | Key pair, containing both private and public extended keys. -- Derive subkeys using 'getKey' data ChildPair = ChildPair { pairPriv :: !HC.XPrvKey , pairPub' :: !HC.XPubKey } deriving (Eq, Show, Generic) -- | Public part only of a 'ChildPair' newtype ChildPub = ChildPub HC.XPubKey deriving (Eq, Show, Generic, NFData, Serialize, FromJSON, ToJSON) type ExtPub = External ChildPub type ExtPrv = External ChildPair -- | class IsChildKey sourceKey (t :: * -> *) k derivPath | t -> derivPath where -- Create top-level child key mkChild :: sourceKey -> derivPath -> t k instance IsChildKey RootPrv Internal ChildPair HC.HardPath where mkChild rk@(RootPrv k) path = Internal (childKeyWrap rk . fromChildPrv . HC.derivePath path $ k) path instance IsChildKey RootPrv External ChildPair HC.SoftPath where mkChild rk@(RootPrv k) path = External (childKeyWrap rk . fromChildPrv . HC.derivePath path $ k) path instance IsChildKey RootPrv External ChildPub HC.SoftPath where mkChild k = fmap fromPair . mkChild k instance IsChildKey RootPub External ChildPub HC.SoftPath where mkChild rk@(RootPub k) path = External hey path where hey = childKeyWrap rk . ChildPub . HC.derivePubPath path $ k fromChildPrv :: HC.XPrvKey -> ChildPair fromChildPrv prv = ChildPair prv (HC.deriveXPubKey prv) fromPair :: ChildPair -> ChildPub fromPair = ChildPub . pairPub' fromExternalPair :: External ChildPair -> External ChildPub fromExternalPair = fmap fromPair class HasKey t k key derivPath | t -> derivPath where getKey :: t k -> key instance HasKey Internal ChildPair (HC.PrvKeyC, HC.XPubKey) HC.HardPath where getKey (Internal (ChildKey (ChildPair k _) _) _) = (HC.xPrvKey k, HC.deriveXPubKey k) instance HasKey Internal ChildPair HC.PrvKeyC HC.HardPath where getKey pair = fst (getKey pair :: (HC.PrvKeyC, HC.XPubKey)) instance HasKey Internal ChildPair HC.XPubKey HC.HardPath where getKey pair = snd (getKey pair :: (HC.PrvKeyC, HC.XPubKey)) instance HasKey Internal ChildPair HC.PubKeyC HC.HardPath where getKey pair = HC.xPubKey $ getKey pair instance HasKey External ChildPair (HC.PrvKeyC, HC.XPubKey) HC.SoftPath where getKey (External (ChildKey (ChildPair k _) _) _) = (HC.xPrvKey k, HC.deriveXPubKey k) instance HasKey External ChildPair HC.PrvKeyC HC.SoftPath where getKey pair = fst (getKey pair :: (HC.PrvKeyC, HC.XPubKey)) instance HasKey External ChildPair HC.XPubKey HC.SoftPath where getKey pair = snd (getKey pair :: (HC.PrvKeyC, HC.XPubKey)) instance HasKey External ChildPair HC.PubKeyC HC.SoftPath where getKey pair = HC.xPubKey $ getKey pair instance HasKey External ChildPub HC.XPubKey HC.SoftPath where getKey (External (ChildKey (ChildPub pk) _) _) = pk instance HasKey External ChildPub HC.PubKeyC HC.SoftPath where getKey = HC.xPubKey . getKey -- ########## -- ### Serialization instance Serialize a => Serialize (ChildKey a) where get = ChildKey <$> get <*> get put (ChildKey key kId) = put key >> put kId instance Serialize a => Serialize (External a) where get = External <$> get <*> desSoftPath put (External a p) = put a >> serPath p instance Serialize a => Serialize (Internal a) where get = Internal <$> get <*> desHardPath put (Internal a p) = put a >> serPath p serPath :: DerivPathI t -> PutM () serPath sp = Bin.put (HN.VarInt . fromIntegral . C8.length $ strBuf) >> Bin.putByteString strBuf where strBuf = C8.pack $ HC.pathToStr sp desSoftPath :: Get HC.SoftPath desSoftPath = do strBuf <- varIntString maybe (fail $ "failed to parse SoftPath from string: " ++ show strBuf) return (HC.parseSoft strBuf) desHardPath :: Get HC.HardPath desHardPath = do strBuf <- varIntString maybe (fail $ "failed to parse HardPath from string: " ++ show strBuf) return (HC.parseHard strBuf) -- | Get 'HN.VarInt' length-prefixed 'String' varIntString :: Get String varIntString = do HN.VarInt len <- Bin.get C8.unpack <$> Bin.getByteString (fromIntegral len) -- |Key index for a BIP32 child key newtype KeyDeriveIndex = KeyDeriveIndex Word32 deriving (Eq, Show, Serialize, Ord, Num, Enum, Real, Integral, FromJSON, ToJSON, NFData) class HasKeyIndex a where getKeyIndex :: a -> KeyDeriveIndex instance HasKeyIndex HC.XPubKey where getKeyIndex = KeyDeriveIndex . HC.xPubIndex -- ########### -- ## UTIL childKeyWrap :: HasKeyId rk => rk -> a -> ChildKey a childKeyWrap rk a = ChildKey a (keyId rk) {- word32Index :: KeyDeriveIndex -> Word32 word32Index (KeyDeriveIndex i) = i -- | Ignore most significant bit word31Index :: KeyDeriveIndex -> Word32 word31Index (KeyDeriveIndex i) = i `mod` (2^31 :: Word32) mkKeyIndex :: Word32 -> Maybe KeyDeriveIndex mkKeyIndex i | i >= 0 && i < 0x80000000 = Just $ KeyDeriveIndex i | otherwise = Nothing -} instance FromJSON a => FromJSON (External a) instance FromJSON a => FromJSON (ChildKey a) instance ToJSON a => ToJSON (External a) instance ToJSON a => ToJSON (ChildKey a) instance NFData ChildPair instance NFData a => NFData (External a) instance NFData a => NFData (Internal a) instance NFData a => NFData (ChildKey a)