{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
module Haskoin.Store.Common
    ( BlockStoreMessage(..)
    , DeriveType(..)
    , Limit
    , Offset
    , BlockStore
    , UnixTime
    , getUnixTime
    , putUnixTime
    , BlockPos
    , XPubSpec(..)
    , StoreRead(..)
    , StoreWrite(..)
    , JsonSerial(..)
    , BinSerial(..)
    , BlockRef(..)
    , BlockTx(..)
    , confirmed
    , Balance(..)
    , BlockData(..)
    , StoreInput(..)
    , isCoinbase
    , Spender(..)
    , StoreOutput(..)
    , Prev(..)
    , TxData(..)
    , Unspent(..)
    , Transaction(..)
    , transactionData
    , fromTransaction
    , toTransaction
    , TxAfterHeight(..)
    , TxId(..)
    , PeerInformation(..)
    , XPubBal(..)
    , xPubBalsTxs
    , XPubUnspent(..)
    , xPubBalsUnspents
    , XPubSummary(..)
    , HealthCheck(..)
    , Event(..)
    , StoreEvent(..)
    , PubExcept(..)
    , zeroBalance
    , nullBalance
    , getTransaction
    , blockAtOrBefore
    , applyOffset
    , applyLimit
    , applyOffsetLimit
    , applyOffsetC
    , applyLimitC
    , applyOffsetLimitC
    , sortTxs
    ) where

import           Conduit                   (ConduitT, dropC, mapC, takeC)
import           Control.Applicative       ((<|>))
import           Control.DeepSeq           (NFData)
import           Control.Exception         (Exception)
import           Control.Monad             (guard, mzero)
import           Control.Monad.Trans       (lift)
import           Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)
import           Data.Aeson                (Encoding, ToJSON (..), Value (..),
                                            object, pairs, (.=))
import qualified Data.Aeson                as A
import qualified Data.Aeson.Encoding       as A
import           Data.ByteString           (ByteString)
import qualified Data.ByteString           as B
import           Data.ByteString.Short     (ShortByteString)
import qualified Data.ByteString.Short     as B.Short
import           Data.Function             (on)
import           Data.Hashable             (Hashable (..))
import qualified Data.IntMap               as I
import           Data.IntMap.Strict        (IntMap)
import           Data.List                 (nub, partition, sortBy)
import           Data.Maybe                (catMaybes, isJust, listToMaybe,
                                            mapMaybe)
import           Data.Serialize            (Get, Put, Putter, Serialize (..),
                                            getListOf, getShortByteString,
                                            getWord32be, getWord64be, getWord8,
                                            putListOf, putShortByteString,
                                            putWord32be, putWord64be, putWord8)
import qualified Data.Serialize            as S
import           Data.String.Conversions   (cs)
import qualified Data.Text.Encoding        as T
import           Data.Word                 (Word32, Word64)
import           GHC.Generics              (Generic)
import           Haskoin                   (Address, Block, BlockHash,
                                            BlockHeader (..), BlockHeight,
                                            BlockNode, BlockWork, HostAddress,
                                            KeyIndex, Network (..),
                                            NetworkAddress (..), OutPoint (..),
                                            PubKeyI (..), RejectCode (..),
                                            Tx (..), TxHash (..), TxIn (..),
                                            TxOut (..), WitnessStack,
                                            XPubKey (..), addrToJSON,
                                            addrToString, deriveAddr,
                                            deriveCompatWitnessAddr,
                                            deriveWitnessAddr, eitherToMaybe,
                                            encodeHex, headerHash,
                                            hostToSockAddr, pubSubKey,
                                            scriptToAddressBS, stringToAddr,
                                            txHash, wrapPubKey)
import           Haskoin.Node              (Peer)
import           Network.Socket            (SockAddr)
import           NQE                       (Listen, Mailbox)
import qualified Paths_haskoin_store       as P

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

-- | Messages for block store actor.
data BlockStoreMessage
    = BlockNewBest !BlockNode
      -- ^ new block header in chain
    | BlockPeerConnect !Peer !SockAddr
      -- ^ new peer connected
    | BlockPeerDisconnect !Peer !SockAddr
      -- ^ peer disconnected
    | BlockReceived !Peer !Block
      -- ^ new block received from a peer
    | BlockNotFound !Peer ![BlockHash]
      -- ^ block not found
    | BlockTxReceived !Peer !Tx
      -- ^ transaction received from peer
    | BlockTxAvailable !Peer ![TxHash]
      -- ^ peer has transactions available
    | BlockPing !(Listen ())
      -- ^ internal housekeeping ping

-- | Mailbox for block store.
type BlockStore = Mailbox BlockStoreMessage

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 DeriveAddr = XPubKey -> KeyIndex -> Address

type UnixTime = Word64
type BlockPos = Word32

