{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
module Haskoin.Store.Data
    ( -- * Address Balances
      Balance(..)
    , balanceToJSON
    , balanceToEncoding
    , balanceParseJSON
    , zeroBalance
    , nullBalance

      -- * Block Data
    , BlockData(..)
    , confirmed

      -- * Transactions
    , BlockTx(..)
    , TxData(..)
    , Transaction(..)
    , transactionToJSON
    , transactionToEncoding
    , transactionData
    , fromTransaction
    , toTransaction
    , StoreInput(..)
    , storeInputToJSON
    , storeInputToEncoding
    , isCoinbase
    , StoreOutput(..)
    , storeOutputToJSON
    , storeOutputToEncoding
    , Prev(..)
    , Spender(..)
    , BlockRef(..)
    , UnixTime
    , getUnixTime
    , putUnixTime
    , BlockPos

      -- * Unspent Outputs
    , Unspent(..)
    , unspentToJSON
    , unspentToEncoding

      -- * Extended Public Keys
    , XPubSpec(..)
    , XPubBal(..)
    , xPubBalToJSON
    , xPubBalToEncoding
    , xPubBalParseJSON
    , XPubUnspent(..)
    , xPubUnspentToJSON
    , xPubUnspentToEncoding
    , XPubSummary(..)
    , DeriveType(..)

      -- * Other Data
    , TxId(..)
    , GenericResult(..)
    , PeerInformation(..)
    , HealthCheck(..)
    , Event(..)
    , Except(..)
    ) where

import           Control.Applicative     ((<|>))
import           Control.DeepSeq         (NFData)
import           Control.Exception       (Exception)
import           Control.Monad           (guard, join)
import           Data.Aeson              (Encoding, FromJSON (..), ToJSON (..),
                                          Value (..), object, pairs, (.!=),
                                          (.:), (.:?), (.=))
import qualified Data.Aeson              as A
import           Data.Aeson.Encoding     (list, null_, pair, text)
import           Data.Aeson.Types        (Parser)
import           Data.ByteString         (ByteString)
import qualified Data.ByteString         as B
import           Data.ByteString.Short   (ShortByteString)
import qualified Data.ByteString.Short   as BSS
import           Data.Hashable           (Hashable (..))
import qualified Data.IntMap             as I
import           Data.IntMap.Strict      (IntMap)
import           Data.Maybe              (catMaybes, isJust, mapMaybe)
import           Data.Serialize          (Get, Put, Serialize (..), getWord32be,
                                          getWord64be, getWord8, putWord32be,
                                          putWord64be, putWord8)
import qualified Data.Serialize          as S
import           Data.String.Conversions (cs)
import           Data.Text               (Text)
import qualified Data.Text.Lazy          as TL
import           Data.Word               (Word32, Word64)
import           GHC.Generics            (Generic)
import           Haskoin                 (Address, BlockHash, BlockHeader (..),
                                          BlockHeight, BlockWork, KeyIndex,
                                          Network (..), OutPoint (..),
                                          PubKeyI (..), Tx (..), TxHash (..),
                                          TxIn (..), TxOut (..), WitnessStack,
                                          XPubKey (..), addrFromJSON,
                                          addrToEncoding, addrToJSON,
                                          blockHashToHex, decodeHex, encodeHex,
                                          headerHash, scriptToAddressBS, txHash,
                                          txHashToHex, wrapPubKey)
import           Web.Scotty.Trans        (ScottyError (..))

data DeriveType
    = DeriveNormal
    | DeriveP2SH
    | DeriveP2WPKH
    deriving (Show, Eq, Generic, NFData, Serialize)

data XPubSpec =
    XPubSpec
        { xPubSpecKey    :: !XPubKey
        , xPubDeriveType :: !DeriveType
        } deriving (Show, Eq, Generic, NFData)

instance Hashable XPubSpec where
    hashWithSalt i XPubSpec {xPubSpecKey = XPubKey {xPubKey = pubkey}} =
        hashWithSalt i pubkey

instance Serialize XPubSpec where
    put XPubSpec {xPubSpecKey = k, xPubDeriveType = t} = do
        put (xPubDepth k)
        put (xPubParent k)
        put (xPubIndex k)
        put (xPubChain k)
        put (wrapPubKey True (xPubKey k))
        put t
    get = do
        d <- get
        p <- get
        i <- get
        c <- get
        k <- get
        t <- get
        let x =
                XPubKey
                    { xPubDepth = d
                    , xPubParent = p
                    , xPubIndex = i
                    , xPubChain = c
                    , xPubKey = pubKeyPoint k
                    }
        return XPubSpec {xPubSpecKey = x, xPubDeriveType = t}

type UnixTime = Word64
type BlockPos = Word32

-- | Serialize such that ordering is inverted.
putUnixTime :: Word64 -> Put
putUnixTime w = putWord64be $ maxBound - w

getUnixTime :: Get Word64
getUnixTime = (maxBound -) <$> getWord64be

-- | Reference to a block where a transaction is stored.
data BlockRef
    = BlockRef
          { blockRefHeight :: !BlockHeight
      -- ^ block height in the chain
          , blockRefPos    :: !Word32
      -- ^ position of transaction within the block
          }
    | MemRef
          { memRefTime :: !UnixTime
          }
    deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData)

