content: {-# LANGUAGE DeriveAnyClass #-}
  {-# LANGUAGE DeriveGeneric #-}
  {-# LANGUAGE DerivingStrategies #-}
  {-# LANGUAGE DuplicateRecordFields #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE ImportQualifiedPost #-}
  {-# LANGUAGE OverloadedRecordDot #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE RecordWildCards #-}
  {-# LANGUAGE NoFieldSelectors #-}
  
  -- |
  -- Module      : Haskoin.Transaction.Common
  -- Copyright   : No rights reserved
  -- License     : MIT
  -- Maintainer  : jprupp@protonmail.ch
  -- Stability   : experimental
  -- Portability : POSIX
  --
  -- Code related to transactions parsing and serialization.
  module Haskoin.Transaction.Common
    ( -- * Transactions
      Tx (..),
      TxIn (..),
      TxOut (..),
      OutPoint (..),
      TxHash (..),
      WitnessData,
      WitnessStack,
      WitnessStackItem,
      txHash,
      hexToTxHash,
      txHashToHex,
      nosigTxHash,
      nullOutPoint,
    )
  where
  
  import Control.Applicative ((<|>))
  import Control.DeepSeq
  import Control.Monad (forM_, guard, liftM2, mzero, replicateM, unless, when, (<=<))
  import Data.Aeson as A
  import Data.Aeson.Encoding qualified as E
  import Data.Binary (Binary (..))
  import Data.Bool (bool)
  import Data.ByteString (ByteString)
  import Data.ByteString qualified as B
  import Data.ByteString.Builder (char7)
  import Data.ByteString.Lazy qualified as BL
  import Data.Bytes.Get
  import Data.Bytes.Put
  import Data.Bytes.Serial
  import Data.Hashable (Hashable)
  import Data.Maybe (fromMaybe)
  import Data.Serialize (Serialize (..))
  import Data.String (IsString, fromString)
  import Data.String.Conversions (cs)
  import Data.Text (Text)
  import Data.Word (Word32, Word64)
  import GHC.Generics (Generic)
  import Haskoin.Crypto.Hash
  import Haskoin.Network.Common
  import Haskoin.Util.Helpers
  import Text.Read as R
  
  -- | Transaction id: hash of transaction excluding witness data.
  newtype TxHash = TxHash {get :: Hash256}
    deriving (Eq, Ord, Generic)
    deriving newtype (Hashable, NFData)
  
  instance Serial TxHash where
    serialize (TxHash h) = serialize h
    deserialize = TxHash <$> deserialize
  
  instance Serialize TxHash where
    put = serialize
    get = deserialize
  
  instance Binary TxHash where
    put = serialize
    get = deserialize
  
  instance Show TxHash where
    showsPrec _ = shows . txHashToHex
  
  instance Read TxHash where
    readPrec = do
      R.String str <- R.lexP
      maybe R.pfail return $ hexToTxHash $ cs str
  
  instance IsString TxHash where
    fromString s =
      let e = error "Could not read transaction hash from hex string"
       in fromMaybe e $ hexToTxHash $ cs s
  
  instance FromJSON TxHash where
    parseJSON =
      withText "txid" $
        maybe mzero return . hexToTxHash
  
  instance ToJSON TxHash where
    toJSON = A.String . txHashToHex
    toEncoding = hexEncoding . BL.reverse . runPutL . serialize
  
  -- | Transaction hash excluding signatures.
  nosigTxHash :: Tx -> TxHash
  nosigTxHash Tx {..} =
    TxHash . doubleSHA256 . runPutS $ serialize tx
    where
      tx = Tx {inputs = map clr inputs, ..}
      clr TxIn {..} = TxIn {script = B.empty, ..}
  
  -- | Convert transaction hash to hex form, reversing bytes.
  txHashToHex :: TxHash -> Text
  txHashToHex (TxHash h) =
    encodeHex . B.reverse . runPutS $ serialize h
  
  -- | Convert transaction hash from hex, reversing bytes.
  hexToTxHash :: Text -> Maybe TxHash
  hexToTxHash hex = do
    bs <- B.reverse <$> decodeHex hex
    h <- either (const Nothing) Just (runGetS deserialize bs)
    return $ TxHash h
  
  -- | Witness stack for SegWit transactions.
  type WitnessData = [WitnessStack]
  
  -- | Witness stack for SegWit transactions.
  type WitnessStack = [WitnessStackItem]
  
  -- | Witness stack item for SegWit transactions.
  type WitnessStackItem = ByteString
  
  -- | Data type representing a transaction.
  data Tx = Tx
    { -- | transaction data format version
      version :: !Word32,
      -- | list of transaction inputs
      inputs :: ![TxIn],
      -- | list of transaction outputs
      outputs :: ![TxOut],
      -- | witness data for the transaction
      witness :: !WitnessData,
      -- | earliest mining height or time
      locktime :: !Word32
    }
    deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData)
  
  -- | Compute transaction hash.
  txHash :: Tx -> TxHash
  txHash tx = TxHash . doubleSHA256 . runPutS $ serialize tx {witness = []}
  
  instance IsString Tx where
    fromString =
      fromMaybe e . (eitherToMaybe . runGetS deserialize <=< decodeHex) . cs
      where
        e = error "Could not read transaction from hex string"
  
  instance Serial Tx where
    deserialize = isWitnessTx >>= bool parseLegacyTx parseWitnessTx
    serialize tx
      | null tx.witness = putLegacyTx tx
      | otherwise = putWitnessTx tx
  
  instance Binary Tx where
    put = serialize
    get = deserialize
  
  instance Serialize Tx where
    put = serialize
    get = deserialize
  
  putInOut :: (MonadPut m) => Tx -> m ()
  putInOut tx = do
    putVarInt $ length tx.inputs
    mapM_ serialize tx.inputs
    putVarInt $ length tx.outputs
    mapM_ serialize tx.outputs
  
  -- | Non-SegWit transaction serializer.
  putLegacyTx :: (MonadPut m) => Tx -> m ()
  putLegacyTx tx = do
    putWord32le tx.version
    putInOut tx
    putWord32le tx.locktime
  
  -- | Witness transaciton serializer.
  putWitnessTx :: (MonadPut m) => Tx -> m ()
  putWitnessTx tx = do
    putWord32le tx.version
    putWord8 0x00
    putWord8 0x01
    putInOut tx
    putWitnessData tx.witness
    putWord32le tx.locktime
  
  isWitnessTx :: (MonadGet m) => m Bool
  isWitnessTx = lookAhead $ do
    _ <- getWord32le
    m <- getWord8
    f <- getWord8
    return (m == 0x00 && f == 0x01)
  
  -- | Non-SegWit transaction deseralizer.
  parseLegacyTx :: (MonadGet m) => m Tx
  parseLegacyTx = do
    version <- getWord32le
    inputs <- rl =<< deserialize
    outputs <- rl =<< deserialize
    when (length inputs == 0x00 && length outputs == 0x01) $
      fail "Witness transaction"
    locktime <- getWord32le
    return Tx {witness = [], ..}
    where
      rl (VarInt c) = replicateM (fromIntegral c) deserialize
  
  -- | Witness transaction deserializer.
  parseWitnessTx :: (MonadGet m) => m Tx
  parseWitnessTx = do
    version <- getWord32le
    m <- getWord8
    f <- getWord8
    unless (m == 0x00 && f == 0x01) $ fail "Not a witness transaction"
    inputs <- replicateList =<< deserialize
    outputs <- replicateList =<< deserialize
    witness <- parseWitnessData $ length inputs
    locktime <- getWord32le
    return Tx {..}
    where
      replicateList (VarInt c) = replicateM (fromIntegral c) deserialize
  
  -- | Witness data deserializer. Requires count of inputs.
  parseWitnessData :: (MonadGet m) => Int -> m WitnessData
  parseWitnessData n = replicateM n parseWitnessStack
    where
      parseWitnessStack = do
        VarInt i <- deserialize
        replicateM (fromIntegral i) parseWitnessStackItem
      parseWitnessStackItem = do
        VarInt i <- deserialize
        getByteString $ fromIntegral i
  
  -- | Witness data serializer.
  putWitnessData :: (MonadPut m) => WitnessData -> m ()
  putWitnessData = mapM_ putWitnessStack
    where
      putWitnessStack ws = do
        putVarInt $ length ws
        mapM_ putWitnessStackItem ws
      putWitnessStackItem bs = do
        putVarInt $ B.length bs
        putByteString bs
  
  instance FromJSON Tx where
    parseJSON = withObject "Tx" $ \o ->
      Tx
        <$> o .: "version"
        <*> o .: "inputs"
        <*> o .: "outputs"
        <*> (mapM (mapM f) =<< o .: "witnessdata")
        <*> o .: "locktime"
      where
        f = maybe mzero return . decodeHex
  
  instance ToJSON Tx where
    toJSON (Tx v i o w l) =
      object
        [ "version" .= v,
          "inputs" .= i,
          "outputs" .= o,
          "witnessdata" .= fmap (fmap encodeHex) w,
          "locktime" .= l
        ]
    toEncoding (Tx v i o w l) =
      pairs $
        mconcat
          [ "version" `E.pair` E.word32 v,
            "inputs" `E.pair` E.list toEncoding i,
            "outputs" `E.pair` E.list toEncoding o,
            "witnessdata" `E.pair` E.list (E.list f) w,
            "locktime" `E.pair` E.word32 l
          ]
      where
        f = hexEncoding . BL.fromStrict
  
  -- | Data type representing a transaction input.
  data TxIn = TxIn
    { -- | output being spent
      outpoint :: !OutPoint,
      -- | signatures and redeem script
      script :: !ByteString,
      -- | lock-time using sequence numbers (BIP-68)
      sequence :: !Word32
    }
    deriving (Eq, Show, Read, Ord, Generic, Hashable, NFData)
  
  instance Serial TxIn where
    deserialize =
      TxIn <$> deserialize <*> (readBS =<< deserialize) <*> getWord32le
      where
        readBS (VarInt len) = getByteString $ fromIntegral len
  
    serialize (TxIn o s q) = do
      serialize o
      putVarInt $ B.length s
      putByteString s
      putWord32le q
  
  instance Binary TxIn where
    get = deserialize
    put = serialize
  
  instance Serialize TxIn where
    get = deserialize
    put = serialize
  
  instance FromJSON TxIn where
    parseJSON =
      withObject "TxIn" $ \o ->
        TxIn
          <$> o .: "prevoutput"
          <*> (maybe mzero return . decodeHex =<< o .: "inputscript")
          <*> o .: "sequence"
  
  instance ToJSON TxIn where
    toJSON (TxIn o s q) =
      object
        [ "prevoutput" .= o,
          "inputscript" .= encodeHex s,
          "sequence" .= q
        ]
    toEncoding (TxIn o s q) =
      pairs $
        mconcat
          [ "prevoutput" `E.pair` toEncoding o,
            "inputscript" `E.pair` hexEncoding (BL.fromStrict s),
            "sequence" `E.pair` E.word32 q
          ]
  
  -- | Data type representing a transaction output.
  data TxOut = TxOut
    { -- | value of output is satoshi
      value :: !Word64,
      -- | pubkey script
      script :: !ByteString
    }
    deriving (Eq, Show, Read, Ord, Generic, Hashable, NFData)
  
  instance Serial TxOut where
    deserialize = do
      val <- getWord64le
      VarInt len <- deserialize
      TxOut val <$> getByteString (fromIntegral len)
  
    serialize (TxOut o s) = do
      putWord64le o
      putVarInt $ B.length s
      putByteString s
  
  instance Binary TxOut where
    put = serialize
    get = deserialize
  
  instance Serialize TxOut where
    put = serialize
    get = deserialize
  
  instance FromJSON TxOut where
    parseJSON =
      withObject "TxOut" $ \o -> do
        value <- o .: "value"
        t <- o .: "outputscript"
        script <- maybe mzero return (decodeHex t)
        return TxOut {..}
  
  instance ToJSON TxOut where
    toJSON (TxOut o s) =
      object ["value" .= o, "outputscript" .= encodeHex s]
    toEncoding (TxOut o s) =
      pairs $
        mconcat
          [ "value" `E.pair` E.word64 o,
            "outputscript" `E.pair` hexEncoding (BL.fromStrict s)
          ]
  
  -- | The 'OutPoint' refers to a transaction output being spent.
  data OutPoint = OutPoint
    { -- | hash of previous transaction
      hash :: !TxHash,
      -- | position of output in previous transaction
      index :: !Word32
    }
    deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData)
  
  instance Serial OutPoint where
    deserialize = do
      (h, i) <- liftM2 (,) deserialize getWord32le
      return $ OutPoint h i
    serialize (OutPoint h i) = serialize h >> putWord32le i
  
  instance Binary OutPoint where
    put = serialize
    get = deserialize
  
  instance Serialize OutPoint where
    put = serialize
    get = deserialize
  
  instance FromJSON OutPoint where
    parseJSON =
      withObject "OutPoint" $ \o ->
        OutPoint <$> o .: "txid" <*> o .: "index"
  
  instance ToJSON OutPoint where
    toJSON (OutPoint h i) = object ["txid" .= h, "index" .= i]
    toEncoding (OutPoint h i) =
      pairs $
        mconcat
          [ "txid" `E.pair` toEncoding h,
            "index" `E.pair` E.word32 i
          ]
  
  -- | Outpoint used in coinbase transactions.
  nullOutPoint :: OutPoint
  nullOutPoint =
    OutPoint
      { hash = "0000000000000000000000000000000000000000000000000000000000000000",
        index = maxBound
      }
  