type Offset = Word32
type Limit = Word32

class Monad m =>
      StoreRead m
    where
    getBestBlock :: m (Maybe BlockHash)
    getBlocksAtHeight :: BlockHeight -> m [BlockHash]
    getBlock :: BlockHash -> m (Maybe BlockData)
    getTxData :: TxHash -> m (Maybe TxData)
    getOrphanTx :: TxHash -> m (Maybe (UnixTime, Tx))
    getOrphans :: m [(UnixTime, Tx)]
    getSpenders :: TxHash -> m (IntMap Spender)
    getSpender :: OutPoint -> m (Maybe Spender)
    getBalance :: Address -> m Balance
    getBalance a = head <$> getBalances [a]
    getBalances :: [Address] -> m [Balance]
    getBalances as = mapM getBalance as
    getAddressesTxs :: [Address] -> Maybe BlockRef -> Maybe Limit -> m [BlockTx]
    getAddressTxs :: Address -> Maybe BlockRef -> Maybe Limit -> m [BlockTx]
    getAddressTxs a = getAddressesTxs [a]
    getUnspent :: OutPoint -> m (Maybe Unspent)
    getAddressUnspents ::
           Address -> Maybe BlockRef -> Maybe Limit -> m [Unspent]
    getAddressUnspents a = getAddressesUnspents [a]
    getAddressesUnspents ::
           [Address] -> Maybe BlockRef -> Maybe Limit -> m [Unspent]
    getMempool :: m [BlockTx]
    xPubBals :: XPubSpec -> m [XPubBal]
    xPubBals xpub = do
        gap <- getMaxGap
        ext <-
            derive_until_gap
                gap
                0
                (deriveAddresses
                     (deriveFunction (xPubDeriveType xpub))
                     (pubSubKey (xPubSpecKey xpub) 0)
                     0)
        chg <-
            derive_until_gap
                gap
                1
                (deriveAddresses
                     (deriveFunction (xPubDeriveType xpub))
                     (pubSubKey (xPubSpecKey xpub) 1)
                     0)
        return (ext ++ chg)
      where
        xbalance m b n = XPubBal {xPubBalPath = [m, n], xPubBal = b}
        derive_until_gap _ _ [] = return []
        derive_until_gap gap m as = do
            let (as1, as2) = splitAt (fromIntegral gap) as
            bs <- getBalances (map snd as1)
            let xbs = zipWith (xbalance m) bs (map fst as1)
            if all nullBalance bs
                then return xbs
                else (xbs <>) <$> derive_until_gap gap m as2
    xPubSummary :: XPubSpec -> m XPubSummary
    xPubSummary xpub = do
        bs <- filter (not . nullBalance . xPubBal) <$> xPubBals xpub
        let ex = foldl max 0 [i | XPubBal {xPubBalPath = [0, i]} <- bs]
            ch = foldl max 0 [i | XPubBal {xPubBalPath = [1, i]} <- bs]
            uc =
                sum
                    [ c
                    | XPubBal {xPubBal = Balance {balanceUnspentCount = c}} <-
                          bs
                    ]
            xt = [b | b@XPubBal {xPubBalPath = [0, _]} <- bs]
            rx =
                sum
                    [ r
                    | XPubBal {xPubBal = Balance {balanceTotalReceived = r}} <-
                          xt
                    ]
        return
            XPubSummary
                { xPubSummaryConfirmed = sum (map (balanceAmount . xPubBal) bs)
                , xPubSummaryZero = sum (map (balanceZero . xPubBal) bs)
                , xPubSummaryReceived = rx
                , xPubUnspentCount = uc
                , xPubChangeIndex = ch
                , xPubExternalIndex = ex
                }
    xPubUnspents ::
           XPubSpec
        -> Maybe BlockRef
        -> Offset
        -> Maybe Limit
        -> m [XPubUnspent]
    xPubUnspents xpub start offset limit = do
        xs <- filter positive <$> xPubBals xpub
        applyOffsetLimit offset limit <$> go xs
      where
        positive XPubBal {xPubBal = Balance {balanceUnspentCount = c}} = c > 0
        go [] = return []
        go (XPubBal {xPubBalPath = p, xPubBal = Balance {balanceAddress = a}}:xs) = do
            uns <- getAddressUnspents a start limit
            let xuns =
                    map
                        (\t ->
                             XPubUnspent {xPubUnspentPath = p, xPubUnspent = t})
                        uns
            (xuns <>) <$> go xs
    xPubTxs ::
           XPubSpec -> Maybe BlockRef -> Offset -> Maybe Limit -> m [BlockTx]
    xPubTxs xpub start offset limit = do
        bs <- xPubBals xpub
        let as = map (balanceAddress . xPubBal) bs
        ts <- concat <$> mapM (\a -> getAddressTxs a start limit) as
        let ts' = nub $ sortBy (flip compare `on` blockTxBlock) ts
        return $ applyOffsetLimit offset limit ts'
    getMaxGap :: m Word32
    getMaxGap = return 32