-- | Serialized entities will sort in reverse order.
instance Serialize BlockRef where
    put MemRef {memRefTime = t} = do
        putWord8 0x00
        putUnixTime t
    put BlockRef {blockRefHeight = h, blockRefPos = p} = do
        putWord8 0x01
        putWord32be (maxBound - h)
        putWord32be (maxBound - p)
    get = getmemref <|> getblockref
      where
        getmemref = do
            guard . (== 0x00) =<< getWord8
            MemRef <$> getUnixTime
        getblockref = do
            guard . (== 0x01) =<< getWord8
            h <- (maxBound -) <$> getWord32be
            p <- (maxBound -) <$> getWord32be
            return BlockRef {blockRefHeight = h, blockRefPos = p}

confirmed :: BlockRef -> Bool
confirmed BlockRef {} = True
confirmed MemRef {}   = False

instance ToJSON BlockRef where
    toJSON BlockRef {blockRefHeight = h, blockRefPos = p} =
        object ["height" .= h, "position" .= p]
    toJSON MemRef {memRefTime = t} = object ["mempool" .= t]
    toEncoding BlockRef {blockRefHeight = h, blockRefPos = p} =
        pairs ("height" .= h <> "position" .= p)
    toEncoding MemRef {memRefTime = t} = pairs ("mempool" .= t)

instance FromJSON BlockRef where
    parseJSON = A.withObject "blockref" $ \o -> b o <|> m o
      where
        b o = do
            height <- o .: "height"
            position <- o .: "position"
            return BlockRef {blockRefHeight = height, blockRefPos = position}
        m o = do
            mempool <- o .: "mempool"
            return MemRef {memRefTime = mempool}

-- | Transaction in relation to an address.
data BlockTx = BlockTx
    { blockTxBlock :: !BlockRef
      -- ^ block information
    , blockTxHash  :: !TxHash
      -- ^ transaction hash
    } deriving (Show, Eq, Ord, Generic, Serialize, Hashable, NFData)

instance ToJSON BlockTx where
    toJSON btx = object ["txid" .= blockTxHash btx, "block" .= blockTxBlock btx]
    toEncoding btx =
        pairs
            (  "txid" .= blockTxHash btx
            <> "block" .= blockTxBlock btx
            )

instance FromJSON BlockTx where
    parseJSON =
        A.withObject "blocktx" $ \o -> do
            txid <- o .: "txid"
            block <- o .: "block"
            return BlockTx {blockTxBlock = block, blockTxHash = txid}

-- | Address balance information.
data Balance =
    Balance
        { balanceAddress       :: !Address
      -- ^ address balance
        , balanceAmount        :: !Word64
      -- ^ confirmed balance
        , balanceZero          :: !Word64
      -- ^ unconfirmed balance
        , balanceUnspentCount  :: !Word64
      -- ^ number of unspent outputs
        , balanceTxCount       :: !Word64
      -- ^ number of transactions
        , balanceTotalReceived :: !Word64
      -- ^ total amount from all outputs in this address
        }
    deriving (Show, Read, Eq, Ord, Generic, Serialize, Hashable, NFData)

zeroBalance :: Address -> Balance
zeroBalance a =
    Balance
        { balanceAddress = a
        , balanceAmount = 0
        , balanceUnspentCount = 0
        , balanceZero = 0
        , balanceTxCount = 0
        , balanceTotalReceived = 0
        }

nullBalance :: Balance -> Bool
nullBalance Balance { balanceAmount = 0
                    , balanceUnspentCount = 0
                    , balanceZero = 0
                    , balanceTxCount = 0
                    , balanceTotalReceived = 0
                    } = True
nullBalance _ = False

balanceToJSON :: Network -> Balance -> Value
balanceToJSON net b =
        object $
        [ "address" .= addrToJSON net (balanceAddress b)
        , "confirmed" .= balanceAmount b
        , "unconfirmed" .= balanceZero b
        , "utxo" .= balanceUnspentCount b
        , "txs" .= balanceTxCount b
        , "received" .= balanceTotalReceived b
        ]

balanceToEncoding :: Network -> Balance -> Encoding
balanceToEncoding net b =
    pairs
        (  "address" `pair` addrToEncoding net (balanceAddress b)
        <> "confirmed" .= balanceAmount b
        <> "unconfirmed" .= balanceZero b
        <> "utxo" .= balanceUnspentCount b
        <> "txs" .= balanceTxCount b
        <> "received" .= balanceTotalReceived b
        )

balanceParseJSON :: Network -> Value -> Parser Balance
balanceParseJSON net =
    A.withObject "balance" $ \o -> do
        amount <- o .: "confirmed"
        unconfirmed <- o .: "unconfirmed"
        utxo <- o .: "utxo"
        txs <- o .: "txs"
        received <- o .: "received"
        address <- addrFromJSON net =<< o .: "address"
        return
            Balance
                { balanceAddress = address
                , balanceAmount = amount
                , balanceUnspentCount = utxo
                , balanceZero = unconfirmed
                , balanceTxCount = txs
                , balanceTotalReceived = received
                }

-- | Unspent output.
data Unspent = Unspent
    { unspentBlock  :: !BlockRef
    , unspentPoint  :: !OutPoint
    , unspentAmount :: !Word64
    , unspentScript :: !ShortByteString
    } deriving (Show, Eq, Ord, Generic, Hashable, Serialize, NFData)

