content: {-# LANGUAGE DeriveAnyClass #-}
  {-# LANGUAGE DeriveGeneric #-}
  {-# LANGUAGE DuplicateRecordFields #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE ImportQualifiedPost #-}
  {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE OverloadedRecordDot #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE NoFieldSelectors #-}
  {-# OPTIONS_GHC -fno-warn-orphans #-}
  
  -- |
  -- Module      : Haskoin.Keys.Common
  -- Copyright   : No rights reserved
  -- License     : MIT
  -- Maintainer  : jprupp@protonmail.ch
  -- Stability   : experimental
  -- Portability : POSIX
  --
  -- ECDSA private and public key functions.
  module Haskoin.Crypto.Keys.Common
    ( -- * Bitcoin Public & Private Keys
      PublicKey (..),
      PrivateKey (..),
      wrapPubKey,
      derivePublicKey,
      wrapSecKey,
      fromMiniKey,
      tweakPubKey,
      tweakSecKey,
  
      -- ** Private Key Wallet Import Format (WIF)
      fromWif,
      toWif,
    )
  where
  
  import Control.DeepSeq
  import Control.Monad (guard, mzero, (<=<))
  import Crypto.Secp256k1
  import Data.Aeson
    ( Encoding,
      FromJSON,
      ToJSON (..),
      Value (String),
      object,
      parseJSON,
      withText,
    )
  import Data.Aeson.Encoding (text, unsafeToEncoding)
  import Data.Aeson.Types (Parser)
  import Data.Binary (Binary (..))
  import Data.Bool (bool)
  import Data.ByteString (ByteString)
  import Data.ByteString qualified as BS
  import Data.ByteString.Builder (char7)
  import Data.Bytes.Get
  import Data.Bytes.Put
  import Data.Bytes.Serial
  import Data.Hashable
  import Data.Maybe (fromMaybe)
  import Data.Serialize (Serialize (..))
  import Data.String (IsString, fromString)
  import Data.String.Conversions (cs)
  import GHC.Generics (Generic)
  import Haskoin.Address.Base58
  import Haskoin.Crypto.Hash
  import Haskoin.Network.Data
  import Haskoin.Util
  
  -- | Elliptic curve public key type with expected serialized compression flag.
  data PublicKey = PublicKey
    { point :: !PubKey,
      compress :: !Bool
    }
    deriving (Generic, Show, Read, Hashable, Eq, NFData)
  
  instance MarshalJSON Ctx PublicKey where
    marshalValue ctx = String . encodeHex . runPutS . marshalPut ctx
  
    marshalEncoding ctx = hexEncoding . runPutL . marshalPut ctx
  
    unmarshalValue ctx =
      withText "PublicKey" $ \t -> do
        bs <- maybe (fail "Expected hex public key") return $ decodeHex t
        either fail return $ unmarshal ctx bs
  
  instance Marshal Ctx PublicKey where
    marshalGet ctx = do
      c <-
        lookAhead $
          getWord8 >>= \case
            0x02 -> return True
            0x03 -> return True
            0x04 -> return False
            _ -> fail "Not a public key"
      bs <- getByteString $ if c then 33 else 65
      case importPubKey ctx bs of
        Nothing -> fail "Could not decode public key"
        Just k -> return $ PublicKey k c
  
    marshalPut ctx pk =
      putByteString $ exportPubKey ctx pk.compress pk.point
  
  -- | Wrap a public key from secp256k1 library adding information about compression.
  wrapPubKey :: Bool -> PubKey -> PublicKey
  wrapPubKey c p = PublicKey p c
  
  -- | Derives a public key from a private key. This function will preserve
  -- compression flag.
  derivePublicKey :: Ctx -> PrivateKey -> PublicKey
  derivePublicKey ctx (PrivateKey d c) = PublicKey (derivePubKey ctx d) c
  
  -- | Tweak a public key.
  tweakPubKey :: Ctx -> PubKey -> Hash256 -> Maybe PubKey
  tweakPubKey ctx p =
    tweakAddPubKey ctx p <=< tweak . runPutS . serialize
  
  -- | Elliptic curve private key type with expected public key compression
  -- information. Compression information is stored in private key WIF formats and
  -- needs to be preserved to generate the correct address from the corresponding
  -- public key.
  data PrivateKey = PrivateKey
    { key :: !SecKey,
      compress :: !Bool
    }
    deriving (Eq, Show, Read, Generic, NFData)
  
  instance Serial PrivateKey where
    serialize p = do
      putByteString p.key.get
      serialize p.compress
    deserialize = do
      k <- getByteString 32
      c <- deserialize
      return PrivateKey {key = SecKey k, compress = c}
  
  instance MarshalJSON Network PrivateKey where
    marshalValue net = String . toWif net
    marshalEncoding net = text . toWif net
    unmarshalValue net =
      withText "PrivateKey" $
        maybe (fail "Could not decode WIF") return . fromWif net
  
  -- | Wrap private key with corresponding public key compression flag.
  wrapSecKey :: Bool -> SecKey -> PrivateKey
  wrapSecKey c d = PrivateKey d c
  
  -- | Tweak a private key.
  tweakSecKey :: Ctx -> SecKey -> Hash256 -> Maybe SecKey
  tweakSecKey ctx k =
    tweakAddSecKey ctx k <=< tweak . runPutS . serialize
  
  -- | Decode Casascius mini private keys (22 or 30 characters).
  fromMiniKey :: ByteString -> Maybe PrivateKey
  fromMiniKey bs = do
    guard checkShortKey
    wrapSecKey False <$> (secKey . runPutS . serialize . sha256) bs
    where
      checkHash = runPutS $ serialize $ sha256 $ bs `BS.append` "?"
      checkShortKey = BS.length bs `elem` [22, 30] && BS.head checkHash == 0x00
  
  -- | Decode private key from WIF (wallet import format) string.
  fromWif :: Network -> Base58 -> Maybe PrivateKey
  fromWif net wif = do
    bs <- decodeBase58Check wif
    -- Check that this is a private key
    guard (BS.head bs == net.secretPrefix)
    case BS.length bs of
      -- Uncompressed format
      33 -> wrapSecKey False <$> (secKey . BS.tail) bs
      -- Compressed format
      34 -> do
        guard $ BS.last bs == 0x01
        wrapSecKey True <$> (secKey . BS.tail . BS.init) bs
      -- Bad length
      _ -> Nothing
  
  -- | Encode private key into a WIF string.
  toWif :: Network -> PrivateKey -> Base58
  toWif net (PrivateKey k c) =
    encodeBase58Check . BS.cons net.secretPrefix $
      if c then k.get `BS.snoc` 0x01 else k.get
  