-- | Implementation to be used when compiled with GHC
module BIP32.GHC
  ( Prv
  , prv
  , unPrv
  , prvToPub
  , addPrvTweak

  , Pub
  , pub
  , unPub
  , addPubTweak

  , Tweak
  , tweak
  ) where

import Control.Monad
import qualified Crypto.Secp256k1 as K
import qualified Data.ByteString as B

--------------------------------------------------------------------------------

-- | Private key.
--
-- Construct with 'prv'.
newtype Prv = Prv K.SecKey
  deriving (Prv -> Prv -> Bool
(Prv -> Prv -> Bool) -> (Prv -> Prv -> Bool) -> Eq Prv
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Prv -> Prv -> Bool
$c/= :: Prv -> Prv -> Bool
== :: Prv -> Prv -> Bool
$c== :: Prv -> Prv -> Bool
Eq, Int -> Prv -> ShowS
[Prv] -> ShowS
Prv -> String
(Int -> Prv -> ShowS)
-> (Prv -> String) -> ([Prv] -> ShowS) -> Show Prv
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Prv] -> ShowS
$cshowList :: [Prv] -> ShowS
show :: Prv -> String
$cshow :: Prv -> String
showsPrec :: Int -> Prv -> ShowS
$cshowsPrec :: Int -> Prv -> ShowS
Show)

-- | Obtain the 32 raw bytes inside a 'Prv'. See 'prv'.
unPrv :: Prv -> B.ByteString
{-# INLINE unPrv #-}
unPrv :: Prv -> ByteString
unPrv (Prv x :: SecKey
x) = SecKey -> ByteString
K.getSecKey SecKey
x

-- | Construct a 'Prv' key from its raw bytes.
--
-- * 32 bytes containing \(ser_{256}(k)\).
--
-- See Bitcoin's [BIP-0032](https://github.com/bitcoin/bips/blob/master/bip-0032.mediawiki)
-- for details.
--
-- 'Nothing' if something is not satisfied.
prv :: B.ByteString -> Maybe Prv
{-# INLINE prv #-}
prv :: ByteString -> Maybe Prv
prv x :: ByteString
x = SecKey -> Prv
Prv (SecKey -> Prv) -> Maybe SecKey -> Maybe Prv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe SecKey
K.secKey ByteString
x

-- | Obtain the 'Pub' key for 'Prv'.
prvToPub :: Prv -> Pub
{-# INLINE prvToPub #-}
prvToPub :: Prv -> Pub
prvToPub (Prv x :: SecKey
x) = PubKey -> Pub
Pub (SecKey -> PubKey
K.derivePubKey SecKey
x)

-- | Tweak a 'Prv'ate key by adding 'Tweak' times the generator to it.
addPrvTweak :: Prv -> Tweak -> Maybe Prv
{-# INLINE addPrvTweak #-}
addPrvTweak :: Prv -> Tweak -> Maybe Prv
addPrvTweak (Prv p :: SecKey
p) (Tweak t :: Tweak
t) = SecKey -> Prv
Prv (SecKey -> Prv) -> Maybe SecKey -> Maybe Prv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SecKey -> Tweak -> Maybe SecKey
K.tweakAddSecKey SecKey
p Tweak
t

--------------------------------------------------------------------------------

-- | Public key.
--
-- Construct with 'pub'.
newtype Pub = Pub K.PubKey
  deriving (Pub -> Pub -> Bool
(Pub -> Pub -> Bool) -> (Pub -> Pub -> Bool) -> Eq Pub
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pub -> Pub -> Bool
$c/= :: Pub -> Pub -> Bool
== :: Pub -> Pub -> Bool
$c== :: Pub -> Pub -> Bool
Eq, Int -> Pub -> ShowS
[Pub] -> ShowS
Pub -> String
(Int -> Pub -> ShowS)
-> (Pub -> String) -> ([Pub] -> ShowS) -> Show Pub
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pub] -> ShowS
$cshowList :: [Pub] -> ShowS
show :: Pub -> String
$cshow :: Pub -> String
showsPrec :: Int -> Pub -> ShowS
$cshowsPrec :: Int -> Pub -> ShowS
Show)

-- | Obtain the 33 raw bytes inside a 'Pub'. See 'pub'.
--
-- Corresponds to BIP-0032's \(ser_{P}(P)\).
unPub :: Pub -> B.ByteString
{-# INLINE unPub #-}
unPub :: Pub -> ByteString
unPub (Pub x :: PubKey
x) = Bool -> PubKey -> ByteString
K.exportPubKey Bool
True PubKey
x

-- | Construct a 'Pub' key from its raw bytes.
--
-- * 33 bytes in total, containing \(ser_{P}(P)\).
--
-- * The leftmost byte is either @0x02@ or @0x03@, depending on the parity
-- of the omitted @y@ coordinate.
--
-- * The remaining 32 bytes are \(ser_{256}(x)\).
--
-- See Bitcoin's [BIP-0032](https://github.com/bitcoin/bips/blob/master/bip-0032.mediawiki)
-- for details.
--
-- 'Nothing' if something is not satisfied.
pub :: B.ByteString -> Maybe Pub
{-# INLINE pub #-}
pub :: ByteString -> Maybe Pub
pub x :: ByteString
x = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteString -> Int
B.length ByteString
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 33)
  PubKey -> Pub
Pub (PubKey -> Pub) -> Maybe PubKey -> Maybe Pub
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe PubKey
K.importPubKey ByteString
x

-- | Tweak a 'Pub'lic key by adding 'Tweak' times the generator to it.
addPubTweak :: Pub -> Tweak -> Maybe Pub
{-# INLINE addPubTweak #-}
addPubTweak :: Pub -> Tweak -> Maybe Pub
addPubTweak (Pub p :: PubKey
p) (Tweak t :: Tweak
t) = PubKey -> Pub
Pub (PubKey -> Pub) -> Maybe PubKey -> Maybe Pub
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PubKey -> Tweak -> Maybe PubKey
K.tweakAddPubKey PubKey
p Tweak
t

--------------------------------------------------------------------------------

newtype Tweak = Tweak K.Tweak

-- | Convert a 32-Byte 'B.ByteString' to a 'Tweak'.
tweak :: B.ByteString -> Maybe Tweak
{-# INLINE tweak #-}
tweak :: ByteString -> Maybe Tweak
tweak x :: ByteString
x = Tweak -> Tweak
Tweak (Tweak -> Tweak) -> Maybe Tweak -> Maybe Tweak
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe Tweak
K.tweak ByteString
x