unspentToJSON :: Network -> Unspent -> Value
unspentToJSON net u =
    object
        [ "address" .= scriptToAddrJSON net bsscript
        , "block" .= unspentBlock u
        , "txid" .= outPointHash (unspentPoint u)
        , "index" .= outPointIndex (unspentPoint u)
        , "pkscript" .= script
        , "value" .= unspentAmount u
        ]
  where
    bsscript = BSS.fromShort (unspentScript u)
    script = encodeHex bsscript

unspentToEncoding :: Network -> Unspent -> Encoding
unspentToEncoding net u =
    pairs
        (  "address" `pair` scriptToAddrEncoding net bsscript
        <> "block" .= unspentBlock u
        <> "txid" .= outPointHash (unspentPoint u)
        <> "index" .= outPointIndex (unspentPoint u)
        <> "pkscript" `pair` text script
        <> "value" .= unspentAmount u
        )
  where
    bsscript = BSS.fromShort (unspentScript u)
    script = encodeHex bsscript

instance FromJSON Unspent where
    parseJSON =
        A.withObject "unspent" $ \o -> do
            block <- o .: "block"
            txid <- o .: "txid"
            index <- o .: "index"
            value <- o .: "value"
            script <- BSS.toShort <$> (o .: "pkscript" >>= jsonHex)
            return
                Unspent
                    { unspentBlock = block
                    , unspentPoint = OutPoint txid index
                    , unspentAmount = value
                    , unspentScript = script
                    }

-- | Database value for a block entry.
data BlockData = BlockData
    { blockDataHeight    :: !BlockHeight
      -- ^ height of the block in the chain
    , blockDataMainChain :: !Bool
      -- ^ is this block in the main chain?
    , blockDataWork      :: !BlockWork
      -- ^ accumulated work in that block
    , blockDataHeader    :: !BlockHeader
      -- ^ block header
    , blockDataSize      :: !Word32
      -- ^ size of the block including witnesses
    , blockDataWeight    :: !Word32
      -- ^ weight of this block (for segwit networks)
    , blockDataTxs       :: ![TxHash]
      -- ^ block transactions
    , blockDataOutputs   :: !Word64
      -- ^ sum of all transaction outputs
    , blockDataFees      :: !Word64
      -- ^ sum of all transaction fees
    , blockDataSubsidy   :: !Word64
      -- ^ block subsidy
    } deriving (Show, Read, Eq, Ord, Generic, Serialize, Hashable, NFData)

instance ToJSON BlockData where
    toJSON bv =
        object
            [ "hash" .= headerHash (blockDataHeader bv)
            , "height" .= blockDataHeight bv
            , "mainchain" .= blockDataMainChain bv
            , "previous" .= prevBlock (blockDataHeader bv)
            , "time" .= blockTimestamp (blockDataHeader bv)
            , "version" .= blockVersion (blockDataHeader bv)
            , "bits" .= blockBits (blockDataHeader bv)
            , "nonce" .= bhNonce (blockDataHeader bv)
            , "size" .= blockDataSize bv
            , "tx" .= blockDataTxs bv
            , "merkle" .= TxHash (merkleRoot (blockDataHeader bv))
            , "subsidy" .= blockDataSubsidy bv
            , "fees" .= blockDataFees bv
            , "outputs" .= blockDataOutputs bv
            , "work" .= show (blockDataWork bv)
            , "weight" .= blockDataWeight bv
            ]
    toEncoding bv =
        pairs
            (  "hash" `pair` text (blockHashToHex (headerHash (blockDataHeader bv)))
            <> "height" .= blockDataHeight bv
            <> "mainchain" .= blockDataMainChain bv
            <> "previous" .= prevBlock (blockDataHeader bv)
            <> "time" .= blockTimestamp (blockDataHeader bv)
            <> "version" .= blockVersion (blockDataHeader bv)
            <> "bits" .= blockBits (blockDataHeader bv)
            <> "nonce" .= bhNonce (blockDataHeader bv)
            <> "size" .= blockDataSize bv
            <> "tx" .= blockDataTxs bv
            <> "merkle" `pair` text (txHashToHex (TxHash (merkleRoot (blockDataHeader bv))))
            <> "subsidy" .= blockDataSubsidy bv
            <> "fees" .= blockDataFees bv
            <> "outputs" .= blockDataOutputs bv
            <> "work" .= blockDataWork bv
            <> "weight" .= blockDataWeight bv)

instance FromJSON BlockData where
    parseJSON =
        A.withObject "blockdata" $ \o -> do
            height <- o .: "height"
            mainchain <- o .: "mainchain"
            previous <- o .: "previous"
            time <- o .: "time"
            version <- o .: "version"
            bits <- o .: "bits"
            nonce <- o .: "nonce"
            size <- o .: "size"
            tx <- o .: "tx"
            TxHash merkle <- o .: "merkle"
            subsidy <- o .: "subsidy"
            fees <- o .: "fees"
            outputs <- o .: "outputs"
            work <- o .: "work"
            weight <- o .: "weight"
            return
                BlockData
                    { blockDataHeader =
                          BlockHeader
                              { prevBlock = previous
                              , blockTimestamp = time
                              , blockVersion = version
                              , blockBits = bits
                              , bhNonce = nonce
                              , merkleRoot = merkle
                              }
                    , blockDataMainChain = mainchain
                    , blockDataWork = work
                    , blockDataSize = size
                    , blockDataWeight = weight
                    , blockDataTxs = tx
                    , blockDataOutputs = outputs
                    , blockDataFees = fees
                    , blockDataHeight = height
                    , blockDataSubsidy = subsidy
                    }

