{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- | Implementation to be used when compiled with GHC
module Bitcoin.Keys.GHC
  ( Prv
  , parsePrv
  , prvRaw
  , prvToPub
  , prvAddTweak

  , Pub
  , parsePubCompressed
  , pubCompressed
  , pubUncompressed
  , pubAddTweak

  , Tweak
  , parseTweak
  ) where

import Control.Monad
import qualified Crypto.Secp256k1 as K
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy.Char8 as BL8
import qualified Data.ByteString.Builder as BB

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

-- | Private key.
--
-- Construct with 'parsePrv'.
newtype Prv = Prv K.SecKey
  deriving newtype (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)

instance Ord Prv where
  compare :: Prv -> Prv -> Ordering
compare a :: Prv
a b :: Prv
b = ByteString -> ByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Prv -> ByteString
prvRaw Prv
a) (Prv -> ByteString
prvRaw Prv
b)
  {-# INLINE compare #-}

-- | Big-endian base-16.
instance Show Prv where
  showsPrec :: Int -> Prv -> ShowS
showsPrec n :: Int
n p :: Prv
p = Bool -> ShowS -> ShowS
showParen (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString "Prv " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    String -> ShowS
forall a. Monoid a => a -> a -> a
mappend (ByteString -> String
BL8.unpack (Builder -> ByteString
BB.toLazyByteString (ByteString -> Builder
BB.byteStringHex (Prv -> ByteString
prvRaw Prv
p))))

-- | Obtain the 32 raw bytes inside a 'Prv' (big-endian).
--
-- @
-- 'Just' == 'parsePrv' . 'prvRaw'
-- @
prvRaw :: Prv -> B.ByteString
{-# INLINE prvRaw #-}
prvRaw :: Prv -> ByteString
prvRaw (Prv x :: SecKey
x) = SecKey -> ByteString
K.getSecKey SecKey
x

-- | Construct a 'Prv' key from its raw 32 bytes (big-endian).
--
-- Returns 'Nothing' if something is not satisfied.
--
-- @
-- 'Just' == 'parsePrv' . 'prvRaw'
-- @
parsePrv :: B.ByteString -> Maybe Prv
{-# INLINE parsePrv #-}
parsePrv :: ByteString -> Maybe Prv
parsePrv 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
== 32)
  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.
--
-- Returns 'Nothing' if the resulting 'Prv' would be invalid.
--
-- @
-- 'pubAddTweak' t . 'prvToPub' == fmap 'prvToPub' . 'prvAddTweak' t
-- @
prvAddTweak :: Tweak -> Prv -> Maybe Prv
{-# INLINE prvAddTweak #-}
prvAddTweak :: Tweak -> Prv -> Maybe Prv
prvAddTweak (Tweak t :: Tweak
t) (Prv p :: SecKey
p) = 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 'Bitcoin.Keys.parsePub'.
newtype Pub = Pub K.PubKey
  deriving newtype (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)

instance Ord Pub where
  compare :: Pub -> Pub -> Ordering
compare a :: Pub
a b :: Pub
b = ByteString -> ByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Pub -> ByteString
pubCompressed Pub
a) (Pub -> ByteString
pubCompressed Pub
b)
  {-# INLINE compare #-}

-- | SEC compressed base-16.
instance Show Pub where
  showsPrec :: Int -> Pub -> ShowS
showsPrec n :: Int
n p :: Pub
p = Bool -> ShowS -> ShowS
showParen (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString "Pub " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    String -> ShowS
forall a. Monoid a => a -> a -> a
mappend (ByteString -> String
BL8.unpack (Builder -> ByteString
BB.toLazyByteString (ByteString -> Builder
BB.byteStringHex (Pub -> ByteString
pubCompressed Pub
p))))

-- | Obtain the 33-bytes contatining the SEC compressed 'Pub'lic key.
--
-- @
-- 'Just' == 'Bitcoin.Keys.parsePub' . 'pubCompressed'
-- @
pubCompressed :: Pub -> B.ByteString
{-# INLINE pubCompressed #-}
pubCompressed :: Pub -> ByteString
pubCompressed (Pub x :: PubKey
x) = Bool -> PubKey -> ByteString
K.exportPubKey Bool
True PubKey
x

-- | Obtain the 65-bytes contatining the SEC uncompressed 'Pub'lic key.
--
-- @
-- 'Just' == 'Bitcoin.Keys.parsePub' . 'pubUncompressed'
-- @
pubUncompressed :: Pub -> B.ByteString
{-# INLINE pubUncompressed #-}
pubUncompressed :: Pub -> ByteString
pubUncompressed (Pub x :: PubKey
x) = Bool -> PubKey -> ByteString
K.exportPubKey Bool
False PubKey
x

-- | Builds a public key from its compressed SEC-encoded bytes.
--
-- * Compressed keys are 33 bytes. The leftmost byte is @0x02@ if the @y@
-- coordinate is even, or @0x03@ if odd. The remaining 32 bytes
-- are the big-endian encoded @x@ coordinate.
--
-- @
-- 'Just' == 'Bitcoin.Keys.parsePub' . 'pubCompressed'
-- @
parsePubCompressed :: B.ByteString -> Maybe Pub
{-# INLINE parsePubCompressed #-}
parsePubCompressed :: ByteString -> Maybe Pub
parsePubCompressed 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.
--
-- Returns 'Nothing' if the resulting 'Pub' would be invalid.
--
-- @
-- 'pubAddTweak' t . 'prvToPub' == fmap 'prvToPub' . 'prvAddTweak' t
-- @
pubAddTweak :: Tweak -> Pub -> Maybe Pub
{-# INLINE pubAddTweak #-}
pubAddTweak :: Tweak -> Pub -> Maybe Pub
pubAddTweak (Tweak t :: Tweak
t) (Pub p :: PubKey
p) = 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

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

-- | A 32-byte number used to modify a 'Pub' or 'Prv' using 'prvAddTweak'
-- or 'pubAddTweak'.
newtype Tweak = Tweak K.Tweak
  deriving newtype (Tweak -> Tweak -> Bool
(Tweak -> Tweak -> Bool) -> (Tweak -> Tweak -> Bool) -> Eq Tweak
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tweak -> Tweak -> Bool
$c/= :: Tweak -> Tweak -> Bool
== :: Tweak -> Tweak -> Bool
$c== :: Tweak -> Tweak -> Bool
Eq)

instance Ord Tweak where
  compare :: Tweak -> Tweak -> Ordering
compare (Tweak a :: Tweak
a) (Tweak b :: Tweak
b) = ByteString -> ByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Tweak -> ByteString
K.getTweak Tweak
a) (Tweak -> ByteString
K.getTweak Tweak
b)

-- | Big-endian base-16.
instance Show Tweak where
  showsPrec :: Int -> Tweak -> ShowS
showsPrec n :: Int
n (Tweak x :: Tweak
x) = Bool -> ShowS -> ShowS
showParen (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString "Tweak " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    String -> ShowS
forall a. Monoid a => a -> a -> a
mappend (ByteString -> String
BL8.unpack (Builder -> ByteString
BB.toLazyByteString (ByteString -> Builder
BB.byteStringHex (Tweak -> ByteString
K.getTweak Tweak
x))))

-- | Construct a 'Tweak' from its raw 32 bytes (big-endian).
--
-- Returns 'Nothing' if something is not satisfied.
parseTweak :: B.ByteString -> Maybe Tweak
{-# INLINE parseTweak #-}
parseTweak :: ByteString -> Maybe Tweak
parseTweak 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
== 32)
  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