class StoreWrite m where
    setBest :: BlockHash -> m ()
    insertBlock :: BlockData -> m ()
    setBlocksAtHeight :: [BlockHash] -> BlockHeight -> m ()
    insertTx :: TxData -> m ()
    insertSpender :: OutPoint -> Spender -> m ()
    deleteSpender :: OutPoint -> m ()
    insertAddrTx :: Address -> BlockTx -> m ()
    deleteAddrTx :: Address -> BlockTx -> m ()
    insertAddrUnspent :: Address -> Unspent -> m ()
    deleteAddrUnspent :: Address -> Unspent -> m ()
    setMempool :: [BlockTx] -> m ()
    insertOrphanTx :: Tx -> UnixTime -> m ()
    deleteOrphanTx :: TxHash -> m ()
    setBalance :: Balance -> m ()
    insertUnspent :: Unspent -> m ()
    deleteUnspent :: OutPoint -> m ()

deriveAddresses :: DeriveAddr -> XPubKey -> Word32 -> [(Word32, Address)]
deriveAddresses derive xpub start = map (\i -> (i, derive xpub i)) [start ..]

deriveFunction :: DeriveType -> DeriveAddr
deriveFunction DeriveNormal i = fst . deriveAddr i
deriveFunction DeriveP2SH i   = fst . deriveCompatWitnessAddr i
deriveFunction DeriveP2WPKH i = fst . deriveWitnessAddr i

xPubBalsUnspents ::
       StoreRead m
    => [XPubBal]
    -> Maybe BlockRef
    -> Offset
    -> Maybe Limit
    -> m [XPubUnspent]
xPubBalsUnspents bals start offset limit = do
    let xs = filter positive bals
    applyOffsetLimit offset limit <$> go xs
  where
    positive XPubBal {xPubBal = Balance {balanceUnspentCount = c}} = c > 0
    go [] = return []
    go (XPubBal {xPubBalPath = p, xPubBal = Balance {balanceAddress = a}}:xs) = do
        uns <- getAddressUnspents a start limit
        let xuns =
                map
                    (\t ->
                          XPubUnspent {xPubUnspentPath = p, xPubUnspent = t})
                    uns
        (xuns <>) <$> go xs

xPubBalsTxs ::
       StoreRead m
    => [XPubBal]
    -> Maybe BlockRef
    -> Offset
    -> Maybe Limit
    -> m [BlockTx]
xPubBalsTxs bals start offset limit = do
    let as = map balanceAddress . filter (not . nullBalance) $ map xPubBal bals
    ts <- concat <$> mapM (\a -> getAddressTxs a start limit) as
    let ts' = nub $ sortBy (flip compare `on` blockTxBlock) ts
    return $ applyOffsetLimit offset limit ts'

getTransaction ::
       (Monad m, StoreRead m) => TxHash -> m (Maybe Transaction)
getTransaction h = runMaybeT $ do
    d <- MaybeT $ getTxData h
    sm <- lift $ getSpenders h
    return $ toTransaction d sm

blockAtOrBefore :: (Monad m, StoreRead m) => UnixTime -> m (Maybe BlockData)
blockAtOrBefore q = runMaybeT $ do
    a <- g 0
    b <- MaybeT getBestBlock >>= MaybeT . getBlock
    f a b
  where
    f a b
        | t b <= q = return b
        | t a > q = mzero
        | h b - h a == 1 = return a
        | otherwise = do
              let x = h a + (h b - h a) `div` 2
              m <- g x
              if t m > q then f a m else f m b
    g x = MaybeT (listToMaybe <$> getBlocksAtHeight x) >>= MaybeT . getBlock
    h = blockDataHeight
    t = fromIntegral . blockTimestamp . blockDataHeader

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

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

class JsonSerial a where
    jsonSerial :: Network -> a -> Encoding
    jsonValue :: Network -> a -> Value

instance JsonSerial a => JsonSerial [a] where
    jsonSerial net = A.list (jsonSerial net)
    jsonValue net = toJSON . (jsonValue net)

instance JsonSerial TxHash where
    jsonSerial _ = toEncoding
    jsonValue _ = toJSON

instance BinSerial TxHash where
    binSerial _ = put
    binDeserial _  = get

instance BinSerial Address where
    binSerial net a =
        case addrToString net a of
            Nothing -> put B.empty
            Just x  -> put $ T.encodeUtf8 x

    binDeserial net = do
          bs <- get
          guard (not (B.null bs))
          t <- case T.decodeUtf8' bs of
            Left _  -> mzero
            Right v -> return v
          case stringToAddr net t of
            Nothing -> mzero
            Just x  -> return x