data StoreInput
    = StoreCoinbase { inputPoint     :: !OutPoint
                    , inputSequence  :: !Word32
                    , inputSigScript :: !ByteString
                    , inputWitness   :: !(Maybe WitnessStack)
                     }
    | StoreInput { inputPoint     :: !OutPoint
                 , inputSequence  :: !Word32
                 , inputSigScript :: !ByteString
                 , inputPkScript  :: !ByteString
                 , inputAmount    :: !Word64
                 , inputWitness   :: !(Maybe WitnessStack)
                  }
    deriving (Show, Read, Eq, Ord, Generic, Serialize, Hashable, NFData)

isCoinbase :: StoreInput -> Bool
isCoinbase StoreCoinbase {} = True
isCoinbase StoreInput {}    = False

storeInputToJSON :: Network -> StoreInput -> Value
storeInputToJSON net StoreInput { inputPoint = OutPoint oph opi
                                , inputSequence = sq
                                , inputSigScript = ss
                                , inputPkScript = ps
                                , inputAmount = val
                                , inputWitness = wit
                                } =
    object
        [ "coinbase" .= False
        , "txid" .= oph
        , "output" .= opi
        , "sigscript" .= String (encodeHex ss)
        , "sequence" .= sq
        , "pkscript" .= String (encodeHex ps)
        , "value" .= val
        , "address" .= scriptToAddrJSON net ps
        , "witness" .= fmap (map encodeHex) wit
        ]
storeInputToJSON _ StoreCoinbase { inputPoint = OutPoint oph opi
                                 , inputSequence = sq
                                 , inputSigScript = ss
                                 , inputWitness = wit
                                 } =
    object
        [ "coinbase" .= True
        , "txid" .= oph
        , "output" .= opi
        , "sigscript" .= String (encodeHex ss)
        , "sequence" .= sq
        , "pkscript" .= Null
        , "value" .= Null
        , "address" .= Null
        , "witness" .= fmap (map encodeHex) wit
        ]

storeInputToEncoding :: Network -> StoreInput -> Encoding
storeInputToEncoding net StoreInput { inputPoint = OutPoint oph opi
                                    , inputSequence = sq
                                    , inputSigScript = ss
                                    , inputPkScript = ps
                                    , inputAmount = val
                                    , inputWitness = wit
                                    } =
    pairs
        (  "coinbase" .= False
        <> "txid" .= oph
        <> "output" .= opi
        <> "sigscript" `pair` text (encodeHex ss)
        <> "sequence" .= sq
        <> "pkscript" `pair` text (encodeHex ps)
        <> "value" .= val
        <> "address" `pair` scriptToAddrEncoding net ps
        <> "witness" .= fmap (map encodeHex) wit
        )

storeInputToEncoding _ StoreCoinbase { inputPoint = OutPoint oph opi
                                     , inputSequence = sq
                                     , inputSigScript = ss
                                     , inputWitness = wit
                                     } =
    pairs
        (  "coinbase" .= True
        <> "txid" `pair` text (txHashToHex oph)
        <> "output" .= opi
        <> "sigscript" `pair` text (encodeHex ss)
        <> "sequence" .= sq
        <> "pkscript" `pair` null_
        <> "value" `pair` null_
        <> "address" `pair` null_
        <> "witness" .= fmap (map encodeHex) wit
        )

instance FromJSON StoreInput where
    parseJSON =
        A.withObject "storeinput" $ \o -> do
            coinbase <- o .: "coinbase"
            outpoint <- OutPoint <$> o .: "txid" <*> o .: "output"
            sequ <- o .: "sequence"
            witness <-
                o .:? "witness" >>= \mmxs ->
                    case join mmxs of
                        Nothing -> return Nothing
                        Just xs -> Just <$> mapM jsonHex xs
            sigscript <- o .: "sigscript" >>= jsonHex
            if coinbase
                then return
                        StoreCoinbase
                            { inputPoint = outpoint
                            , inputSequence = sequ
                            , inputSigScript = sigscript
                            , inputWitness = witness
                            }
                else do
                    pkscript <- o .: "pkscript" >>= jsonHex
                    value <- o .: "value"
                    return
                        StoreInput
                            { inputPoint = outpoint
                            , inputSequence = sequ
                            , inputSigScript = sigscript
                            , inputPkScript = pkscript
                            , inputAmount = value
                            , inputWitness = witness
                            }

jsonHex :: Text -> Parser ByteString
jsonHex s =
    case decodeHex s of
        Nothing -> fail "Could not decode hex"
        Just b  -> return b

-- | Information about input spending output.
data Spender = Spender
    { spenderHash  :: !TxHash
      -- ^ input transaction hash
    , spenderIndex :: !Word32
      -- ^ input position in transaction
    } deriving (Show, Read, Eq, Ord, Generic, Serialize, Hashable, NFData)

