GHCJS.hs

{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE JavaScriptFFI #-}

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

  , Pub
  , pub
  , unPub
  , addPubTweak

  , Tweak
  , tweak

  , hmacSHA512
  , ripemd160
  , sha256
  ) where

import Control.Monad
import qualified Data.ByteString as B
import qualified Data.ByteString.Builder as BB
import qualified GHCJS.Buffer as Buf
import GHCJS.Types (JSVal)
import GHCJS.Nullable
import qualified JavaScript.TypedArray.ArrayBuffer as AB
import qualified JavaScript.TypedArray as TA

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

-- | Private key.
--
-- Construct with 'prv'.
newtype Prv = Prv TA.Uint8Array

instance Eq Prv where
  Prv a == Prv b =
    byteStringFromUint8Array a == byteStringFromUint8Array b

instance Show Prv where
  showsPrec n (Prv u) = showParen (n > 10) $
    let b = byteStringFromUint8Array u
    in showString "Prv " .
       showsPrec 0 (BB.toLazyByteString (BB.byteStringHex b))


-- | Obtain the 32 raw bytes inside a 'Prv'. See 'prv'.
unPrv :: Prv -> B.ByteString
{-# INLINE unPrv #-}
unPrv (Prv x) = byteStringFromUint8Array 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
prv b = do
  guard (B.length b == 32)
  let u = byteStringToUint8Array b
  guard (js_secp256k1_verifyPrv u)
  pure (Prv u)

foreign import javascript unsafe
  "h$bip32.secp256k1.verifyPrv($1)"
  js_secp256k1_verifyPrv :: TA.Uint8Array -> Bool

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

foreign import javascript unsafe
  "h$bip32.secp256k1.prvToPub($1)"
  js_secp256k1_prvToPub :: TA.Uint8Array -> TA.Uint8Array

-- | Tweak a 'Prv'ate key by adding 'Tweak' times the generator to it.
addPrvTweak :: Prv -> Tweak -> Maybe Prv
{-# INLINE addPrvTweak #-}
addPrvTweak (Prv p) (Tweak t) = do
  jsv <- nullableToMaybe (js_secp256k1_addPrvTweak p t)
  pure $ Prv (js_unsafe_JSVal_to_UInt8Array jsv)

foreign import javascript unsafe
  "h$bip32.secp256k1.addPrvTweak($1, $2)"
  js_secp256k1_addPrvTweak :: TA.Uint8Array  -- ^ Private key.
                           -> TA.Uint8Array  -- ^ Tweak.
                           -> Nullable JSVal -- ^ Nullable Uint8Array

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

-- | Public key.
--
-- Construct with 'pub'.
newtype Pub = Pub TA.Uint8Array

instance Eq Pub where
  Pub a == Pub b =
    byteStringFromUint8Array a == byteStringFromUint8Array b

instance Show Pub where
  showsPrec n (Pub u) = showParen (n > 10) $
    let b = byteStringFromUint8Array u
    in showString "Pub " .
       showsPrec 0 (BB.toLazyByteString (BB.byteStringHex b))

-- | 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 x) = byteStringFromUint8Array 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
pub b = do
  guard (B.length b == 33)
  let u = byteStringToUint8Array b
  guard (js_secp256k1_verifyPub u)
  pure (Pub u)

foreign import javascript unsafe
  "h$bip32.secp256k1.verifyPub($1)"
  js_secp256k1_verifyPub :: TA.Uint8Array -> Bool

-- | Tweak a 'Pub'lic key by adding 'Tweak' times the generator to it.
addPubTweak :: Pub -> Tweak -> Maybe Pub
{-# INLINE addPubTweak #-}
addPubTweak (Pub p) (Tweak t) = do
  jsv <- nullableToMaybe (js_secp256k1_addPubTweak p t)
  pure $ Pub (js_unsafe_JSVal_to_UInt8Array jsv)

foreign import javascript unsafe
  "h$bip32.secp256k1.addPubTweak($1, $2)"
  js_secp256k1_addPubTweak :: TA.Uint8Array  -- ^ Public key.
                           -> TA.Uint8Array  -- ^ Tweak.
                           -> Nullable JSVal -- ^ Nullable Uint8Array

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

newtype Tweak = Tweak TA.Uint8Array

-- | Convert a 32-Byte 'B.ByteString' to a 'Tweak'.
tweak :: B.ByteString -> Maybe Tweak
tweak b = do
  guard (B.length b == 32)
  pure $ Tweak (byteStringToUint8Array b)

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

-- | RIPEMD-160
ripemd160
  :: B.ByteString  -- ^ Data to hash.
  -> B.ByteString  -- ^ 20-byte long digest.
{-# INLINE ripemd160 #-}
ripemd160 = byteStringFromUint8Array . js_ripemd160 . byteStringToUint8Array

foreign import javascript unsafe
  "h$bip32.ripemd160($1)"
  js_ripemd160 :: TA.Uint8Array -- ^ Data to hash.
               -> TA.Uint8Array -- ^ 20-bytes long digest.

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

-- | HMAC-SHA512
hmacSHA512
  :: B.ByteString  -- ^ Arbitrary length key.
  -> B.ByteString  -- ^ Data to hash.
  -> B.ByteString  -- ^ 64-byte long digest.
{-# INLINE hmacSHA512 #-}
hmacSHA512 k d =
  byteStringFromUint8Array $ js_hmacSHA512 (byteStringToUint8Array k)
                                           (byteStringToUint8Array d)

foreign import javascript unsafe
  "h$bip32.hmacSHA512($1, $2)"
  js_hmacSHA512 :: TA.Uint8Array  -- ^ Key.
                -> TA.Uint8Array  -- ^ Data to hash.
                -> TA.Uint8Array  -- ^ 64-bytes long digest.

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

-- | SHA256
sha256
  :: B.ByteString  -- ^ Data to hash.
  -> B.ByteString  -- ^ 32-byte long digest.
{-# INLINE sha256 #-}
sha256 = byteStringFromUint8Array . js_sha256 . byteStringToUint8Array

foreign import javascript unsafe
  "h$bip32.sha256($1)"
  js_sha256 :: TA.Uint8Array   -- ^ Data to hash.
            -> TA.Uint8Array   -- ^ 32-bytes long digest.

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

byteStringToUint8Array :: B.ByteString -> TA.Uint8Array
byteStringToUint8Array x
  | B.length x == 0 = js_emptyUint8Array
  | otherwise = let (buf, off, len) = Buf.fromByteString x
                in js_newUint8Array (Buf.getArrayBuffer buf) off len

foreign import javascript unsafe
  "new Uint8Array($1, $2, $3)"
  js_newUint8Array :: AB.ArrayBuffer
                   -> Int  -- ^ Byte offset.
                   -> Int  -- ^ Byte length.
                   -> TA.Uint8Array

foreign import javascript unsafe
  "new Uint8Array(0)"
  js_emptyUint8Array :: TA.Uint8Array

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

byteStringFromUint8Array :: TA.Uint8Array -> B.ByteString
byteStringFromUint8Array x =
  Buf.toByteString (TA.byteOffset x)
                   (Just (TA.byteLength x))
                   (Buf.createFromArrayBuffer (TA.buffer x))

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

foreign import javascript unsafe
  "$r = $1;"
  js_unsafe_JSVal_to_UInt8Array :: JSVal -> TA.Uint8Array