class BinSerial a where
    binSerial :: Network -> Putter a
    binDeserial :: Network -> Get a

instance BinSerial a => BinSerial [a] where
    binSerial net = putListOf (binSerial net)
    binDeserial net = getListOf (binDeserial net)

-- | 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}

instance BinSerial BlockRef where
    binSerial _ BlockRef {blockRefHeight = h, blockRefPos = p} = do
        putWord8 0x00
        putWord32be h
        putWord32be p
    binSerial _ MemRef {memRefTime = t} = do
        putWord8 0x01
        putWord64be t

    binDeserial _ = getWord8 >>=
        \case
            0x00 -> BlockRef <$> getWord32be <*> getWord32be
            0x01 -> MemRef <$> getUnixTime
            _ -> fail "Expected fst byte to be 0x00 or 0x01"

-- | JSON serialization for 'BlockRef'.
blockRefPairs :: A.KeyValue kv => BlockRef -> [kv]
blockRefPairs BlockRef {blockRefHeight = h, blockRefPos = p} =
    ["height" .= h, "position" .= p]
blockRefPairs MemRef {memRefTime = t} = ["mempool" .= t]

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

instance ToJSON BlockRef where
    toJSON = object . blockRefPairs
    toEncoding = pairs . mconcat . blockRefPairs

-- | 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)

-- | JSON serialization for 'AddressTx'.
blockTxPairs :: A.KeyValue kv => BlockTx -> [kv]
blockTxPairs btx =
    [ "txid" .= blockTxHash btx
    , "block" .= blockTxBlock btx
    ]

instance ToJSON BlockTx where
    toJSON = object . blockTxPairs
    toEncoding = pairs . mconcat . blockTxPairs

instance JsonSerial BlockTx where
    jsonSerial _ = toEncoding
    jsonValue _ = toJSON

instance BinSerial BlockTx where
    binSerial net BlockTx { blockTxBlock = b, blockTxHash = h } = do
        binSerial net b
        binSerial net h

    binDeserial net = BlockTx <$> binDeserial net <*> binDeserial net

-- | 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

-- | JSON serialization for 'Balance'.
balancePairs :: A.KeyValue kv => Network -> Balance -> [kv]
balancePairs net ab =
    [ "address" .= addrToJSON net (balanceAddress ab)
    , "confirmed" .= balanceAmount ab
    , "unconfirmed" .= balanceZero ab
    , "utxo" .= balanceUnspentCount ab
    , "txs" .= balanceTxCount ab
    , "received" .= balanceTotalReceived ab
    ]

balanceToJSON :: Network -> Balance -> Value
balanceToJSON net = object . balancePairs net

balanceToEncoding :: Network -> Balance -> Encoding
balanceToEncoding net = pairs . mconcat . balancePairs net

instance JsonSerial Balance where
    jsonSerial = balanceToEncoding
    jsonValue = balanceToJSON

instance BinSerial Balance where
    binSerial net Balance { balanceAddress = a
                          , balanceAmount = v
                          , balanceZero = z
                          , balanceUnspentCount = u
                          , balanceTxCount = c
                          , balanceTotalReceived = t
                          } = do
        binSerial net a
        putWord64be v
        putWord64be z
        putWord64be u
        putWord64be c
        putWord64be t

    binDeserial net =
      Balance <$> binDeserial net
        <*> getWord64be
        <*> getWord64be
        <*> getWord64be
        <*> getWord64be
        <*> getWord64be


-- | Unspent output.
data Unspent = Unspent
    { unspentBlock  :: !BlockRef
      -- ^ block information for output
    , unspentPoint  :: !OutPoint
      -- ^ txid and index where output located
    , unspentAmount :: !Word64
      -- ^ value of output in satoshi
    , unspentScript :: !ShortByteString
      -- ^ pubkey (output) script
    } deriving (Show, Eq, Ord, Generic, Hashable, NFData)

instance Serialize Unspent where
    put u = do
        put $ unspentBlock u
        put $ unspentPoint u
        put $ unspentAmount u
        put $ B.Short.length (unspentScript u)
        putShortByteString $ unspentScript u
    get =
        Unspent <$> get <*> get <*> get <*> (getShortByteString =<< get)

unspentPairs :: A.KeyValue kv => Network -> Unspent -> [kv]
unspentPairs net u =
    [ "address" .=
      eitherToMaybe
          (addrToJSON net <$>
           scriptToAddressBS (B.Short.fromShort (unspentScript u)))
    , "block" .= unspentBlock u
    , "txid" .= outPointHash (unspentPoint u)
    , "index" .= outPointIndex (unspentPoint u)
    , "pkscript" .= String (encodeHex (B.Short.fromShort (unspentScript u)))
    , "value" .= unspentAmount u
    ]