instance ToJSON Spender where
    toJSON n = object ["txid" .= txHashToHex (spenderHash n), "input" .= spenderIndex n]
    toEncoding n = pairs ("txid" .= txHashToHex (spenderHash n) <> "input" .= spenderIndex n)

instance FromJSON Spender where
    parseJSON =
        A.withObject "spender" $ \o -> Spender <$> o .: "txid" <*> o .: "input"

-- | Output information.
data StoreOutput = StoreOutput
    { outputAmount  :: !Word64
    , outputScript  :: !ByteString
    , outputSpender :: !(Maybe Spender)
    } deriving (Show, Read, Eq, Ord, Generic, Serialize, Hashable, NFData)

storeOutputToJSON :: Network -> StoreOutput -> Value
storeOutputToJSON net d =
    object
        [ "address" .= scriptToAddrJSON net (outputScript d)
        , "pkscript" .= encodeHex (outputScript d)
        , "value" .= outputAmount d
        , "spent" .= isJust (outputSpender d)
        , "spender" .= outputSpender d
        ]

storeOutputToEncoding :: Network -> StoreOutput -> Encoding
storeOutputToEncoding net d =
    pairs
        (  "address" `pair` scriptToAddrEncoding net (outputScript d)
        <> "pkscript" `pair` text (encodeHex (outputScript d))
        <> "value" .= outputAmount d
        <> "spent" .= isJust (outputSpender d)
        <> "spender" .= outputSpender d
        )

instance FromJSON StoreOutput where
    parseJSON =
        A.withObject "storeoutput" $ \o -> do
            value <- o .: "value"
            pkscript <- o .: "pkscript" >>= jsonHex
            spender <- o .: "spender"
            return
                StoreOutput
                    { outputAmount = value
                    , outputScript = pkscript
                    , outputSpender = spender
                    }

data Prev = Prev
    { prevScript :: !ByteString
    , prevAmount :: !Word64
    } deriving (Show, Eq, Ord, Generic, Hashable, Serialize, NFData)

toInput :: TxIn -> Maybe Prev -> Maybe WitnessStack -> StoreInput
toInput i Nothing w =
    StoreCoinbase
        { inputPoint = prevOutput i
        , inputSequence = txInSequence i
        , inputSigScript = scriptInput i
        , inputWitness = w
        }
toInput i (Just p) w =
    StoreInput
        { inputPoint = prevOutput i
        , inputSequence = txInSequence i
        , inputSigScript = scriptInput i
        , inputPkScript = prevScript p
        , inputAmount = prevAmount p
        , inputWitness = w
        }

toOutput :: TxOut -> Maybe Spender -> StoreOutput
toOutput o s =
    StoreOutput
        { outputAmount = outValue o
        , outputScript = scriptOutput o
        , outputSpender = s
        }

data TxData = TxData
    { txDataBlock   :: !BlockRef
    , txData        :: !Tx
    , txDataPrevs   :: !(IntMap Prev)
    , txDataDeleted :: !Bool
    , txDataRBF     :: !Bool
    , txDataTime    :: !Word64
    } deriving (Show, Eq, Ord, Generic, Serialize, NFData)

toTransaction :: TxData -> IntMap Spender -> Transaction
toTransaction t sm =
    Transaction
        { transactionBlock = txDataBlock t
        , transactionVersion = txVersion (txData t)
        , transactionLockTime = txLockTime (txData t)
        , transactionInputs = ins
        , transactionOutputs = outs
        , transactionDeleted = txDataDeleted t
        , transactionRBF = txDataRBF t
        , transactionTime = txDataTime t
        }
  where
    ws =
        take (length (txIn (txData t))) $
        map Just (txWitness (txData t)) <> repeat Nothing
    f n i = toInput i (I.lookup n (txDataPrevs t)) (ws !! n)
    ins = zipWith f [0 ..] (txIn (txData t))
    g n o = toOutput o (I.lookup n sm)
    outs = zipWith g [0 ..] (txOut (txData t))

fromTransaction :: Transaction -> (TxData, IntMap Spender)
fromTransaction t = (d, sm)
  where
    d =
        TxData
            { txDataBlock = transactionBlock t
            , txData = transactionData t
            , txDataPrevs = ps
            , txDataDeleted = transactionDeleted t
            , txDataRBF = transactionRBF t
            , txDataTime = transactionTime t
            }
    f _ StoreCoinbase {} = Nothing
    f n StoreInput {inputPkScript = s, inputAmount = v} =
        Just (n, Prev {prevScript = s, prevAmount = v})
    ps = I.fromList . catMaybes $ zipWith f [0 ..] (transactionInputs t)
    g _ StoreOutput {outputSpender = Nothing} = Nothing
    g n StoreOutput {outputSpender = Just s}  = Just (n, s)
    sm = I.fromList . catMaybes $ zipWith g [0 ..] (transactionOutputs t)

-- | Detailed transaction information.
data Transaction = Transaction
    { transactionBlock    :: !BlockRef
      -- ^ block information for this transaction
    , transactionVersion  :: !Word32
      -- ^ transaction version
    , transactionLockTime :: !Word32
      -- ^ lock time
    , transactionInputs   :: ![StoreInput]
      -- ^ transaction inputs
    , transactionOutputs  :: ![StoreOutput]
      -- ^ transaction outputs
    , transactionDeleted  :: !Bool
      -- ^ this transaction has been deleted and is no longer valid
    , transactionRBF      :: !Bool
      -- ^ this transaction can be replaced in the mempool
    , transactionTime     :: !Word64
      -- ^ time the transaction was first seen or time of block
    } deriving (Show, Eq, Ord, Generic, Hashable, Serialize, NFData)

