{-# LANGUAGE CPP #-}

-- | This module exports tools for working with Bitcoin keys.
module Bitcoin.Keys
  ( -- * Private
    I.Prv
  , I.parsePrv
  , I.prvRaw
  , I.prvToPub

   -- * Public
  , I.Pub
  , parsePub
  , I.pubCompressed
  , I.pubUncompressed

   -- * Tweak
  , I.Tweak
  , I.parseTweak
  , I.pubAddTweak
  , I.prvAddTweak
  ) where

import Control.Applicative
import Control.Monad
import Data.Bits
import qualified Data.ByteString as B

#ifdef ghcjs_HOST_OS
import qualified Bitcoin.Keys.GHCJS as I
#else
import qualified Bitcoin.Keys.GHC as I
#endif

-- | Construct a 'I.Pub' key from either its compressed or uncompressed 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.
--
-- * Uncompressed keys are 65 bytes. The leftmost byte is @0x04@. The next 32
-- bytes are the big-endian encoded @x@ cordinate. The next 32 bytes are the
-- big-endian encoded @y@ coordinate.
--
-- Returns 'Nothing' if something is not satisfied.
parsePub :: B.ByteString -> Maybe I.Pub
{-# INLINE parsePub #-}
parsePub :: ByteString -> Maybe Pub
parsePub b :: ByteString
b = ByteString -> Maybe Pub
I.parsePubCompressed ByteString
b Maybe Pub -> Maybe Pub -> Maybe Pub
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Maybe Pub
parsePubUncompressed ByteString
b

-- | Builds a public key from its uncompressed SEC-encoded bytes.
--
-- Uncompressed keys are 65 bytes. The leftmost byte is @0x04@. The next 32
-- bytes are the big-endian encoded @x@ cordinate. The next 32 bytes are the
-- big-endian encoded @y@ coordinate.
--
-- Returns 'Nothing' if something is not satisfied.
parsePubUncompressed :: B.ByteString -> Maybe I.Pub
{-# INLINE parsePubUncompressed #-}
parsePubUncompressed :: ByteString -> Maybe Pub
parsePubUncompressed b :: ByteString
b = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteString -> Int
B.length ByteString
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 65 Bool -> Bool -> Bool
&& ByteString -> Int -> Word8
B.index ByteString
b 0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 0x04)
  let w0 :: Word8
w0 = 0x02 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ (ByteString -> Int -> Word8
B.index ByteString
b 64 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0x01)
  ByteString -> Maybe Pub
I.parsePubCompressed (Word8 -> ByteString -> ByteString
B.cons Word8
w0 (Int -> ByteString -> ByteString
B.take 32 (Int -> ByteString -> ByteString
B.drop 1 ByteString
b)))