unspentToJSON :: Network -> Unspent -> Value
unspentToJSON net = object . unspentPairs net

unspentToEncoding :: Network -> Unspent -> Encoding
unspentToEncoding net = pairs . mconcat . unspentPairs net

instance JsonSerial Unspent where
    jsonSerial = unspentToEncoding
    jsonValue = unspentToJSON

instance BinSerial Unspent where
    binSerial net Unspent { unspentBlock = b
                          , unspentPoint = p
                          , unspentAmount = v
                          , unspentScript = s
                          } = do
        binSerial net b
        put p
        putWord64be v
        put s

    binDeserial net =
      Unspent
      <$> binDeserial net
      <*> get
      <*> getWord64be
      <*> get

-- | 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)

-- | JSON serialization for 'BlockData'.
blockDataPairs :: A.KeyValue kv => Network -> BlockData -> [kv]
blockDataPairs net bv =
    [ "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
    ] ++ ["weight" .= blockDataWeight bv | getSegWit net]

blockDataToJSON :: Network -> BlockData -> Value
blockDataToJSON net = object . blockDataPairs net

blockDataToEncoding :: Network -> BlockData -> Encoding
blockDataToEncoding net = pairs . mconcat . blockDataPairs net

instance JsonSerial BlockData where
    jsonSerial = blockDataToEncoding
    jsonValue = blockDataToJSON

instance BinSerial BlockData where
    binSerial _ BlockData { blockDataHeight = e
                          , blockDataMainChain = m
                          , blockDataWork = w
                          , blockDataHeader = h
                          , blockDataSize = z
                          , blockDataWeight = g
                          , blockDataTxs = t
                          , blockDataOutputs = o
                          , blockDataFees = f
                          , blockDataSubsidy = y
                          } = do
        put m
        putWord32be e
        put h
        put w
        putWord32be z
        putWord32be g
        putWord64be o
        putWord64be f
        putWord64be y
        put t

    binDeserial _ = do
      m <- get
      e <- getWord32be
      h <- get
      w <- get
      z <- getWord32be
      g <- getWord32be
      o <- getWord64be
      f <- getWord64be
      y <- getWord64be
      t <- get
      return $ BlockData e m w h z g t o f y

-- | Input information.
data StoreInput
    = StoreCoinbase { inputPoint     :: !OutPoint
                 -- ^ output being spent (should be null)
                    , inputSequence  :: !Word32
                 -- ^ sequence
                    , inputSigScript :: !ByteString
                 -- ^ input script data (not valid script)
                    , inputWitness   :: !(Maybe WitnessStack)
                 -- ^ witness data for this input (only segwit)
                     }
    -- ^ coinbase details
    | StoreInput { inputPoint     :: !OutPoint
              -- ^ output being spent
                 , inputSequence  :: !Word32
              -- ^ sequence
                 , inputSigScript :: !ByteString
              -- ^ signature (input) script
                 , inputPkScript  :: !ByteString
              -- ^ pubkey (output) script from previous tx
                 , inputAmount    :: !Word64
              -- ^ amount in satoshi being spent spent
                 , inputWitness   :: !(Maybe WitnessStack)
              -- ^ witness data for this input (only segwit)
                  }
    -- ^ input details
    deriving (Show, Read, Eq, Ord, Generic, Serialize, Hashable, NFData)

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

inputPairs :: A.KeyValue kv => Network -> StoreInput -> [kv]
inputPairs net StoreInput { inputPoint = OutPoint oph opi
                          , inputSequence = sq
                          , inputSigScript = ss
                          , inputPkScript = ps
                          , inputAmount = val
                          , inputWitness = wit
                          } =
    [ "coinbase" .= False
    , "txid" .= oph
    , "output" .= opi
    , "sigscript" .= String (encodeHex ss)
    , "sequence" .= sq
    , "pkscript" .= String (encodeHex ps)
    , "value" .= val
    , "address" .= eitherToMaybe (addrToJSON net <$> scriptToAddressBS ps)
    ] ++
    ["witness" .= fmap (map encodeHex) wit | getSegWit net]

inputPairs net StoreCoinbase { inputPoint = OutPoint oph opi
                             , inputSequence = sq
                             , inputSigScript = ss
                             , inputWitness = wit
                             } =
    [ "coinbase" .= True
    , "txid" .= oph
    , "output" .= opi
    , "sigscript" .= String (encodeHex ss)
    , "sequence" .= sq
    , "pkscript" .= Null
    , "value" .= Null
    , "address" .= Null
    ] ++
    ["witness" .= fmap (map encodeHex) wit | getSegWit net]

-- | 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)