transactionData :: Transaction -> Tx
transactionData t =
    Tx
        { txVersion = transactionVersion t
        , txIn = map i (transactionInputs t)
        , txOut = map o (transactionOutputs t)
        , txWitness = mapMaybe inputWitness (transactionInputs t)
        , txLockTime = transactionLockTime t
        }
  where
    i StoreCoinbase {inputPoint = p, inputSequence = q, inputSigScript = s} =
        TxIn {prevOutput = p, scriptInput = s, txInSequence = q}
    i StoreInput {inputPoint = p, inputSequence = q, inputSigScript = s} =
        TxIn {prevOutput = p, scriptInput = s, txInSequence = q}
    o StoreOutput {outputAmount = v, outputScript = s} =
        TxOut {outValue = v, scriptOutput = s}

transactionToJSON :: Network -> Transaction -> Value
transactionToJSON net dtx =
    object
        [ "txid" .= txHash (transactionData dtx)
        , "size" .= B.length (S.encode (transactionData dtx))
        , "version" .= transactionVersion dtx
        , "locktime" .= transactionLockTime dtx
        , "fee" .=
          if any isCoinbase (transactionInputs dtx)
              then 0
              else inv - outv
        , "inputs" .= map (storeInputToJSON net) (transactionInputs dtx)
        , "outputs" .= map (storeOutputToJSON net) (transactionOutputs dtx)
        , "block" .= transactionBlock dtx
        , "deleted" .= transactionDeleted dtx
        , "time" .= transactionTime dtx
        , "rbf" .= transactionRBF dtx
        , "weight" .= w
        ]
  where
    inv = sum (map inputAmount (transactionInputs dtx))
    outv = sum (map outputAmount (transactionOutputs dtx))
    w =
        let b = B.length $ S.encode (transactionData dtx) {txWitness = []}
            x = B.length $ S.encode (transactionData dtx)
          in b * 3 + x

transactionToEncoding :: Network -> Transaction -> Encoding
transactionToEncoding net dtx =
    pairs
        (  "txid" `pair` text (txHashToHex (txHash (transactionData dtx)))
        <> "size" .= B.length (S.encode (transactionData dtx))
        <> "version" .= transactionVersion dtx
        <> "locktime" .= transactionLockTime dtx
        <> "fee" .= (if any isCoinbase (transactionInputs dtx) then 0 else inv - outv)
        <> "inputs" `pair` list (storeInputToEncoding net) (transactionInputs dtx)
        <> "outputs" `pair` list (storeOutputToEncoding net) (transactionOutputs dtx)
        <> "block" .= transactionBlock dtx
        <> "deleted" .= transactionDeleted dtx
        <> "time" .= transactionTime dtx
        <> "rbf" .= transactionRBF dtx
        <> "weight" .= w
        )
  where
    inv = sum (map inputAmount (transactionInputs dtx))
    outv = sum (map outputAmount (transactionOutputs dtx))
    w =
        let b = B.length $ S.encode (transactionData dtx) {txWitness = []}
            x = B.length $ S.encode (transactionData dtx)
          in b * 3 + x

instance FromJSON Transaction where
    parseJSON =
        A.withObject "transaction" $ \o -> do
            version <- o .: "version"
            locktime <- o .: "locktime"
            inputs <- o .: "inputs"
            outputs <- o .: "outputs"
            block <- o .: "block"
            deleted <- o .: "deleted"
            time <- o .: "time"
            rbf <- o .:? "rbf" .!= False
            return
                Transaction
                    { transactionBlock = block
                    , transactionVersion = version
                    , transactionLockTime = locktime
                    , transactionInputs = inputs
                    , transactionOutputs = outputs
                    , transactionDeleted = deleted
                    , transactionTime = time
                    , transactionRBF = rbf
                    }

-- | Information about a connected peer.
data PeerInformation
    = PeerInformation { peerUserAgent :: !ByteString
                        -- ^ user agent string
                      , peerAddress   :: !String
                        -- ^ network address
                      , peerVersion   :: !Word32
                        -- ^ version number
                      , peerServices  :: !Word64
                        -- ^ services field
                      , peerRelay     :: !Bool
                        -- ^ will relay transactions
                      }
    deriving (Show, Eq, Ord, Generic, NFData, Serialize)

instance ToJSON PeerInformation where
    toJSON p = object
        [ "useragent"   .= String (cs (peerUserAgent p))
        , "address"     .= peerAddress p
        , "version"     .= peerVersion p
        , "services"    .= String (encodeHex (S.encode (peerServices p)))
        , "relay"       .= peerRelay p
        ]
    toEncoding p = pairs
        (  "useragent"   `pair` text (cs (peerUserAgent p))
        <> "address"     .= peerAddress p
        <> "version"     .= peerVersion p
        <> "services"    `pair` text (encodeHex (S.encode (peerServices p)))
        <> "relay"       .= peerRelay p
        )

instance FromJSON PeerInformation where
    parseJSON =
        A.withObject "peerinformation" $ \o -> do
            String useragent <- o .: "useragent"
            address <- o .: "address"
            version <- o .: "version"
            services <-
                o .: "services" >>= jsonHex >>= \b ->
                    case S.decode b of
                        Left e  -> fail $ "Could not decode services: " <> e
                        Right s -> return s
            relay <- o .: "relay"
            return
                PeerInformation
                    { peerUserAgent = cs useragent
                    , peerAddress = address
                    , peerVersion = version
                    , peerServices = services
                    , peerRelay = relay
                    }

-- | Address balances for an extended public key.
data XPubBal = XPubBal
    { xPubBalPath :: ![KeyIndex]
    , xPubBal     :: !Balance
    } deriving (Show, Ord, Eq, Generic, Serialize, NFData)

xPubBalToJSON :: Network -> XPubBal -> Value
xPubBalToJSON net XPubBal {xPubBalPath = p, xPubBal = b} =
    object ["path" .= p, "balance" .= balanceToJSON net b]

xPubBalToEncoding :: Network -> XPubBal -> Encoding
xPubBalToEncoding net XPubBal {xPubBalPath = p, xPubBal = b} =
    pairs ("path" .= p <> "balance" `pair` balanceToEncoding net b)

xPubBalParseJSON :: Network -> Value -> Parser XPubBal
xPubBalParseJSON net =
    A.withObject "xpubbal" $ \o -> do
        path <- o .: "path"
        balance <- balanceParseJSON net =<< o .: "balance"
        return XPubBal {xPubBalPath = path, xPubBal = balance}

-- | Unspent transaction for extended public key.
data XPubUnspent = XPubUnspent
    { xPubUnspentPath :: ![KeyIndex]
    , xPubUnspent     :: !Unspent
    } deriving (Show, Eq, Generic, Serialize, NFData)

xPubUnspentToJSON :: Network -> XPubUnspent -> Value
xPubUnspentToJSON net XPubUnspent {xPubUnspentPath = p, xPubUnspent = u} =
    object ["path" .= p, "unspent" .= unspentToJSON net u]

xPubUnspentToEncoding :: Network -> XPubUnspent -> Encoding
xPubUnspentToEncoding net XPubUnspent {xPubUnspentPath = p, xPubUnspent = u} =
    pairs ("path" .= p <> "unspent" `pair` unspentToEncoding net u)

instance FromJSON XPubUnspent where
    parseJSON =
        A.withObject "xpubunspent" $ \o -> do
            p <- o .: "path"
            u <- o .: "unspent"
            return XPubUnspent {xPubUnspentPath = p, xPubUnspent = u}

data XPubSummary =
    XPubSummary
        { xPubSummaryConfirmed :: !Word64
        , xPubSummaryZero      :: !Word64
        , xPubSummaryReceived  :: !Word64
        , xPubUnspentCount     :: !Word64
        , xPubExternalIndex    :: !Word32
        , xPubChangeIndex      :: !Word32
        }
    deriving (Eq, Show, Generic, Serialize, NFData)

instance ToJSON XPubSummary where
    toJSON XPubSummary { xPubSummaryConfirmed = c
                       , xPubSummaryZero = z
                       , xPubSummaryReceived = r
                       , xPubUnspentCount = u
                       , xPubExternalIndex = ext
                       , xPubChangeIndex = ch
                       } =
        object
            [ "balance" .=
              object
                  [ "confirmed" .= c
                  , "unconfirmed" .= z
                  , "received" .= r
                  , "utxo" .= u
                  ]
            , "indices" .= object ["change" .= ch, "external" .= ext]
            ]
    toEncoding XPubSummary { xPubSummaryConfirmed = c
                       , xPubSummaryZero = z
                       , xPubSummaryReceived = r
                       , xPubUnspentCount = u
                       , xPubExternalIndex = ext
                       , xPubChangeIndex = ch
                       } =
        pairs
            (  "balance" `pair` pairs
                (  "confirmed" .= c
                <> "unconfirmed" .= z
                <> "received" .= r
                <> "utxo" .= u
                )
            <> "indices" `pair` pairs
                (  "change" .= ch
                <> "external" .= ext
                )
            )

instance FromJSON XPubSummary where
    parseJSON =
        A.withObject "xpubsummary" $ \o -> do
            b <- o .: "balance"
            i <- o .: "indices"
            conf <- b .: "confirmed"
            unconfirmed <- b .: "unconfirmed"
            received <- b .: "received"
            utxo <- b .: "utxo"
            change <- i .: "change"
            external <- i .: "external"
            return
                XPubSummary
                    { xPubSummaryConfirmed = conf
                    , xPubSummaryZero = unconfirmed
                    , xPubSummaryReceived = received
                    , xPubUnspentCount = utxo
                    , xPubExternalIndex = external
                    , xPubChangeIndex = change
                    }

data HealthCheck =
    HealthCheck
        { healthHeaderBest   :: !(Maybe BlockHash)
        , healthHeaderHeight :: !(Maybe BlockHeight)
        , healthBlockBest    :: !(Maybe BlockHash)
        , healthBlockHeight  :: !(Maybe BlockHeight)
        , healthPeers        :: !(Maybe Int)
        , healthNetwork      :: !String
        , healthOK           :: !Bool
        , healthSynced       :: !Bool
        , healthLastBlock    :: !(Maybe Word64)
        , healthLastTx       :: !(Maybe Word64)
        , healthVersion      :: !String
        }
    deriving (Show, Eq, Generic, Serialize, NFData)