-- | JSON serialization for 'Spender'.
spenderPairs :: A.KeyValue kv => Spender -> [kv]
spenderPairs n =
    ["txid" .= spenderHash n, "input" .= spenderIndex n]

instance ToJSON Spender where
    toJSON = object . spenderPairs
    toEncoding = pairs . mconcat . spenderPairs

-- | Output information.
data StoreOutput = StoreOutput
    { outputAmount  :: !Word64
      -- ^ amount in satoshi
    , outputScript  :: !ByteString
      -- ^ pubkey (output) script
    , outputSpender :: !(Maybe Spender)
      -- ^ input spending this transaction
    } deriving (Show, Read, Eq, Ord, Generic, Serialize, Hashable, NFData)

outputPairs :: A.KeyValue kv => Network -> StoreOutput -> [kv]
outputPairs net d =
    [ "address" .=
      eitherToMaybe (addrToJSON net <$> scriptToAddressBS (outputScript d))
    , "pkscript" .= String (encodeHex (outputScript d))
    , "value" .= outputAmount d
    , "spent" .= isJust (outputSpender d)
    ] ++
    ["spender" .= outputSpender d | isJust (outputSpender d)]

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)

instance BinSerial TxData where
  binSerial _ TxData
        { txDataBlock   = br
        , txData        = tx
        , txDataPrevs   = dp
        , txDataDeleted = dd
        , txDataRBF     = dr
        , txDataTime    = t
        } = do
      put br
      put tx
      put dp
      put dd
      put dr
      putWord64be t

  binDeserial _ = do br <- get
                     tx <- get
                     dp <- get
                     dd <- get
                     dr <- get
                     TxData br tx dp dd dr <$> getWord64be

instance Serialize a => BinSerial (IntMap a) where
  binSerial _ = put
  binDeserial _ = get

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}

-- | JSON serialization for 'Transaction'.
transactionPairs :: A.KeyValue kv => Network -> Transaction -> [kv]
transactionPairs net dtx =
    [ "txid" .= txHash (transactionData dtx)
    , "size" .= B.length (S.encode (transactionData dtx))
    , "version" .= transactionVersion dtx
    , "locktime" .= transactionLockTime dtx
    , "fee" .=
      if all isCoinbase (transactionInputs dtx)
          then 0
          else sum (map inputAmount (transactionInputs dtx)) -
               sum (map outputAmount (transactionOutputs dtx))
    , "inputs" .= map (object . inputPairs net) (transactionInputs dtx)
    , "outputs" .= map (object . outputPairs net) (transactionOutputs dtx)
    , "block" .= transactionBlock dtx
    , "deleted" .= transactionDeleted dtx
    , "time" .= transactionTime dtx
    ] ++
    ["rbf" .= transactionRBF dtx | getReplaceByFee net] ++
    ["weight" .= w | getSegWit net]
  where
    w = let b = B.length $ S.encode (transactionData dtx) {txWitness = []}
            x = B.length $ S.encode (transactionData dtx)
        in b * 3 + x

transactionToJSON :: Network -> Transaction -> Value
transactionToJSON net = object . transactionPairs net

transactionToEncoding :: Network -> Transaction -> Encoding
transactionToEncoding net = pairs . mconcat . transactionPairs net

instance JsonSerial Transaction where
    jsonSerial = transactionToEncoding
    jsonValue = transactionToJSON

instance BinSerial Transaction where
    binSerial net tx = do
        let (txd, sp) = fromTransaction tx
        binSerial net txd
        binSerial net sp

    binDeserial net = do
      txd <- binDeserial net
      sp <- binDeserial net
      return $ toTransaction txd sp

instance JsonSerial Tx where
    jsonSerial _ = toEncoding
    jsonValue _ = toJSON

instance BinSerial Tx where
    binSerial _ = put
    binDeserial _ = get

instance JsonSerial Block where
    jsonSerial _ = toEncoding
    jsonValue _ = toJSON

instance BinSerial Block where
    binSerial _ = put
    binDeserial _ = get

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

-- | JSON serialization for 'PeerInformation'.
peerInformationPairs :: A.KeyValue kv => PeerInformation -> [kv]
peerInformationPairs p =
    [ "useragent"   .= String (cs (peerUserAgent p))
    , "address"     .= String (cs (show (hostToSockAddr (peerAddress p))))
    , "version"     .= peerVersion p
    , "services"    .= String (encodeHex (S.encode (peerServices p)))
    , "relay"       .= peerRelay p
    ]

instance ToJSON PeerInformation where
    toJSON = object . peerInformationPairs
    toEncoding = pairs . mconcat . peerInformationPairs

instance JsonSerial PeerInformation where
    jsonSerial _ = toEncoding
    jsonValue _ = toJSON

instance BinSerial PeerInformation where
    binSerial _ PeerInformation { peerUserAgent = u
                                , peerAddress = a
                                , peerVersion = v
                                , peerServices = s
                                , peerRelay = b
                                } = do
        putWord32be v
        put b
        put u
        put $ NetworkAddress s a

    binDeserial _ = do
      v <- getWord32be
      b <- get
      u <- get
      NetworkAddress { naServices = s, naAddress = a } <- get
      return $ PeerInformation u a v s b

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

-- | JSON serialization for 'XPubBal'.
xPubBalPairs :: A.KeyValue kv => Network -> XPubBal -> [kv]
xPubBalPairs net XPubBal {xPubBalPath = p, xPubBal = b} =
    [ "path" .= p
    , "balance" .= balanceToJSON net b
    ]

xPubBalToJSON :: Network -> XPubBal -> Value
xPubBalToJSON net = object . xPubBalPairs net

xPubBalToEncoding :: Network -> XPubBal -> Encoding
xPubBalToEncoding net = pairs . mconcat . xPubBalPairs net

instance JsonSerial XPubBal where
    jsonSerial = xPubBalToEncoding
    jsonValue = xPubBalToJSON

instance BinSerial XPubBal where
    binSerial net XPubBal {xPubBalPath = p, xPubBal = b} = do
        put p
        binSerial net b
    binDeserial net  = do
      p <- get
      b <- binDeserial net
      return $ XPubBal p b

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

-- | JSON serialization for 'XPubUnspent'.
xPubUnspentPairs :: A.KeyValue kv => Network -> XPubUnspent -> [kv]
xPubUnspentPairs net XPubUnspent { xPubUnspentPath = p
                                 , xPubUnspent = u
                                 } =
    [ "path" .= p
    , "unspent" .= unspentToJSON net u
    ]

xPubUnspentToJSON :: Network -> XPubUnspent -> Value
xPubUnspentToJSON net = object . xPubUnspentPairs net

xPubUnspentToEncoding :: Network -> XPubUnspent -> Encoding
xPubUnspentToEncoding net = pairs . mconcat . xPubUnspentPairs net

instance JsonSerial XPubUnspent where
    jsonSerial = xPubUnspentToEncoding
    jsonValue = xPubUnspentToJSON

instance BinSerial XPubUnspent where
    binSerial net XPubUnspent {xPubUnspentPath = p, xPubUnspent = u} = do
        put p
        binSerial net u

    binDeserial net = do
      p <- get
      u <- binDeserial net
      return $ XPubUnspent p u

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

xPubSummaryPairs :: A.KeyValue kv => XPubSummary -> [kv]
xPubSummaryPairs XPubSummary { xPubSummaryConfirmed = c
                               , xPubSummaryZero = z
                               , xPubSummaryReceived = r
                               , xPubUnspentCount = u
                               , xPubExternalIndex = ext
                               , xPubChangeIndex = ch
                               } =
    [ "balance" .=
      object
          ["confirmed" .= c, "unconfirmed" .= z, "received" .= r, "utxo" .= u]
    , "indices" .= object ["change" .= ch, "external" .= ext]
    ]

xPubSummaryToJSON :: XPubSummary -> Value
xPubSummaryToJSON = object . xPubSummaryPairs

xPubSummaryToEncoding :: XPubSummary -> Encoding
xPubSummaryToEncoding = pairs . mconcat . xPubSummaryPairs

instance ToJSON XPubSummary where
    toJSON = xPubSummaryToJSON
    toEncoding = xPubSummaryToEncoding

instance JsonSerial XPubSummary where
    jsonSerial _ = xPubSummaryToEncoding
    jsonValue _ = xPubSummaryToJSON

instance BinSerial XPubSummary where
    binSerial _ = put
    binDeserial _ = get

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)
        }
    deriving (Show, Eq, Generic, Serialize, NFData)

healthCheckPairs :: A.KeyValue kv => HealthCheck -> [kv]
healthCheckPairs h =
    [ "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" .= P.version
    , "lastblock" .= healthLastBlock h
    , "lasttx" .= healthLastTx h
    ]

instance ToJSON HealthCheck where
    toJSON = object . healthCheckPairs
    toEncoding = pairs . mconcat . healthCheckPairs

instance JsonSerial HealthCheck where
    jsonSerial _ = toEncoding
    jsonValue _ = toJSON

instance BinSerial HealthCheck where
    binSerial _ HealthCheck { healthHeaderBest = hbest
                            , healthHeaderHeight = hheight
                            , healthBlockBest = bbest
                            , healthBlockHeight = bheight
                            , healthPeers = peers
                            , healthNetwork = net
                            , healthOK = ok
                            , healthSynced = synced
                            , healthLastBlock = lbk
                            , healthLastTx = ltx
                            } = do
        put hbest
        put hheight
        put bbest
        put bheight
        put peers
        put net
        put ok
        put synced
        put lbk
        put ltx
    binDeserial _ =
        HealthCheck <$> get <*> get <*> get <*> get <*> get <*> get <*> get <*>
        get <*>
        get <*>
        get

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