instance ToJSON HealthCheck where
    toJSON h =
        object
            [ "headers" .=
              object
                  [ "hash" .= healthHeaderBest h
                  , "height" .= healthHeaderHeight h
                  ]
            , "blocks" .=
              object
                  ["hash" .= healthBlockBest h, "height" .= healthBlockHeight h]
            , "peers" .= healthPeers h
            , "net" .= healthNetwork h
            , "ok" .= healthOK h
            , "synced" .= healthSynced h
            , "version" .= healthVersion h
            , "lastblock" .= healthLastBlock h
            , "lasttx" .= healthLastTx h
            ]
    toEncoding h =
        pairs
            (  "headers" `pair`
              pairs
                  (  "hash" .= healthHeaderBest h
                  <> "height" .= healthHeaderHeight h
                  )
            <> "blocks" `pair`
              pairs
                  (  "hash" .= healthBlockBest h
                  <> "height" .= healthBlockHeight h
                  )
            <> "peers" .= healthPeers h
            <> "net" .= healthNetwork h
            <> "ok" .= healthOK h
            <> "synced" .= healthSynced h
            <> "version" .= healthVersion h
            <> "lastblock" .= healthLastBlock h
            <> "lasttx" .= healthLastTx h
            )

instance FromJSON HealthCheck where
    parseJSON =
        A.withObject "healthcheck" $ \o -> do
            headers <- o .: "headers"
            headers_hash <- headers .: "hash"
            headers_height <- headers .: "height"
            blocks <- o .: "blocks"
            blocks_hash <- blocks .: "hash"
            blocks_height <- blocks .: "height"
            peers <- o .: "peers"
            net <- o .: "net"
            ok <- o .: "ok"
            synced <- o .: "synced"
            lastblock <- o .: "lastblock"
            lasttx <- o .: "lasttx"
            ver <- o .: "version"
            return
                HealthCheck
                    { healthHeaderBest = headers_hash
                    , healthHeaderHeight = headers_height
                    , healthBlockBest = blocks_hash
                    , healthBlockHeight = blocks_height
                    , healthPeers = peers
                    , healthNetwork = net
                    , healthOK = ok
                    , healthSynced = synced
                    , healthLastBlock = lastblock
                    , healthLastTx = lasttx
                    , healthVersion = ver
                    }

data Event
    = EventBlock BlockHash
    | EventTx TxHash
    deriving (Show, Eq, Generic, Serialize, NFData)

instance ToJSON Event where
    toJSON (EventTx h)    = object ["type" .= String "tx", "id" .= h]
    toJSON (EventBlock h) = object ["type" .= String "block", "id" .= h]
    toEncoding (EventTx h) =
        pairs ("type" `pair` text "tx" <> "id" `pair` text (txHashToHex h))
    toEncoding (EventBlock h) =
        pairs
            ("type" `pair` text "block" <> "id" `pair` text (blockHashToHex h))

instance FromJSON Event where
    parseJSON =
        A.withObject "event" $ \o -> do
            t <- o .: "type"
            case t of
                "tx" -> do
                    i <- o .: "id"
                    return $ EventTx i
                "block" -> do
                    i <- o .: "id"
                    return $ EventBlock i
                _ -> fail $ "Could not recognize event type: " <> t

newtype GenericResult a = GenericResult
    { getResult :: a
    } deriving (Show, Eq, Generic, Serialize, NFData)

instance ToJSON a => ToJSON (GenericResult a) where
    toJSON (GenericResult b) = object ["result" .= b]
    toEncoding (GenericResult b) = pairs ("result" .= b)

instance FromJSON a => FromJSON (GenericResult a) where
    parseJSON =
        A.withObject "result" $ \o -> GenericResult <$> o .: "result"

newtype TxId =
    TxId TxHash
    deriving (Show, Eq, Generic, Serialize, NFData)

instance ToJSON TxId where
    toJSON (TxId h) = object ["txid" .= h]
    toEncoding (TxId h) = pairs ("txid" `pair` text (txHashToHex h))

instance FromJSON TxId where
    parseJSON = A.withObject "txid" $ \o -> TxId <$> o .: "txid"

scriptToAddrJSON :: Network -> ByteString -> Value
scriptToAddrJSON net bs =
    case scriptToAddressBS bs of
        Left _  -> Null
        Right a -> addrToJSON net a

scriptToAddrEncoding :: Network -> ByteString -> Encoding
scriptToAddrEncoding net bs =
    case scriptToAddressBS bs of
        Left _  -> null_
        Right a -> addrToEncoding net a

data Except
    = ThingNotFound
    | ServerError
    | BadRequest
    | UserError String
    | StringError String
    | BlockTooLarge
    deriving (Eq, Ord, Serialize, Generic, NFData)

instance Show Except where
    show ThingNotFound   = "not found"
    show ServerError     = "you made me kill a unicorn"
    show BadRequest      = "bad request"
    show (UserError s)   = s
    show (StringError _) = "you killed the dragon with your bare hands"
    show BlockTooLarge   = "block too large"

instance Exception Except

instance ScottyError Except where
    stringError = StringError
    showError = TL.pack . show

instance ToJSON Except where
    toJSON e = object ["error" .= TL.pack (show e)]