instance ToJSON Event where
    toJSON (EventTx h)    = object ["type" .= String "tx", "id" .= h]
    toJSON (EventBlock h) = object ["type" .= String "block", "id" .= h]

instance JsonSerial Event where
    jsonSerial _ = toEncoding
    jsonValue _ = toJSON

instance BinSerial Event where
    binSerial _ (EventBlock bh) = putWord8 0x00 >> put bh
    binSerial _ (EventTx th)    = putWord8 0x01 >> put th

    binDeserial _ = getWord8 >>=
            \case
                0x00-> EventBlock <$> get
                0x01 -> EventTx <$> get
                _ -> fail "Expected fst byte to be 0x00 or 0x01"


newtype TxAfterHeight = TxAfterHeight
    { txAfterHeight :: Maybe Bool
    } deriving (Show, Eq, Generic, NFData)

instance ToJSON TxAfterHeight where
    toJSON (TxAfterHeight b) = object ["result" .= b]

instance JsonSerial TxAfterHeight where
    jsonSerial _ = toEncoding
    jsonValue _ = toJSON

instance BinSerial TxAfterHeight where
    binSerial _ TxAfterHeight {txAfterHeight = a} = put a
    binDeserial _ = TxAfterHeight <$> get

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

instance ToJSON TxId where
    toJSON (TxId h) = object ["txid" .= h]

instance JsonSerial TxId where
    jsonSerial _ = toEncoding
    jsonValue _ = toJSON

instance BinSerial TxId where
    binSerial _ (TxId th) = put th
    binDeserial _ = TxId <$> get

-- | Events that the store can generate.
data StoreEvent
    = StoreBestBlock !BlockHash
      -- ^ new best block
    | StoreMempoolNew !TxHash
      -- ^ new mempool transaction
    | StorePeerConnected !Peer !SockAddr
      -- ^ new peer connected
    | StorePeerDisconnected !Peer !SockAddr
      -- ^ peer has disconnected
    | StorePeerPong !Peer !Word64
      -- ^ peer responded 'Ping'
    | StoreTxAvailable !Peer ![TxHash]
      -- ^ peer inv transactions
    | StoreTxReject !Peer !TxHash !RejectCode !ByteString
      -- ^ peer rejected transaction
    | StoreTxDeleted !TxHash
      -- ^ transaction deleted from store
    | StoreBlockReverted !BlockHash
      -- ^ block no longer head of main chain

data PubExcept
    = PubNoPeers
    | PubReject RejectCode
    | PubTimeout
    | PubPeerDisconnected
    deriving Eq

instance Show PubExcept where
    show PubNoPeers = "no peers"
    show (PubReject c) =
        "rejected: " <>
        case c of
            RejectMalformed       -> "malformed"
            RejectInvalid         -> "invalid"
            RejectObsolete        -> "obsolete"
            RejectDuplicate       -> "duplicate"
            RejectNonStandard     -> "not standard"
            RejectDust            -> "dust"
            RejectInsufficientFee -> "insufficient fee"
            RejectCheckpoint      -> "checkpoint"
    show PubTimeout = "peer timeout or silent rejection"
    show PubPeerDisconnected = "peer disconnected"

instance Exception PubExcept

applyOffsetLimit :: Offset -> Maybe Limit -> [a] -> [a]
applyOffsetLimit offset limit = applyLimit limit . applyOffset offset

applyOffset :: Offset -> [a] -> [a]
applyOffset = drop . fromIntegral

applyLimit :: Maybe Limit -> [a] -> [a]
applyLimit Nothing  = id
applyLimit (Just l) = take (fromIntegral l)

applyOffsetLimitC :: Monad m => Offset -> Maybe Limit -> ConduitT i i m ()
applyOffsetLimitC offset limit = applyOffsetC offset >> applyLimitC limit

applyOffsetC :: Monad m => Offset -> ConduitT i i m ()
applyOffsetC = dropC . fromIntegral

applyLimitC :: Monad m => Maybe Limit -> ConduitT i i m ()
applyLimitC Nothing  = mapC id
applyLimitC (Just l) = takeC (fromIntegral l)

sortTxs :: [Tx] -> [(Word32, Tx)]
sortTxs txs = go $ zip [0 ..] txs
  where
    go [] = []
    go ts =
        let (is, ds) =
                partition
                    (all ((`notElem` map (txHash . snd) ts) .
                          outPointHash . prevOutput) .
                     txIn . snd)
                    ts
         in is <> go ds