diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -4,11 +4,22 @@
 The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/)
 and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.html).
 
+## 0.6.0
+### Added
+- Address balance cache in memory.
+
+### Changed
+- Simplify data model further.
+- Fix bug importing outputs with UTXO cache.
+- Unspent balances cannot be negative.
+
 ## 0.5.0
+### Added
+- Add UTXO cache in memory.
+- Get transactions with witness data in segwit networks.
+
 ### Changed
 - Paths for derivations in xpubs is a list and no longer a string.
-- Get transactions with witness data in segwit networks.
-- Add UTXO cache in memory.
 - Various bug fixes.
 
 ## 0.4.2
diff --git a/app/Main.hs b/app/Main.hs
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -356,14 +356,31 @@
             res <-
                 withSnapshot db $ \s -> do
                     let d = (db, defaultReadOptions {useSnapshot = Just s})
-                    getBalance d address
+                    getBalance d address >>= \case
+                        Just b -> return b
+                        Nothing ->
+                            return
+                                Balance
+                                    { balanceAddress = address
+                                    , balanceAmount = 0
+                                    , balanceCount = 0
+                                    , balanceZero = 0
+                                    }
             S.json $ balanceToJSON net res
         S.get "/address/balances" $ do
             addresses <- parse_addresses
             res <-
                 withSnapshot db $ \s -> do
                     let d = (db, defaultReadOptions {useSnapshot = Just s})
-                    mapM (getBalance d) addresses
+                        f a Nothing =
+                            Balance
+                                { balanceAddress = a
+                                , balanceAmount = 0
+                                , balanceCount = 0
+                                , balanceZero = 0
+                                }
+                        f _ (Just b) = b
+                    mapM (\a -> f a <$> getBalance d a) addresses
             S.json $ map (balanceToJSON net) res
         S.get "/xpub/:xpub/balances" $ do
             xpub <- parse_xpub
diff --git a/haskoin-store.cabal b/haskoin-store.cabal
--- a/haskoin-store.cabal
+++ b/haskoin-store.cabal
@@ -2,10 +2,10 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 9f282c83b5c6c54c4781dbfbe252a55fa6ae68ba6164c9f42f954775560e2b20
+-- hash: 922627e06c3369774ef7b05e763944bc0e2305abe21a0ff6628093fcfe5a2ccb
 
 name:           haskoin-store
-version:        0.5.0
+version:        0.6.0
 synopsis:       Storage and index for Bitcoin and Bitcoin Cash
 description:    Store blocks, transactions, and balances for Bitcoin or Bitcoin Cash, and make that information via REST API.
 category:       Bitcoin, Finance, Network
diff --git a/src/Haskoin/Store.hs b/src/Haskoin/Store.hs
--- a/src/Haskoin/Store.hs
+++ b/src/Haskoin/Store.hs
@@ -27,6 +27,11 @@
     , getBlocksAtHeight
     , getBlock
     , getTransaction
+    , getTxData
+    , getSpenders
+    , getSpender
+    , fromTransaction
+    , toTransaction
     , getBalance
     , getMempool
     , getAddressUnspents
@@ -231,20 +236,17 @@
     f p t = XPubTx {xPubTxPath = pathToList p, xPubTx = t}
 
 xpubBals ::
-       (Monad m, StoreStream i m, StoreRead i m) => i -> XPubKey -> m [XPubBal]
+       (Monad m, StoreStream i m, BalanceRead i m)
+    => i
+    -> XPubKey
+    -> m [XPubBal]
 xpubBals i xpub = do
     as <- xpubAddrs i xpub
-    fmap catMaybes $
-        forM as $ \(a, p) ->
-            getBalance i a >>= \b ->
-                return $
-                if balanceCount b == 0
-                    then Nothing
-                    else Just
-                             XPubBal
-                                 { xPubBalPath = pathToList p
-                                 , xPubBal = b
-                                 }
+    fmap catMaybes . forM as $ \(a, p) ->
+        getBalance i a >>= \case
+            Nothing -> return Nothing
+            Just b ->
+                return $ Just XPubBal {xPubBalPath = pathToList p, xPubBal = b}
 
 xpubUnspent ::
        (Monad m, StoreStream i m, StoreRead i m)
diff --git a/src/Network/Haskoin/Store/Block.hs b/src/Network/Haskoin/Store/Block.hs
--- a/src/Network/Haskoin/Store/Block.hs
+++ b/src/Network/Haskoin/Store/Block.hs
@@ -47,10 +47,11 @@
 
 -- | Block store process state.
 data BlockRead = BlockRead
-    { mySelf    :: !BlockStore
-    , myConfig  :: !BlockConfig
-    , myPeer    :: !(TVar (Maybe Syncing))
-    , myUnspent :: !(TVar UnspentMap)
+    { mySelf     :: !BlockStore
+    , myConfig   :: !BlockConfig
+    , myPeer     :: !(TVar (Maybe Syncing))
+    , myUnspent  :: !(TVar UnspentMap)
+    , myBalances :: !(TVar BalanceMap)
     }
 
 -- | Run block store process.
@@ -63,15 +64,23 @@
     $(logInfoS) "Block" "Initializing block store..."
     pb <- newTVarIO Nothing
     um <- newTVarIO M.empty
+    bm <- newTVarIO (M.empty, [])
     runReaderT
         (ini >> run)
-        BlockRead {mySelf = inboxToMailbox inbox, myConfig = cfg, myPeer = pb, myUnspent = um}
+        BlockRead
+            { mySelf = inboxToMailbox inbox
+            , myConfig = cfg
+            , myPeer = pb
+            , myUnspent = um
+            , myBalances = bm
+            }
   where
     ini = do
         db <- blockConfDB <$> asks myConfig
         net <- blockConfNet <$> asks myConfig
         um <- asks myUnspent
-        runExceptT (initDB net db um) >>= \case
+        bm <- asks myBalances
+        runExceptT (initDB net db um bm) >>= \case
             Left e -> do
                 $(logErrorS) "Block" $
                     "Could not initialize block store: " <> fromString (show e)
@@ -94,18 +103,27 @@
        (MonadReader BlockRead m, MonadUnliftIO m, MonadLoggerIO m) => Peer -> m ()
 mempool p = MMempool `sendMessage` p
 
-pruneUnspent :: (MonadReader BlockRead m, MonadUnliftIO m, MonadLoggerIO m) => m ()
-pruneUnspent = do
+pruneCache :: (MonadReader BlockRead m, MonadUnliftIO m, MonadLoggerIO m) => m ()
+pruneCache = do
     um <- asks myUnspent
+    bm <- asks myBalances
     u <- readTVarIO um
+    b <- readTVarIO bm
     $(logDebugS) "Block" $
         "Unspent output cache pre-prune tx count: " <>
         fromString (show (M.size u))
-    atomically $ modifyTVar um pruneUnspentMap
-    v <- readTVarIO um
     $(logDebugS) "Block" $
+        "Address cache pre-prune count: " <> fromString (show (M.size (fst b)))
+    pruneUnspent um
+    pruneBalance bm
+    u' <- readTVarIO um
+    b' <- readTVarIO bm
+    $(logDebugS) "Block" $
         "Unspent output cache post-prune tx count: " <>
-        fromString (show (M.size v))
+        fromString (show (M.size u'))
+    $(logDebugS) "Block" $
+        "Address cache post-prune count: " <>
+        fromString (show (M.size (fst b')))
 
 processBlock ::
        (MonadReader BlockRead m, MonadUnliftIO m, MonadLoggerIO m)
@@ -126,12 +144,13 @@
         upr
         net <- blockConfNet <$> asks myConfig
         um <- asks myUnspent
-        runExceptT (newBlock net db um b n) >>= \case
+        bm <- asks myBalances
+        runExceptT (newBlock net db um bm b n) >>= \case
             Right () -> do
                 l <- blockConfListener <$> asks myConfig
                 atomically $ l (StoreBestBlock (headerHash (blockHeader b)))
                 lift $ isSynced >>= \x -> when x (mempool p)
-                when (nodeHeight n `mod` 1000 == 0) (lift pruneUnspent)
+                when (nodeHeight n `mod` 1000 == 0) (lift pruneCache)
             Left e -> do
                 $(logErrorS) "Block" $
                     "Error importing block " <>
@@ -190,7 +209,8 @@
             net <- blockConfNet <$> asks myConfig
             db <- blockConfDB <$> asks myConfig
             um <- asks myUnspent
-            runExceptT (runImportDB db um $ \i -> newMempoolTx net i tx now) >>= \case
+            bm <- asks myBalances
+            runExceptT (runImportDB db um bm $ \i -> newMempoolTx net i tx now) >>= \case
                 Left e ->
                     $(logErrorS) "Block" $
                     "Error importing tx: " <> txHashToHex (txHash tx) <> ": " <>
@@ -214,7 +234,7 @@
             xs <-
                 fmap catMaybes . forM hs $ \h ->
                     runMaybeT $ do
-                        t <- getTransaction (db, defaultReadOptions) h
+                        t <- getTxData (db, defaultReadOptions) h
                         guard (isNothing t)
                         return (getTxHash h)
             $(logDebugS) "Block" $
@@ -350,7 +370,9 @@
                 resetPeer
                 db <- blockConfDB <$> asks myConfig
                 um <- asks myUnspent
-                runExceptT (runImportDB db um $ \i -> revertBlock i d) >>= \case
+                bm <- asks myBalances
+                net <- blockConfNet <$> asks myConfig
+                runExceptT (runImportDB db um bm $ \i -> revertBlock net i d) >>= \case
                     Left e -> do
                         $(logErrorS) "Block" $
                             "Could not revert best block: " <>
diff --git a/src/Network/Haskoin/Store/Data.hs b/src/Network/Haskoin/Store/Data.hs
--- a/src/Network/Haskoin/Store/Data.hs
+++ b/src/Network/Haskoin/Store/Data.hs
@@ -5,21 +5,24 @@
 module Network.Haskoin.Store.Data where
 
 import           Conduit
-import           Data.Aeson              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           Control.Monad.Trans.Maybe
+import           Data.Aeson                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.Hashable
 import           Data.Int
+import qualified Data.IntMap               as I
+import           Data.IntMap.Strict        (IntMap)
 import           Data.Maybe
-import           Data.Serialize          as S
+import           Data.Serialize            as S
 import           Data.String.Conversions
 import           Data.Time.Clock.System
 import           Data.Word
 import           GHC.Generics
 import           Haskoin
-import           Network.Socket          (SockAddr)
+import           Network.Socket            (SockAddr)
 import           UnliftIO.Exception
 
 type UnixTime = Int64
@@ -27,20 +30,39 @@
 newtype InitException = IncorrectVersion Word32
     deriving (Show, Read, Eq, Ord, Exception)
 
-class UnspentStore u m where
+class Applicative m => UnspentWrite u m where
     addUnspent :: u -> Unspent -> m ()
     delUnspent :: u -> OutPoint -> m ()
+    pruneUnspent :: u -> m ()
+    pruneUnspent _ = pure ()
+
+class UnspentRead u m where
     getUnspent :: u -> OutPoint -> m (Maybe Unspent)
 
+class Applicative m => BalanceWrite b m where
+    setBalance :: b -> Balance -> m ()
+    pruneBalance :: b -> m ()
+    pruneBalance _ = pure ()
+
+class BalanceRead b m where
+    getBalance :: b -> Address -> m (Maybe Balance)
+
 class StoreRead r m where
     isInitialized :: r -> m (Either InitException Bool)
     getBestBlock :: r -> m (Maybe BlockHash)
     getBlocksAtHeight :: r -> BlockHeight -> m [BlockHash]
     getBlock :: r -> BlockHash -> m (Maybe BlockData)
-    getTransaction :: r -> TxHash -> m (Maybe Transaction)
-    getOutput :: r -> OutPoint -> m (Maybe Output)
-    getBalance :: r -> Address -> m Balance
+    getTxData :: r -> TxHash -> m (Maybe TxData)
+    getSpenders :: r -> TxHash -> m (IntMap Spender)
+    getSpender :: r -> OutPoint -> m (Maybe Spender)
 
+getTransaction ::
+       (Monad m, StoreRead r m) => r -> TxHash -> m (Maybe Transaction)
+getTransaction r h = runMaybeT $ do
+    d <- MaybeT $ getTxData r h
+    sm <- lift $ getSpenders r h
+    return $ toTransaction d sm
+
 class StoreStream r m where
     getMempool :: r -> ConduitT () (PreciseUnixTime, TxHash) m ()
     getAddressUnspents :: r -> Address -> ConduitT () Unspent m ()
@@ -51,9 +73,9 @@
     setBest :: w -> BlockHash -> m ()
     insertBlock :: w -> BlockData -> m ()
     insertAtHeight :: w -> BlockHash -> BlockHeight -> m ()
-    insertTx :: w -> Transaction -> m ()
-    insertOutput :: w -> OutPoint -> Output -> m ()
-    setBalance :: w -> Balance -> m ()
+    insertTx :: w -> TxData -> m ()
+    insertSpender :: w -> OutPoint -> Spender -> m ()
+    deleteSpender :: w -> OutPoint -> m ()
     insertAddrTx :: w -> AddressTx -> m ()
     removeAddrTx :: w -> AddressTx -> m ()
     insertAddrUnspent :: w -> Address -> Unspent -> m ()
@@ -129,8 +151,8 @@
       -- ^ address balance
     , balanceAmount  :: !Word64
       -- ^ confirmed balance
-    , balanceZero    :: !Int64
-      -- ^ unconfirmed balance (can be negative)
+    , balanceZero    :: !Word64
+      -- ^ unconfirmed balance
     , balanceCount   :: !Word64
       -- ^ number of unspent outputs
     } deriving (Show, Read, Eq, Ord, Generic, Serialize, Hashable)
@@ -278,6 +300,7 @@
     , "address" .= eitherToMaybe (addrToJSON net <$> scriptToAddressBS ps)
     ] ++
     ["witness" .= fmap (map encodeHex) wit | getSegWit net]
+
 inputPairs net Coinbase { inputPoint = OutPoint oph opi
                         , inputSequence = sq
                         , inputSigScript = ss
@@ -344,6 +367,84 @@
 outputToEncoding :: Network -> Output -> Encoding
 outputToEncoding net = pairs . mconcat . outputPairs net
 
+data Prev = Prev
+    { prevScript :: !ByteString
+    , prevAmount :: !Word64
+    } deriving (Show, Eq, Ord, Generic, Hashable, Serialize)
+
+toInput :: TxIn -> Maybe Prev -> Maybe WitnessStack -> Input
+toInput i Nothing w =
+    Coinbase
+        { inputPoint = prevOutput i
+        , inputSequence = txInSequence i
+        , inputSigScript = scriptInput i
+        , inputWitness = w
+        }
+toInput i (Just p) w =
+    Input
+        { inputPoint = prevOutput i
+        , inputSequence = txInSequence i
+        , inputSigScript = scriptInput i
+        , inputPkScript = prevScript p
+        , inputAmount = prevAmount p
+        , inputWitness = w
+        }
+
+toOutput :: TxOut -> Maybe Spender -> Output
+toOutput o s =
+    Output
+        { outputAmount = outValue o
+        , outputScript = scriptOutput o
+        , outputSpender = s
+        }
+
+data TxData = TxData
+    { txDataBlock   :: !BlockRef
+    , txData        :: !Tx
+    , txDataPrevs   :: !(IntMap Prev)
+    , txDataDeleted :: !Bool
+    , txDataRBF     :: Bool
+    } deriving (Show, Eq, Ord, Generic, Serialize)
+
+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
+        }
+  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
+            }
+    f _ Coinbase {} = Nothing
+    f n Input {inputPkScript = s, inputAmount = v} =
+        Just (n, Prev {prevScript = s, prevAmount = v})
+    ps = I.fromList . catMaybes $ zipWith f [0 ..] (transactionInputs t)
+    g _ Output {outputSpender = Nothing} = Nothing
+    g n Output {outputSpender = Just s}  = Just (n, s)
+    sm = I.fromList . catMaybes $ zipWith g [0 ..] (transactionOutputs t)
+
 -- | Detailed transaction information.
 data Transaction = Transaction
     { transactionBlock    :: !BlockRef
@@ -352,8 +453,6 @@
       -- ^ transaction version
     , transactionLockTime :: !Word32
       -- ^ lock time
-    , transactionFee      :: !Word64
-      -- ^ transaction fees paid to miners in satoshi
     , transactionInputs   :: ![Input]
       -- ^ transaction inputs
     , transactionOutputs  :: ![Output]
@@ -388,9 +487,15 @@
     , "size" .= B.length (S.encode (transactionData dtx))
     , "version" .= transactionVersion dtx
     , "locktime" .= transactionLockTime dtx
-    , "fee" .= transactionFee dtx
-    , "inputs" .= map (object . inputPairs net) (transactionInputs dtx)
-    , "outputs" .= map (object . outputPairs net) (transactionOutputs 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
     ] ++
diff --git a/src/Network/Haskoin/Store/Data/HashMap.hs b/src/Network/Haskoin/Store/Data/HashMap.hs
--- a/src/Network/Haskoin/Store/Data/HashMap.hs
+++ b/src/Network/Haskoin/Store/Data/HashMap.hs
@@ -8,6 +8,7 @@
 import           Conduit
 import           Control.Monad
 import qualified Data.ByteString.Short               as B.Short
+import           Data.Function
 import           Data.HashMap.Strict                 (HashMap)
 import qualified Data.HashMap.Strict                 as M
 import           Data.IntMap.Strict                  (IntMap)
@@ -20,13 +21,14 @@
 import           UnliftIO
 
 type UnspentMap = HashMap TxHash (IntMap Unspent)
+type BalanceMap = (HashMap Address Balance, [Address])
 
 data HashMapDB = HashMapDB
     { hBest :: !(Maybe BlockHash)
     , hBlock :: !(HashMap BlockHash BlockData)
     , hHeight :: !(HashMap BlockHeight [BlockHash])
-    , hTx :: !(HashMap TxHash Transaction)
-    , hOut :: !(HashMap TxHash (IntMap Output))
+    , hTx :: !(HashMap TxHash TxData)
+    , hSpender :: !(HashMap TxHash (IntMap (Maybe Spender)))
     , hUnspent :: !(HashMap TxHash (IntMap (Maybe Unspent)))
     , hBalance :: !(HashMap Address (Maybe BalVal))
     , hAddrTx :: !(HashMap Address (HashMap BlockRef (HashMap TxHash Bool)))
@@ -42,7 +44,7 @@
         , hBlock = M.empty
         , hHeight = M.empty
         , hTx = M.empty
-        , hOut = M.empty
+        , hSpender = M.empty
         , hUnspent = M.empty
         , hBalance = M.empty
         , hAddrTx = M.empty
@@ -64,38 +66,28 @@
 getBlockH :: HashMapDB -> BlockHash -> Maybe BlockData
 getBlockH db h = M.lookup h (hBlock db)
 
-getTransactionH :: HashMapDB -> TxHash -> Maybe Transaction
-getTransactionH db t = do
-    tx <- M.lookup t (hTx db)
-    m <- M.lookup t (hOut db)
-    return tx {transactionOutputs = I.elems m}
+getTxDataH :: HashMapDB -> TxHash -> Maybe TxData
+getTxDataH db t = M.lookup t (hTx db)
 
-getOutputH :: HashMapDB -> OutPoint -> Maybe Output
-getOutputH db op = do
-    m <- M.lookup (outPointHash op) (hOut db)
+getSpenderH :: HashMapDB -> OutPoint -> Maybe (Maybe Spender)
+getSpenderH db op = do
+    m <- M.lookup (outPointHash op) (hSpender db)
     I.lookup (fromIntegral (outPointIndex op)) m
 
-getBalanceH :: HashMapDB -> Address -> Maybe Balance
-getBalanceH db a =
-    case M.lookup a (hBalance db) of
-        Nothing -> Nothing
-        Just Nothing ->
-            Just
-                Balance
-                    { balanceAddress = a
-                    , balanceAmount = 0
-                    , balanceZero = 0
-                    , balanceCount = 0
-                    }
-        Just (Just b) ->
-            Just
-                Balance
-                    { balanceAddress = a
-                    , balanceAmount = balValAmount b
-                    , balanceZero = balValZero b
-                    , balanceCount = balValCount b
-                    }
+getSpendersH :: HashMapDB -> TxHash -> IntMap (Maybe Spender)
+getSpendersH db t = M.lookupDefault I.empty t (hSpender db)
 
+getBalanceH :: HashMapDB -> Address -> Maybe (Maybe Balance)
+getBalanceH db a = fmap f <$> M.lookup a (hBalance db)
+  where
+    f b =
+        Balance
+            { balanceAddress = a
+            , balanceAmount = balValAmount b
+            , balanceZero = balValZero b
+            , balanceCount = balValCount b
+            }
+
 getMempoolH :: HashMapDB -> HashMap PreciseUnixTime (HashMap TxHash Bool)
 getMempoolH = hMempool
 
@@ -141,41 +133,43 @@
   where
     f xs ys = nub $ xs <> ys
 
-insertTxH :: Transaction -> HashMapDB -> HashMapDB
-insertTxH tx db =
+insertTxH :: TxData -> HashMapDB -> HashMapDB
+insertTxH tx db = db {hTx = M.insert (txHash (txData tx)) tx (hTx db)}
+
+insertSpenderH :: OutPoint -> Spender -> HashMapDB -> HashMapDB
+insertSpenderH op s db =
     db
-        { hTx =
-              M.insert
-                  (txHash (transactionData tx))
-                  tx {transactionOutputs = []}
-                  (hTx db)
-        , hOut =
-              M.insert
-                  (txHash (transactionData tx))
-                  (I.fromList (zip [0 ..] (transactionOutputs tx)))
-                  (hOut db)
+        { hSpender =
+              M.insertWith
+                  (<>)
+                  (outPointHash op)
+                  (I.singleton (fromIntegral (outPointIndex op)) (Just s))
+                  (hSpender db)
         }
 
-insertOutputH :: OutPoint -> Output -> HashMapDB -> HashMapDB
-insertOutputH op out db =
+deleteSpenderH :: OutPoint -> HashMapDB -> HashMapDB
+deleteSpenderH op db =
     db
-        { hOut =
+        { hSpender =
               M.insertWith
                   (<>)
                   (outPointHash op)
-                  (I.singleton (fromIntegral (outPointIndex op)) out)
-                  (hOut db)
+                  (I.singleton (fromIntegral (outPointIndex op)) Nothing)
+                  (hSpender db)
         }
 
 setBalanceH :: Balance -> HashMapDB -> HashMapDB
 setBalanceH b db = db {hBalance = M.insert (balanceAddress b) x (hBalance db)}
   where
-    x =
-        case b of
-            Balance {balanceAmount = 0, balanceZero = 0, balanceCount = 0} ->
-                Nothing
-            Balance {balanceAmount = v, balanceZero = z, balanceCount = c} ->
-                Just BalVal {balValAmount = v, balValZero = z, balValCount = c}
+    x
+        | balanceCount b == 0 = Nothing
+        | otherwise =
+            Just
+                BalVal
+                    { balValAmount = balanceAmount b
+                    , balValZero = balanceZero b
+                    , balValCount = balanceCount b
+                    }
 
 insertAddrTxH :: AddressTx -> HashMapDB -> HashMapDB
 insertAddrTxH a db =
@@ -232,23 +226,50 @@
     let s = M.singleton u (M.singleton h False)
      in db {hMempool = M.unionWith M.union s (hMempool db)}
 
+getUnspentH :: HashMapDB -> OutPoint -> Maybe (Maybe Unspent)
+getUnspentH db op = do
+    m <- M.lookup (outPointHash op) (hUnspent db)
+    I.lookup (fromIntegral (outPointIndex op)) m
+
+addUnspentH :: Unspent -> HashMapDB -> HashMapDB
+addUnspentH u db =
+    db
+        { hUnspent =
+              M.insertWith
+                  (<>)
+                  (outPointHash (unspentPoint u))
+                  (I.singleton
+                       (fromIntegral (outPointIndex (unspentPoint u)))
+                       (Just u))
+                  (hUnspent db)
+        }
+
+delUnspentH :: OutPoint -> HashMapDB -> HashMapDB
+delUnspentH op db =
+    db
+        { hUnspent =
+              M.insertWith
+                  (<>)
+                  (outPointHash op)
+                  (I.singleton (fromIntegral (outPointIndex op)) Nothing)
+                  (hUnspent db)
+        }
+
 instance Applicative m => StoreRead HashMapDB m where
     isInitialized = pure . isInitializedH
     getBestBlock = pure . getBestBlockH
     getBlocksAtHeight db = pure . getBlocksAtHeightH db
     getBlock db = pure . getBlockH db
-    getTransaction db = pure . getTransactionH db
-    getOutput db = pure . getOutputH db
-    getBalance db a = pure . fromMaybe b $ getBalanceH db a
-      where
-        b =
-            Balance
-                { balanceAddress = a
-                , balanceAmount = 0
-                , balanceZero = 0
-                , balanceCount = 0
-                }
+    getTxData db = pure . getTxDataH db
+    getSpenders db = pure . I.map fromJust . I.filter isJust . getSpendersH db
+    getSpender db = pure . join . getSpenderH db
 
+instance Applicative m => BalanceRead HashMapDB m where
+    getBalance db = pure . join . getBalanceH db
+
+instance Applicative m => UnspentRead HashMapDB m where
+    getUnspent db = pure . join . getUnspentH db
+
 instance Monad m => StoreStream HashMapDB m where
     getMempool db =
         let ls = M.toList . M.map (M.keys . M.filter id) $ getMempoolH db
@@ -258,15 +279,24 @@
         yieldMany . sort . catMaybes . getAddressUnspentsH db
 
 instance MonadIO m => StoreRead (TVar HashMapDB) m where
-    isInitialized v = atomically $ readTVar v >>= isInitialized
-    getBestBlock v = atomically $ readTVar v >>= getBestBlock
-    getBlocksAtHeight v h =
-        atomically $ readTVar v >>= \db -> getBlocksAtHeight db h
-    getBlock v b = atomically $ readTVar v >>= \db -> getBlock db b
-    getTransaction v t = atomically $ readTVar v >>= \db -> getTransaction db t
-    getOutput v t = atomically $ readTVar v >>= \db -> getOutput db t
-    getBalance v t = atomically $ readTVar v >>= \db -> getBalance db t
+    isInitialized v = readTVarIO v >>= isInitialized
+    getBestBlock v = readTVarIO v >>= getBestBlock
+    getBlocksAtHeight v h = readTVarIO v >>= \db -> getBlocksAtHeight db h
+    getBlock v b = readTVarIO v >>= \db -> getBlock db b
+    getTxData v t = readTVarIO v >>= \db -> getTxData db t
+    getSpender v t = readTVarIO v >>= \db -> getSpender db t
+    getSpenders v t = readTVarIO v >>= \db -> getSpenders db t
 
+instance MonadIO m => BalanceRead (TVar HashMapDB) m where
+    getBalance v a =
+        readTVarIO v >>= \db -> getBalance db a
+
+instance MonadIO m => UnspentRead (TVar HashMapDB) m where
+    getUnspent v op = readTVarIO v >>= \db -> getUnspent db op
+
+instance MonadIO m => BalanceWrite (TVar HashMapDB) m where
+    setBalance v b = atomically $ modifyTVar v (setBalanceH b)
+
 instance MonadIO m => StoreStream (TVar HashMapDB) m where
     getMempool v = readTVarIO v >>= getMempool
     getAddressTxs v a = readTVarIO v >>= \db -> getAddressTxs db a
@@ -278,8 +308,8 @@
     insertBlock f = f . insertBlockH
     insertAtHeight f h = f . insertAtHeightH h
     insertTx f = f . insertTxH
-    insertOutput f p = f . insertOutputH p
-    setBalance f = f . setBalanceH
+    insertSpender f p = f . insertSpenderH p
+    deleteSpender f = f . deleteSpenderH
     insertAddrTx f = f . insertAddrTxH
     removeAddrTx f = f . removeAddrTxH
     insertAddrUnspent f a = f . insertAddrUnspentH a
@@ -287,14 +317,18 @@
     insertMempoolTx f h = f . insertMempoolTxH h
     deleteMempoolTx f h = f . deleteMempoolTxH h
 
+instance Applicative m => UnspentWrite ((HashMapDB -> HashMapDB) -> m ()) m where
+    addUnspent f = f . addUnspentH
+    delUnspent f = f . delUnspentH
+
 instance MonadIO m => StoreWrite (TVar HashMapDB) m where
     setInit v = atomically $ setInit (modifyTVar v)
     setBest v = atomically . setBest (modifyTVar v)
     insertBlock v = atomically . insertBlock (modifyTVar v)
     insertAtHeight v h = atomically . insertAtHeight (modifyTVar v) h
     insertTx v = atomically . insertTx (modifyTVar v)
-    insertOutput v p = atomically . insertOutput (modifyTVar v) p
-    setBalance v = atomically . setBalance (modifyTVar v)
+    insertSpender v p = atomically . insertSpender (modifyTVar v) p
+    deleteSpender v = atomically . deleteSpender (modifyTVar v)
     insertAddrTx v = atomically . insertAddrTx (modifyTVar v)
     removeAddrTx v = atomically . removeAddrTx (modifyTVar v)
     insertAddrUnspent v a = atomically . insertAddrUnspent (modifyTVar v) a
@@ -302,49 +336,78 @@
     insertMempoolTx v h = atomically . insertMempoolTx (modifyTVar v) h
     deleteMempoolTx v h = atomically . deleteMempoolTx (modifyTVar v) h
 
-instance MonadIO m => UnspentStore (TVar HashMapDB) m where
-    addUnspent v u =
-        atomically . modifyTVar v $ \x ->
-            x
-                { hUnspent =
-                      M.insertWith
-                          (<>)
-                          (outPointHash (unspentPoint u))
-                          (I.singleton
-                               (fromIntegral (outPointIndex (unspentPoint u)))
-                               (Just u))
-                          (hUnspent x)
-                }
-    delUnspent v p =
-        atomically . modifyTVar v $ \x ->
-            x
-                { hUnspent =
-                      M.insertWith
-                          (<>)
-                          (outPointHash p)
-                          (I.singleton (fromIntegral (outPointIndex p)) Nothing)
-                          (hUnspent x)
-                }
-    getUnspent v p =
-        (join . I.lookup (fromIntegral (outPointIndex p)) <=<
-         M.lookup (outPointHash p)) .
-        hUnspent <$>
-        readTVarIO v
+instance MonadIO m => UnspentWrite (TVar HashMapDB) m where
+    addUnspent v = atomically . addUnspent (modifyTVar v)
+    delUnspent v = atomically . delUnspent (modifyTVar v)
 
-instance MonadIO m => UnspentStore (TVar UnspentMap) m where
-    addUnspent v u =
-        atomically . modifyTVar v $
+instance Applicative m => UnspentRead UnspentMap m where
+    getUnspent um op = pure $ do
+        m <- M.lookup (outPointHash op) um
+        I.lookup (fromIntegral (outPointIndex op)) m
+
+instance MonadIO m => UnspentRead (TVar UnspentMap) m where
+    getUnspent v op = readTVarIO v >>= \um -> getUnspent um op
+
+instance Applicative m =>
+         UnspentWrite ((UnspentMap -> UnspentMap) -> m ()) m where
+    addUnspent f u =
+        f $
         M.insertWith
             (<>)
             (outPointHash (unspentPoint u))
             (I.singleton (fromIntegral (outPointIndex (unspentPoint u))) u)
-    delUnspent v p = atomically . modifyTVar v $ M.update f (outPointHash p)
+    delUnspent f op = f $ M.update g (outPointHash op)
       where
-        f m =
-            let n = I.delete (fromIntegral (outPointIndex p)) m
+        g m =
+            let n = I.delete (fromIntegral (outPointIndex op)) m
              in if I.null n
                     then Nothing
                     else Just n
-    getUnspent v p =
-        (I.lookup (fromIntegral (outPointIndex p)) <=< M.lookup (outPointHash p)) <$>
-        readTVarIO v
+    pruneUnspent f =
+        f $ \um ->
+            if M.size um > 2000 * 1000
+                then let g is = unspentBlock (head (I.elems is))
+                         ls =
+                             sortBy
+                                 (compare `on` (g . snd))
+                                 (filter (not . I.null . snd) (M.toList um))
+                      in M.fromList (drop (1000 * 1000) ls)
+                else um
+
+instance MonadIO m => UnspentWrite (TVar UnspentMap) m where
+    addUnspent v = atomically . addUnspent (modifyTVar v)
+    delUnspent v = atomically . delUnspent (modifyTVar v)
+    pruneUnspent = atomically . pruneUnspent . modifyTVar
+
+instance Applicative m => BalanceRead BalanceMap m where
+    getBalance m a = pure $ M.lookup a (fst m)
+
+instance Applicative m =>
+         BalanceWrite ((BalanceMap -> BalanceMap) -> m ()) m where
+    setBalance f b =
+        f $ \(m, s) ->
+            if balanceCount b == 0
+                then let m' = M.delete (balanceAddress b) m
+                      in (m', s)
+                else let m' = M.insert (balanceAddress b) b m
+                         s' = balanceAddress b : s
+                      in (m', s')
+    pruneBalance f =
+        f $ \(m, s) ->
+            if length s > 2000 * 1000
+                then let s' = take (1000 * 1000) s
+                         m' = M.fromList (mapMaybe (g m) s')
+                      in (m', s')
+                else (m, s)
+      where
+        g m a =
+            case M.lookup a m of
+                Nothing -> Nothing
+                Just b  -> Just (a, b)
+
+instance MonadIO m => BalanceWrite (TVar BalanceMap) m where
+    setBalance v = atomically . setBalance (modifyTVar v)
+    pruneBalance = atomically . pruneBalance . modifyTVar
+
+instance MonadIO m => BalanceRead (TVar BalanceMap) m where
+    getBalance v a = readTVarIO v >>= \m -> getBalance m a
diff --git a/src/Network/Haskoin/Store/Data/ImportDB.hs b/src/Network/Haskoin/Store/Data/ImportDB.hs
--- a/src/Network/Haskoin/Store/Data/ImportDB.hs
+++ b/src/Network/Haskoin/Store/Data/ImportDB.hs
@@ -25,20 +25,29 @@
 import           UnliftIO
 
 data ImportDB = ImportDB
-    { importRocksDB :: !(DB, ReadOptions)
-    , importHashMap :: !(TVar HashMapDB)
+    { importRocksDB    :: !(DB, ReadOptions)
+    , importHashMap    :: !(TVar HashMapDB)
     , importUnspentMap :: !(TVar UnspentMap)
+    , importBalanceMap :: !(TVar BalanceMap)
     }
 
 runImportDB ::
        (MonadError e m, MonadIO m)
     => DB
     -> TVar UnspentMap
+    -> TVar BalanceMap
     -> (ImportDB -> m a)
     -> m a
-runImportDB db um f = do
+runImportDB db um bm f = do
     hm <- newTVarIO emptyHashMapDB
-    x <- f ImportDB {importRocksDB = d, importHashMap = hm, importUnspentMap = um}
+    x <-
+        f
+            ImportDB
+                { importRocksDB = d
+                , importHashMap = hm
+                , importUnspentMap = um
+                , importBalanceMap = bm
+                }
     ops <- hashMapOps <$> readTVarIO hm
     writeBatch db ops
     return x
@@ -51,7 +60,7 @@
     blockHashOps (hBlock db) <>
     blockHeightOps (hHeight db) <>
     txOps (hTx db) <>
-    outOps (hOut db) <>
+    spenderOps (hSpender db) <>
     balOps (hBalance db) <>
     addrTxOps (hAddrTx db) <>
     addrOutOps (hAddrOut db) <>
@@ -72,22 +81,23 @@
   where
     f (g, ls) = insertOp (HeightKey g) ls
 
-txOps :: HashMap TxHash Transaction -> [BatchOp]
+txOps :: HashMap TxHash TxData -> [BatchOp]
 txOps = map f . M.toList
   where
     f (h, t) = insertOp (TxKey h) t
 
-outOps :: HashMap TxHash (IntMap Output) -> [BatchOp]
-outOps = concatMap (uncurry f) . M.toList
+spenderOps :: HashMap TxHash (IntMap (Maybe Spender)) -> [BatchOp]
+spenderOps = concatMap (uncurry f) . M.toList
   where
     f h = map (uncurry (g h)) . I.toList
-    g h i = insertOp (OutputKey (OutPoint h (fromIntegral i)))
+    g h i (Just s) = insertOp (SpenderKey (OutPoint h (fromIntegral i))) s
+    g h i Nothing  = deleteOp (SpenderKey (OutPoint h (fromIntegral i)))
 
 balOps :: HashMap Address (Maybe BalVal) -> [BatchOp]
 balOps = map (uncurry f) . M.toList
   where
-    f a (Just b) = insertOp (BalKey a) b
     f a Nothing  = deleteOp (BalKey a)
+    f a (Just b) = insertOp (BalKey a) b
 
 addrTxOps ::
        HashMap Address (HashMap BlockRef (HashMap TxHash Bool)) -> [BatchOp]
@@ -170,45 +180,55 @@
 getBlockI ImportDB {importRocksDB = db, importHashMap = hm} bh =
     runMaybeT $ MaybeT (getBlock hm bh) <|> MaybeT (getBlock db bh)
 
-getTransactionI ::
-       MonadIO m => ImportDB -> TxHash -> m (Maybe Transaction)
-getTransactionI ImportDB {importRocksDB = db, importHashMap = hm} th =
-    runMaybeT $ do
-        tx <- MaybeT (getTransaction hm th) <|> MaybeT (getTransaction db th)
-        outs <-
-            forM (take (length (transactionOutputs tx)) [0 ..]) $ \i ->
-                fromMaybe (transactionOutputs tx !! fromIntegral i) <$>
-                getOutput hm (OutPoint th i)
-        return tx {transactionOutputs = outs}
+getTxDataI ::
+       MonadIO m => ImportDB -> TxHash -> m (Maybe TxData)
+getTxDataI ImportDB {importRocksDB = db, importHashMap = hm} th =
+    runMaybeT $ MaybeT (getTxData hm th) <|> MaybeT (getTxData db th)
 
-getOutputI :: MonadIO m => ImportDB -> OutPoint -> m (Maybe Output)
-getOutputI ImportDB {importRocksDB = db, importHashMap = hm} op =
-    runMaybeT $ MaybeT (getOutput hm op) <|> MaybeT (getOutput db op)
+getSpenderI :: MonadIO m => ImportDB -> OutPoint -> m (Maybe Spender)
+getSpenderI ImportDB {importRocksDB = db, importHashMap = hm} op =
+    getSpenderH <$> readTVarIO hm <*> pure op >>= \case
+        Just s -> return s
+        Nothing -> getSpender db op
 
-getBalanceI :: MonadIO m => ImportDB -> Address -> m Balance
-getBalanceI ImportDB {importRocksDB = db, importHashMap = hm} a =
-    getBalanceH <$> readTVarIO hm <*> pure a >>= \case
-        Just b -> return b
-        Nothing -> getBalance db a
+getSpendersI :: MonadIO m => ImportDB -> TxHash -> m (IntMap Spender)
+getSpendersI ImportDB {importRocksDB = db, importHashMap = hm} t = do
+    hsm <- getSpendersH <$> readTVarIO hm <*> pure t
+    dsm <- I.map Just <$> getSpenders db t
+    return . I.map fromJust . I.filter isJust $ hsm <> dsm
 
+getBalanceI :: MonadIO m => ImportDB -> Address -> m (Maybe Balance)
+getBalanceI ImportDB { importRocksDB = db
+                     , importHashMap = hm
+                     , importBalanceMap = bm
+                     } a =
+    getBalance bm a >>= \case
+        Just b -> return (Just b)
+        Nothing ->
+            getBalanceH <$> readTVarIO hm <*> pure a >>= \case
+                Just x -> return x
+                Nothing -> getBalance db a
+
 getUnspentI :: MonadIO m => ImportDB -> OutPoint -> m (Maybe Unspent)
-getUnspentI ImportDB { importRocksDB = (db, opts)
+getUnspentI ImportDB { importRocksDB = db
                      , importHashMap = hm
                      , importUnspentMap = um
-                     } p =
-    runMaybeT $
-    MaybeT (getUnspent hm p) <|>
-    MaybeT (getUnspent um p) <|>
-    MaybeT (getUnspentDB db opts p)
+                     } op =
+    getUnspent um op >>= \case
+        Just b -> return (Just b)
+        Nothing ->
+            getUnspentH <$> readTVarIO hm <*> pure op >>= \case
+                Just x -> return x
+                Nothing -> getUnspent db op
 
 instance MonadIO m => StoreRead ImportDB m where
     isInitialized = isInitializedI
     getBestBlock = getBestBlockI
     getBlocksAtHeight = getBlocksAtHeightI
     getBlock = getBlockI
-    getTransaction = getTransactionI
-    getOutput = getOutputI
-    getBalance = getBalanceI
+    getTxData = getTxDataI
+    getSpender = getSpenderI
+    getSpenders = getSpendersI
 
 instance MonadIO m => StoreWrite ImportDB m where
     setInit ImportDB {importHashMap = hm, importRocksDB = (db, _)} =
@@ -217,8 +237,8 @@
     insertBlock ImportDB {importHashMap = hm} = insertBlock hm
     insertAtHeight ImportDB {importHashMap = hm} = insertAtHeight hm
     insertTx ImportDB {importHashMap = hm} = insertTx hm
-    insertOutput ImportDB {importHashMap = hm} = insertOutput hm
-    setBalance ImportDB {importHashMap = hm} = setBalance hm
+    insertSpender ImportDB {importHashMap = hm} = insertSpender hm
+    deleteSpender ImportDB {importHashMap = hm} = deleteSpender hm
     insertAddrTx ImportDB {importHashMap = hm} = insertAddrTx hm
     removeAddrTx ImportDB {importHashMap = hm} = removeAddrTx hm
     insertAddrUnspent ImportDB {importHashMap = hm} = insertAddrUnspent hm
@@ -226,8 +246,18 @@
     insertMempoolTx ImportDB {importHashMap = hm} = insertMempoolTx hm
     deleteMempoolTx ImportDB {importHashMap = hm} = deleteMempoolTx hm
 
-instance MonadIO m => UnspentStore ImportDB m where
+instance MonadIO m => UnspentRead ImportDB m where
+    getUnspent = getUnspentI
+
+instance MonadIO m => UnspentWrite ImportDB m where
     addUnspent ImportDB {importHashMap = hm, importUnspentMap = um} u =
         addUnspent hm u >> addUnspent um u
-    delUnspent ImportDB {importHashMap = hm} = delUnspent hm
-    getUnspent = getUnspentI
+    delUnspent ImportDB {importHashMap = hm, importUnspentMap = um} op =
+        delUnspent um op >> delUnspent hm op
+
+instance MonadIO m => BalanceRead ImportDB m where
+    getBalance = getBalanceI
+
+instance MonadIO m => BalanceWrite ImportDB m where
+    setBalance ImportDB {importHashMap = hm, importBalanceMap = bm} b =
+        setBalance hm b >> setBalance bm b
diff --git a/src/Network/Haskoin/Store/Data/KeyValue.hs b/src/Network/Haskoin/Store/Data/KeyValue.hs
--- a/src/Network/Haskoin/Store/Data/KeyValue.hs
+++ b/src/Network/Haskoin/Store/Data/KeyValue.hs
@@ -11,7 +11,6 @@
 import qualified Data.ByteString            as B
 import           Data.Default
 import           Data.Hashable
-import           Data.Int
 import           Data.Serialize             as S
 import           Data.Word
 import           Database.RocksDB.Query
@@ -111,30 +110,30 @@
 
 instance Key TxKey
 
-instance KeyValue TxKey Transaction
+instance KeyValue TxKey TxData
 
-data OutputKey
-    = OutputKey { outputPoint :: !OutPoint }
-    | OutputKeyS { outputKeyS :: !TxHash }
+data SpenderKey
+    = SpenderKey { outputPoint :: !OutPoint }
+    | SpenderKeyS { outputKeyS :: !TxHash }
     deriving (Show, Read, Eq, Ord, Generic, Hashable)
 
-instance Serialize OutputKey where
+instance Serialize SpenderKey where
     -- 0x10 · TxHash · Index
-    put (OutputKey OutPoint {outPointHash = h, outPointIndex = i}) = do
+    put (SpenderKey OutPoint {outPointHash = h, outPointIndex = i}) = do
         putWord8 0x10
         put h
         put i
-    put (OutputKeyS h) = do
+    put (SpenderKeyS h) = do
         putWord8 0x10
         put h
     get = do
         guard . (== 0x10) =<< getWord8
         op <- OutPoint <$> get <*> get
-        return $ OutputKey op
+        return $ SpenderKey op
 
-instance Key OutputKey
+instance Key SpenderKey
 
-instance KeyValue OutputKey Output
+instance KeyValue SpenderKey Spender
 
 -- | Unspent output database key.
 data UnspentKey
@@ -241,8 +240,8 @@
 data BalVal = BalVal
     { balValAmount :: !Word64
       -- ^ balance in satoshi
-    , balValZero   :: !Int64
-      -- ^ unconfirmed balance in satoshi (can be negative)
+    , balValZero   :: !Word64
+      -- ^ unconfirmed balance in satoshi
     , balValCount  :: !Word64
       -- ^ number of unspent outputs
     } deriving (Show, Read, Eq, Ord, Generic, Hashable, Serialize)
diff --git a/src/Network/Haskoin/Store/Data/RocksDB.hs b/src/Network/Haskoin/Store/Data/RocksDB.hs
--- a/src/Network/Haskoin/Store/Data/RocksDB.hs
+++ b/src/Network/Haskoin/Store/Data/RocksDB.hs
@@ -7,9 +7,9 @@
 module Network.Haskoin.Store.Data.RocksDB where
 
 import           Conduit
-import           Control.Monad.Trans.Maybe
 import qualified Data.ByteString.Short               as B.Short
-import           Data.Maybe
+import           Data.IntMap                         (IntMap)
+import qualified Data.IntMap.Strict                  as I
 import           Data.Word
 import           Database.RocksDB                    (DB, ReadOptions)
 import           Database.RocksDB.Query
@@ -19,7 +19,7 @@
 import           UnliftIO
 
 dataVersion :: Word32
-dataVersion = 6
+dataVersion = 8
 
 data ExceptRocksDB =
     MempoolTxNotFound
@@ -46,19 +46,20 @@
 getBlockDB :: MonadIO m => DB -> ReadOptions -> BlockHash -> m (Maybe BlockData)
 getBlockDB db opts h = retrieve db opts (BlockKey h)
 
-getTransactionDB ::
-       MonadIO m => DB -> ReadOptions -> TxHash -> m (Maybe Transaction)
-getTransactionDB db opts th = runMaybeT $ do
-    tx <- MaybeT $ retrieve db opts (TxKey th)
-    outs <- lift $ getOutputsDB db opts th
-    return tx {transactionOutputs = outs}
+getTxDataDB ::
+       MonadIO m => DB -> ReadOptions -> TxHash -> m (Maybe TxData)
+getTxDataDB db opts th = retrieve db opts (TxKey th)
 
-getOutputDB :: MonadIO m => DB -> ReadOptions -> OutPoint -> m (Maybe Output)
-getOutputDB db opts = retrieve db opts . OutputKey
+getSpenderDB :: MonadIO m => DB -> ReadOptions -> OutPoint -> m (Maybe Spender)
+getSpenderDB db opts = retrieve db opts . SpenderKey
 
-getOutputsDB :: MonadIO m => DB -> ReadOptions -> TxHash -> m [Output]
-getOutputsDB db opts th =
-    map snd <$> liftIO (matchingAsList db opts (OutputKeyS th))
+getSpendersDB :: MonadIO m => DB -> ReadOptions -> TxHash -> m (IntMap Spender)
+getSpendersDB db opts th =
+    I.fromList . map (uncurry f) <$>
+    liftIO (matchingAsList db opts (SpenderKeyS th))
+  where
+    f (SpenderKey op) s = (fromIntegral (outPointIndex op), s)
+    f _ _ = undefined
 
 getBalanceDB :: MonadIO m => DB -> ReadOptions -> Address -> m (Maybe Balance)
 getBalanceDB db opts a = fmap f <$> retrieve db opts (BalKey a)
@@ -132,22 +133,20 @@
     getBestBlock (db, opts) = getBestBlockDB db opts
     getBlocksAtHeight (db, opts) = getBlocksAtHeightDB db opts
     getBlock (db, opts) = getBlockDB db opts
-    getTransaction (db, opts) = getTransactionDB db opts
-    getOutput (db, opts) = getOutputDB db opts
-    getBalance (db, opts) a = fromMaybe b <$> getBalanceDB db opts a
-      where
-        b =
-            Balance
-                { balanceAddress = a
-                , balanceAmount = 0
-                , balanceZero = 0
-                , balanceCount = 0
-                }
+    getTxData (db, opts) = getTxDataDB db opts
+    getSpenders (db, opts) = getSpendersDB db opts
+    getSpender (db, opts) = getSpenderDB db opts
 
 instance (MonadIO m, MonadResource m) => StoreStream (DB, ReadOptions) m where
     getMempool (db, opts) = getMempoolDB db opts
     getAddressTxs (db, opts) = getAddressTxsDB db opts
     getAddressUnspents (db, opts) = getAddressUnspentsDB db opts
+
+instance MonadIO m => BalanceRead (DB, ReadOptions) m where
+    getBalance (db, opts) = getBalanceDB db opts
+
+instance MonadIO m => UnspentRead (DB, ReadOptions) m where
+    getUnspent (db, opts) = getUnspentDB db opts
 
 setInitDB :: MonadIO m => DB -> m ()
 setInitDB db = insert db VersionKey dataVersion
diff --git a/src/Network/Haskoin/Store/Logic.hs b/src/Network/Haskoin/Store/Logic.hs
--- a/src/Network/Haskoin/Store/Logic.hs
+++ b/src/Network/Haskoin/Store/Logic.hs
@@ -1,19 +1,21 @@
-{-# LANGUAGE DeriveAnyClass   #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE LambdaCase       #-}
+{-# LANGUAGE DeriveAnyClass    #-}
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE LambdaCase        #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell   #-}
 module Network.Haskoin.Store.Logic where
 
 import           Conduit
 import           Control.Monad
 import           Control.Monad.Except
+import           Control.Monad.Logger
 import qualified Data.ByteString                     as B
 import qualified Data.ByteString.Short               as B.Short
-import           Data.Function
-import qualified Data.HashMap.Strict                 as M
 import qualified Data.IntMap.Strict                  as I
 import           Data.List
 import           Data.Maybe
 import           Data.Serialize
+import           Data.String
 import           Data.Word
 import           Database.RocksDB
 import           Haskoin
@@ -33,9 +35,12 @@
     | NoUnspent !OutPoint
     | TxDeleted !TxHash
     | TxDoubleSpend !TxHash
+    | AlreadyUnspent !OutPoint
     | TxConfirmed !TxHash
     | OutputOutOfRange !OutPoint
+    | BalanceNotFound !Address
     | InsufficientBalance !Address
+    | InsufficientZeroBalance !Address
     | InsufficientOutputs !Address
     | InsufficientFunds !TxHash
     | InitException !InitException
@@ -43,17 +48,26 @@
     deriving (Show, Read, Eq, Ord, Exception)
 
 initDB ::
-       (MonadIO m, MonadError ImportException m)
+       (MonadIO m, MonadError ImportException m, MonadLoggerIO m)
     => Network
     -> DB
     -> TVar UnspentMap
+    -> TVar BalanceMap
     -> m ()
-initDB net db um =
-    runImportDB db um $ \i ->
+initDB net db um bm =
+    runImportDB db um bm $ \i ->
         isInitialized i >>= \case
-            Left e -> throwError (InitException e)
-            Right True -> return ()
+            Left e -> do
+                $(logErrorS) "BlockLogic" $
+                    "Initialization exception: " <> fromString (show e)
+                throwError (InitException e)
+            Right True -> do
+                $(logDebugS) "BlockLogic" "Database is already initialized"
+                return ()
             Right False -> do
+                $(logDebugS)
+                    "BlockLogic"
+                    "Initializing database by importing genesis block"
                 importBlock net i (genesisBlock net) (genesisNode net)
                 setInit i
 
@@ -61,22 +75,35 @@
        ( MonadError ImportException m
        , StoreRead i m
        , StoreWrite i m
-       , UnspentStore i m
+       , UnspentRead i m
+       , UnspentWrite i m
+       , BalanceRead i m
+       , BalanceWrite i m
+       , MonadLogger m
        )
     => Network
     -> i
     -> Tx
     -> PreciseUnixTime
     -> m ()
-newMempoolTx net i tx now =
-    getTransaction i (txHash tx) >>= \case
-        Just x | not (transactionDeleted x) -> return ()
+newMempoolTx net i tx now = do
+    $(logInfoS) "BlockLogic" $
+        "Adding transaction to mempool: " <> txHashToHex (txHash tx)
+    getTxData i (txHash tx) >>= \case
+        Just x
+            | not (txDataDeleted x) -> do
+                $(logWarnS) "BlockLogic" $
+                    "Transaction already exists: " <> txHashToHex (txHash tx)
+                return ()
         _ -> go
   where
     go = do
         orp <-
             any isNothing <$>
-            mapM (getTransaction i . outPointHash . prevOutput) (txIn tx)
+            mapM (getTxData i . outPointHash . prevOutput) (txIn tx)
+        when orp $
+            $(logErrorS) "BlockLogic" $
+            "Transaction is orphan: " <> txHashToHex (txHash tx)
         unless orp f
     f = do
         us <-
@@ -85,9 +112,11 @@
                 getTxOutput (outPointIndex op) t
         let ds = map spenderHash (mapMaybe outputSpender us)
         if null ds
-            then importTx i (MemRef now) tx
+            then importTx net i (MemRef now) tx
             else g ds
     g ds = do
+        $(logWarnS) "BlockLogic" $
+            "Transaction inputs already spent: " <> txHashToHex (txHash tx)
         rbf <-
             if getReplaceByFee net
                 then and <$> mapM isrbf ds
@@ -96,46 +125,74 @@
             then r ds
             else n
     r ds = do
-        forM_ ds (deleteTx i False)
-        importTx i (MemRef now) tx
-    n = insertDeletedMempoolTx i tx now
+        $(logWarnS) "BlockLogic" $
+            "Replacting RBF transaction with: " <> txHashToHex (txHash tx)
+        forM_ ds (deleteTx net i True)
+        importTx net i (MemRef now) tx
+    n = do
+        $(logWarnS) "BlockLogic" $
+            "Inserting transaction with deleted flag: " <>
+            txHashToHex (txHash tx)
+        insertDeletedMempoolTx i tx now
     isrbf th = transactionRBF <$> getImportTx i th
 
 newBlock ::
-       (MonadError ImportException m, MonadIO m)
+       (MonadError ImportException m, MonadIO m, MonadLogger m)
     => Network
     -> DB
     -> TVar UnspentMap
+    -> TVar BalanceMap
     -> Block
     -> BlockNode
     -> m ()
-newBlock net db um b n = runImportDB db um $ \i -> importBlock net i b n
+newBlock net db um bm b n = runImportDB db um bm $ \i -> importBlock net i b n
 
 revertBlock ::
        ( MonadError ImportException m
        , StoreRead i m
        , StoreWrite i m
-       , UnspentStore i m
+       , UnspentRead i m
+       , UnspentWrite i m
+       , BalanceRead i m
+       , BalanceWrite i m
+       , MonadLogger m
        )
-    => i
+    => Network
+    -> i
     -> BlockHash
     -> m ()
-revertBlock i bh = do
+revertBlock net i bh = do
     bd <-
         getBestBlock i >>= \case
-            Nothing -> throwError BestBlockUnknown
+            Nothing -> do
+                $(logErrorS) "BlockLogic" "Best block unknown"
+                throwError BestBlockUnknown
             Just h ->
                 getBlock i h >>= \case
-                    Nothing -> throwError (BestBlockNotFound h)
+                    Nothing -> do
+                        $(logErrorS) "BlockLogic" "Best block not found"
+                        throwError (BestBlockNotFound h)
                     Just b
                         | h == bh -> return b
-                        | otherwise -> throwError (BlockNotBest bh)
-    forM_ (blockDataTxs bd) $ deleteTx i False
+                        | otherwise -> do
+                            $(logErrorS) "BlockLogic" $
+                                "Attempted to delete block that isn't best: " <>
+                                blockHashToHex h
+                            throwError (BlockNotBest bh)
+    mapM_ (deleteTx net i False) (reverse (blockDataTxs bd))
     setBest i (prevBlock (blockDataHeader bd))
     insertBlock i bd {blockDataMainChain = False}
 
 importBlock ::
-       (MonadError ImportException m, StoreRead i m, StoreWrite i m, UnspentStore i m)
+       ( MonadError ImportException m
+       , StoreRead i m
+       , StoreWrite i m
+       , UnspentRead i m
+       , UnspentWrite i m
+       , BalanceRead i m
+       , BalanceWrite i m
+       , MonadLogger m
+       )
     => Network
     -> i
     -> Block
@@ -144,11 +201,23 @@
 importBlock net i b n = do
     getBestBlock i >>= \case
         Nothing
-            | isGenesis n -> return ()
-            | otherwise -> throwError BestBlockUnknown
+            | isGenesis n -> do
+                $(logInfoS) "BlockLogic" $
+                    "Importing genesis block: " <>
+                    blockHashToHex (headerHash (nodeHeader n))
+                return ()
+            | otherwise -> do
+                $(logErrorS) "BlockLogic" $
+                    "Importing non-genesis block when best block unknown: " <>
+                    blockHashToHex (headerHash (blockHeader b))
+                throwError BestBlockUnknown
         Just h
             | prevBlock (blockHeader b) == h -> return ()
-            | otherwise ->
+            | otherwise -> do
+                $(logErrorS) "BlockLogic" $
+                    "Block " <> blockHashToHex (headerHash (blockHeader b)) <>
+                    " does not build on current best " <>
+                    blockHashToHex h
                 throwError (PrevBlockNotBest (prevBlock (nodeHeader n)))
     insertBlock
         i
@@ -163,15 +232,19 @@
     insertAtHeight i (headerHash (nodeHeader n)) (nodeHeight n)
     setBest i (headerHash (nodeHeader n))
     txs <- concat <$> mapM (getRecursiveTx i . txHash) (tail (blockTxns b))
-    mapM_ (deleteTx i False . txHash . transactionData) (reverse txs)
-    zipWithM_ (\x t -> importTx i (br x) t) [0 ..] (blockTxns b)
+    mapM_ (deleteTx net i False . txHash . transactionData) (reverse txs)
+    zipWithM_ (\x t -> importTx net i (br x) t) [0 ..] (blockTxns b)
     forM_ txs $ \tr -> do
         let tx = transactionData tr
             th = txHash tx
         when (th `notElem` hs) $
             case transactionBlock tr of
                 MemRef t -> newMempoolTx net i tx t
-                BlockRef {} -> throwError (TxConfirmed (txHash tx))
+                BlockRef {} -> do
+                    $(logErrorS) "BlockLogic" $
+                        "Expected mempool transaction but found confirmed: " <>
+                        txHashToHex (txHash tx)
+                    throwError (TxConfirmed (txHash tx))
   where
     hs = map txHash (blockTxns b)
     br pos = BlockRef {blockRefHeight = nodeHeight n, blockRefPos = pos}
@@ -180,70 +253,95 @@
        ( MonadError ImportException m
        , StoreRead i m
        , StoreWrite i m
-       , UnspentStore i m
+       , UnspentRead i m
+       , UnspentWrite i m
+       , BalanceRead i m
+       , BalanceWrite i m
+       , MonadLogger m
        )
-    => i
+    => Network
+    -> i
     -> BlockRef
     -> Tx
     -> m ()
-importTx i br tx = do
-    when (length (nub (map prevOutput (txIn tx))) < length (txIn tx)) $
+importTx net i br tx = do
+    when (length (nub (map prevOutput (txIn tx))) < length (txIn tx)) $ do
+        $(logErrorS) "BlockLogic" $
+            "Transaction spends same output twice: " <> txHashToHex (txHash tx)
         throwError (DuplicatePrevOutput (txHash tx))
     us <-
         if iscb
             then return []
-            else forM (txIn tx) $ \TxIn {prevOutput = op} ->
-                     getUnspent i op >>= \case
-                         Nothing
-                             | confirmed br ->
-                                 getOutput i op >>= \case
-                                     Nothing ->
-                                         throwError (OrphanTx (txHash tx))
-                                     Just Output {outputSpender = Just s} -> do
-                                         deleteTx i False (spenderHash s)
-                                         getUnspent i op >>= \case
-                                             Nothing ->
-                                                 throwError
-                                                     (TxDoubleSpend (txHash tx))
-                                             Just u -> return u
-                                     Just Output {outputSpender = Nothing} ->
-                                         throwError (TxDoubleSpend (txHash tx))
-                             | otherwise -> throwError (NoUnspent op)
-                         Just u -> return u
-    when (iscb && not (confirmed br)) $
+            else forM (txIn tx) $ \TxIn {prevOutput = op} -> uns op
+    when (iscb && not (confirmed br)) $ do
+        $(logErrorS) "BlockLogic" $
+            "Attempting to import coinbase to the mempool: " <>
+            txHashToHex (txHash tx)
         throwError (UnconfirmedCoinbase (txHash tx))
     unless iscb $ do
-        when (sum (map unspentAmount us) < sum (map outValue (txOut tx))) $
+        when (sum (map unspentAmount us) < sum (map outValue (txOut tx))) $ do
+            $(logErrorS) "BlockLogic" $
+                "Insufficient funds: " <> txHashToHex (txHash tx)
             throwError (InsufficientFunds th)
-        zipWithM_
-            (spendOutput i br (txHash tx))
-            [0 ..]
-            us
-    zipWithM_ (newOutput i br (txHash tx)) [0 ..] (txOut tx)
+        zipWithM_ (spendOutput net i br (txHash tx)) [0 ..] us
+    zipWithM_ (newOutput net i br . OutPoint (txHash tx)) [0 ..] (txOut tx)
     rbf <- getrbf
-    insertTx
-        i
-        Transaction
-            { transactionBlock = br
-            , transactionVersion = txVersion tx
-            , transactionLockTime = txLockTime tx
-            , transactionFee = fee us
-            , transactionInputs =
-                  if iscb
-                      then zipWith mkcb (txIn tx) ws
-                      else zipWith3 mkin us (txIn tx) ws
-            , transactionOutputs = map mkout (txOut tx)
-            , transactionDeleted = False
-            , transactionRBF = rbf
-            }
-    unless (confirmed br) $ insertMempoolTx i (txHash tx) (memRefTime br)
+    let (d, _) =
+            fromTransaction
+                Transaction
+                    { transactionBlock = br
+                    , transactionVersion = txVersion tx
+                    , transactionLockTime = txLockTime tx
+                    , transactionInputs =
+                          if iscb
+                              then zipWith mkcb (txIn tx) ws
+                              else zipWith3 mkin us (txIn tx) ws
+                    , transactionOutputs = map mkout (txOut tx)
+                    , transactionDeleted = False
+                    , transactionRBF = rbf
+                    }
+    insertTx i d
+    unless (confirmed br) $
+        insertMempoolTx i (txHash tx) (memRefTime br)
   where
+    uns op =
+        getUnspent i op >>= \case
+            Nothing
+                | confirmed br -> do
+                    $(logWarnS) "BlockLogic" $
+                        "Could not find unspent output: " <>
+                        txHashToHex (outPointHash op) <>
+                        " " <>
+                        fromString (show (outPointIndex op))
+                    getSpender i op >>= \case
+                        Nothing -> do
+                            $(logErrorS) "BlockLogic" $
+                                "Could not find output: " <>
+                                txHashToHex (outPointHash op) <>
+                                " " <>
+                                fromString (show (outPointIndex op))
+                            throwError (OrphanTx (txHash tx))
+                        Just s -> do
+                            $(logWarnS) "BlockLogic" $
+                                "Deleting conflicting transaction: " <>
+                                txHashToHex (spenderHash s)
+                            deleteTx net i True (spenderHash s)
+                            getUnspent i op >>= \case
+                                Nothing -> do
+                                    $(logErrorS) "BlockLogic" $
+                                        "Transaction double-spend detected: " <>
+                                        txHashToHex (txHash tx)
+                                    throwError (TxDoubleSpend (txHash tx))
+                                Just u -> return u
+                | otherwise -> do
+                    $(logErrorS) "BlockLogic" $
+                        "No unspent output: " <> txHashToHex (outPointHash op) <>
+                        " " <>
+                        fromString (show (outPointIndex op))
+                    throwError (NoUnspent op)
+            Just u -> return u
     th = txHash tx
     iscb = all (== nullOutPoint) (map prevOutput (txIn tx))
-    fee us =
-        if iscb
-            then 0
-            else sum (map unspentAmount us) - sum (map outValue (txOut tx))
     ws = map Just (txWitness tx) <> repeat Nothing
     getrbf
         | iscb = return False
@@ -252,11 +350,11 @@
         | otherwise =
             let hs = nub $ map (outPointHash . prevOutput) (txIn tx)
              in fmap or . forM hs $ \h ->
-                    getTransaction i h >>= \case
+                    getTxData i h >>= \case
                         Nothing -> throwError (TxNotFound h)
                         Just t
-                            | confirmed (transactionBlock t) -> return False
-                            | transactionRBF t -> return True
+                            | confirmed (txDataBlock t) -> return False
+                            | txDataRBF t -> return True
                             | otherwise -> return False
     mkcb ip w =
         Coinbase
@@ -281,51 +379,68 @@
             , outputSpender = Nothing
             }
 
-getRecursiveTx :: (Monad m, StoreRead i m) => i -> TxHash -> m [Transaction]
+getRecursiveTx ::
+       (Monad m, StoreRead i m, MonadLogger m) => i -> TxHash -> m [Transaction]
 getRecursiveTx i th =
-    getTransaction i th >>= \case
+    getTxData i th >>= \case
         Nothing -> return []
-        Just t ->
+        Just d -> do
+            sm <- getSpenders i th
+            let t = toTransaction d sm
             fmap (t :) $ do
-                let ss =
-                        nub
-                            (map spenderHash
-                                 (mapMaybe outputSpender (transactionOutputs t)))
+                let ss = nub . map spenderHash $ I.elems sm
                 concat <$> mapM (getRecursiveTx i) ss
 
 deleteTx ::
        ( MonadError ImportException m
        , StoreRead i m
        , StoreWrite i m
-       , UnspentStore i m
+       , UnspentRead i m
+       , UnspentWrite i m
+       , BalanceRead i m
+       , BalanceWrite i m
+       , MonadLogger m
        )
-    => i
+    => Network
+    -> i
     -> Bool -- ^ only delete transaction if unconfirmed
     -> TxHash
     -> m ()
-deleteTx i mo h =
-    getTransaction i h >>= \case
-        Nothing -> throwError (TxNotFound h)
+deleteTx net i mo h = do
+    $(logDebugS) "BlockLogic" $ "Deleting transaction: " <> txHashToHex h
+    getTxData i h >>= \case
+        Nothing -> do
+            $(logErrorS) "BlockLogic" $
+                "Transaciton not found: " <> txHashToHex h
+            throwError (TxNotFound h)
         Just t
-            | not (transactionDeleted t) ->
-                if mo && confirmed (transactionBlock t)
-                    then throwError (TxConfirmed h)
-                    else go t
-            | otherwise -> return ()
+            | txDataDeleted t -> do
+                $(logErrorS) "BlockLogic" $
+                    "Transaction already deleted: " <> txHashToHex h
+                return ()
+            | mo && confirmed (txDataBlock t) -> do
+                $(logErrorS) "BlockLogic" $
+                    "Will not delete confirmed transaction: " <> txHashToHex h
+                throwError (TxConfirmed h)
+            | otherwise -> go t
   where
     go t = do
-        forM_ (mapMaybe outputSpender (transactionOutputs t)) $ \s ->
-            deleteTx i False (spenderHash s)
-        forM_ (take (length (transactionOutputs t)) [0 ..]) $ \n ->
-            delOutput i (OutPoint h n)
-        let ps = filter (/= nullOutPoint) (map inputPoint (transactionInputs t))
-        forM_ ps $ \op -> unspendOutput i op (transactionBlock t)
-        unless (confirmed (transactionBlock t)) $
-            deleteMempoolTx i h (memRefTime (transactionBlock t))
-        insertTx i t {transactionDeleted = True}
+        ss <- nub . map spenderHash . I.elems <$> getSpenders i h
+        mapM_ (deleteTx net i True) ss
+        let ps = filter (/= nullOutPoint) (map prevOutput (txIn (txData t)))
+        mapM_ (unspendOutput net i) ps
+        forM_ (take (length (txOut (txData t))) [0 ..]) $ \n ->
+            delOutput net i (OutPoint h n)
+        unless (confirmed (txDataBlock t)) $
+            deleteMempoolTx i h (memRefTime (txDataBlock t))
+        insertTx i t {txDataDeleted = True}
 
 insertDeletedMempoolTx ::
-       (MonadError ImportException m, StoreRead i m, StoreWrite i m)
+       ( MonadError ImportException m
+       , StoreRead i m
+       , StoreWrite i m
+       , MonadLogger m
+       )
     => i
     -> Tx
     -> PreciseUnixTime
@@ -335,18 +450,20 @@
         forM (txIn tx) $ \TxIn {prevOutput = op} ->
             getImportTx i (outPointHash op) >>= getTxOutput (outPointIndex op)
     rbf <- getrbf
-    insertTx
-        i
-        Transaction
-            { transactionBlock = MemRef now
-            , transactionVersion = txVersion tx
-            , transactionLockTime = txLockTime tx
-            , transactionFee = fee us
-            , transactionInputs = zipWith3 mkin us (txIn tx) ws
-            , transactionOutputs = map mkout (txOut tx)
-            , transactionDeleted = True
-            , transactionRBF = rbf
-            }
+    let (d, _) =
+            fromTransaction
+                Transaction
+                    { transactionBlock = MemRef now
+                    , transactionVersion = txVersion tx
+                    , transactionLockTime = txLockTime tx
+                    , transactionInputs = zipWith3 mkin us (txIn tx) ws
+                    , transactionOutputs = map mkout (txOut tx)
+                    , transactionDeleted = True
+                    , transactionRBF = rbf
+                    }
+    $(logWarnS) "BlockLogic" $
+        "Inserting deleted mempool transaction: " <> txHashToHex (txHash tx)
+    insertTx i d
   where
     ws = map Just (txWitness tx) <> repeat Nothing
     getrbf
@@ -354,13 +471,15 @@
         | otherwise =
             let hs = nub $ map (outPointHash . prevOutput) (txIn tx)
              in fmap or . forM hs $ \h ->
-                    getTransaction i h >>= \case
-                        Nothing -> throwError (TxNotFound h)
+                    getTxData i h >>= \case
+                        Nothing -> do
+                            $(logErrorS) "BlockLogic" $
+                                "Transaction not found: " <> txHashToHex h
+                            throwError (TxNotFound h)
                         Just t
-                            | confirmed (transactionBlock t) -> return False
-                            | transactionRBF t -> return True
+                            | confirmed (txDataBlock t) -> return False
+                            | txDataRBF t -> return True
                             | otherwise -> return False
-    fee us = sum (map outputAmount us) - sum (map outValue (txOut tx))
     mkin u ip w =
         Input
             { inputPoint = prevOutput ip
@@ -381,15 +500,19 @@
        ( MonadError ImportException m
        , StoreRead i m
        , StoreWrite i m
-       , UnspentStore i m
+       , UnspentRead i m
+       , UnspentWrite i m
+       , BalanceRead i m
+       , BalanceWrite i m
+       , MonadLogger m
        )
-    => i
+    => Network
+    -> i
     -> BlockRef
-    -> TxHash
-    -> Word32
+    -> OutPoint
     -> TxOut
     -> m ()
-newOutput i tb th ix to = do
+newOutput net i br op to = do
     addUnspent i u
     case scriptToAddressBS (scriptOutput to) of
         Left _ -> return ()
@@ -399,29 +522,34 @@
                 i
                 AddressTx
                     { addressTxAddress = a
-                    , addressTxHash = th
-                    , addressTxBlock = tb
+                    , addressTxHash = outPointHash op
+                    , addressTxBlock = br
                     }
-            increaseBalance i (confirmed tb) a (outValue to)
+            increaseBalance net i (confirmed br) a (outValue to)
   where
     u =
         Unspent
-            { unspentBlock = tb
+            { unspentBlock = br
             , unspentAmount = outValue to
             , unspentScript = B.Short.toShort (scriptOutput to)
-            , unspentPoint = OutPoint th ix
+            , unspentPoint = op
             }
 
 delOutput ::
        ( MonadError ImportException m
        , StoreRead i m
        , StoreWrite i m
-       , UnspentStore i m
+       , UnspentRead i m
+       , UnspentWrite i m
+       , BalanceRead i m
+       , BalanceWrite i m
+       , MonadLogger m
        )
-    => i
+    => Network
+    -> i
     -> OutPoint
     -> m ()
-delOutput i op = do
+delOutput net i op = do
     t <- getImportTx i (outPointHash op)
     u <- getTxOutput (outPointIndex op) t
     delUnspent i op
@@ -445,162 +573,221 @@
                     , addressTxBlock = transactionBlock t
                     }
             reduceBalance
+                net
                 i
                 (confirmed (transactionBlock t))
                 a
                 (outputAmount u)
 
 getImportTx ::
-       (MonadError ImportException m, StoreRead i m)
+       (MonadError ImportException m, StoreRead i m, MonadLogger m)
     => i
     -> TxHash
     -> m Transaction
 getImportTx i th =
-    getTransaction i th >>= \case
-        Nothing -> throwError $ TxNotFound th
-        Just t
-            | transactionDeleted t -> throwError $ TxDeleted th
-            | otherwise -> return t
+    getTxData i th >>= \case
+        Nothing -> do
+            $(logErrorS) "BlockLogic" $
+                "Tranasction not found: " <> txHashToHex th
+            throwError $ TxNotFound th
+        Just d
+            | txDataDeleted d -> do
+                $(logErrorS) "BlockLogic" $
+                    "Transaction deleted: " <> txHashToHex th
+                throwError $ TxDeleted th
+            | otherwise -> do
+                sm <- getSpenders i th
+                return $ toTransaction d sm
 
 getTxOutput ::
-       (MonadError ImportException m) => Word32 -> Transaction -> m Output
+       (MonadError ImportException m, MonadLogger m)
+    => Word32
+    -> Transaction
+    -> m Output
 getTxOutput i tx = do
-    unless (fromIntegral i < length (transactionOutputs tx)) $
+    unless (fromIntegral i < length (transactionOutputs tx)) $ do
+        $(logErrorS) "BlockLogic" $
+            "Output out of range " <> txHashToHex (txHash (transactionData tx)) <>
+            " " <>
+            fromString (show i)
         throwError $
-        OutputOutOfRange
-            OutPoint
-                {outPointHash = txHash (transactionData tx), outPointIndex = i}
+            OutputOutOfRange
+                OutPoint
+                    { outPointHash = txHash (transactionData tx)
+                    , outPointIndex = i
+                    }
     return $ transactionOutputs tx !! fromIntegral i
 
 spendOutput ::
        ( MonadError ImportException m
        , StoreRead i m
        , StoreWrite i m
-       , UnspentStore i m
+       , UnspentRead i m
+       , UnspentWrite i m
+       , BalanceRead i m
+       , BalanceWrite i m
+       , MonadLogger m
        )
-    => i
+    => Network
+    -> i
     -> BlockRef
     -> TxHash
     -> Word32
     -> Unspent
     -> m ()
-spendOutput i tb th ix u = do
-    insertOutput
+spendOutput net i br th ix u = do
+    insertSpender
         i
         (unspentPoint u)
-        Output
-            { outputAmount = unspentAmount u
-            , outputScript = B.Short.fromShort (unspentScript u)
-            , outputSpender = Just Spender {spenderHash = th, spenderIndex = ix}
-            }
-    delUnspent i (unspentPoint u)
+        Spender {spenderHash = th, spenderIndex = ix}
     case scriptToAddressBS (B.Short.fromShort (unspentScript u)) of
         Left _ -> return ()
         Right a -> do
+            reduceBalance net i (confirmed (unspentBlock u)) a (unspentAmount u)
             removeAddrUnspent i a u
-            reduceBalance i (confirmed tb) a (unspentAmount u)
             insertAddrTx
                 i
                 AddressTx
                     { addressTxAddress = a
                     , addressTxHash = th
-                    , addressTxBlock = tb
+                    , addressTxBlock = br
                     }
+    delUnspent i (unspentPoint u)
 
 unspendOutput ::
        ( MonadError ImportException m
        , StoreRead i m
        , StoreWrite i m
-       , UnspentStore i m
+       , UnspentRead i m
+       , UnspentWrite i m
+       , BalanceRead i m
+       , BalanceWrite i m
+       , MonadLogger m
        )
-    => i
+    => Network
+    -> i
     -> OutPoint
-    -> BlockRef
     -> m ()
-unspendOutput i op br = do
-    tx <- getImportTx i (outPointHash op)
-    out <- getTxOutput (outPointIndex op) tx
-    when (isJust (outputSpender out)) $ do
-        insertTx
-            i
-            tx {transactionOutputs = zipWith f [0 ..] (transactionOutputs tx)}
-        let u =
-                Unspent
-                    { unspentAmount = outputAmount out
-                    , unspentBlock = transactionBlock tx
-                    , unspentScript = B.Short.toShort (outputScript out)
-                    , unspentPoint = op
+unspendOutput net i op = do
+    t <- getImportTx i (outPointHash op)
+    o <- getTxOutput (outPointIndex op) t
+    s <-
+        case outputSpender o of
+            Nothing -> do
+                $(logErrorS) "BlockLogic" $
+                    "Output already unspent: " <> txHashToHex (outPointHash op) <>
+                    " " <>
+                    fromString (show (outPointIndex op))
+                throwError (AlreadyUnspent op)
+            Just s -> return s
+    x <- getImportTx i (spenderHash s)
+    deleteSpender i op
+    let u =
+            Unspent
+                { unspentAmount = outputAmount o
+                , unspentBlock = transactionBlock t
+                , unspentScript = B.Short.toShort (outputScript o)
+                , unspentPoint = op
+                }
+    addUnspent i u
+    case scriptToAddressBS (outputScript o) of
+        Left _ -> return ()
+        Right a -> do
+            insertAddrUnspent i a u
+            removeAddrTx
+                i
+                AddressTx
+                    { addressTxAddress = a
+                    , addressTxHash = spenderHash s
+                    , addressTxBlock = transactionBlock x
                     }
-        addUnspent i u
-        case scriptToAddressBS (outputScript out) of
-            Left _ -> return ()
-            Right a -> do
-                insertAddrUnspent i a u
-                increaseBalance i (confirmed br) a (outputAmount out)
-  where
-    f n o
-        | n == outPointIndex op = o {outputSpender = Nothing}
-        | otherwise = o
+            increaseBalance
+                net
+                i
+                (confirmed (unspentBlock u))
+                a
+                (outputAmount o)
 
 reduceBalance ::
-       (MonadError ImportException m, StoreRead i m, StoreWrite i m)
-    => i
-    -> Bool -- ^ confirmed
+       ( MonadError ImportException m
+       , StoreRead i m
+       , StoreWrite i m
+       , BalanceRead i m
+       , BalanceWrite i m
+       , MonadLogger m
+       )
+    => Network
+    -> i
+    -> Bool -- ^ spend or delete confirmed output
     -> Address
     -> Word64
     -> m ()
-reduceBalance i c a v = do
-    b <- getBalance i a
-    setBalance i =<<
-        if c
-            then do
-                unless (v <= balanceAmount b) $
-                    throwError (InsufficientBalance a)
-                unless (balanceCount b > 0) $ throwError (InsufficientOutputs a)
-                return
-                    b
-                        { balanceAmount = balanceAmount b - v
-                        , balanceCount = balanceCount b - 1
-                        }
-            else do
-                unless
-                    (fromIntegral v <=
-                     fromIntegral (balanceAmount b) + balanceZero b) $
-                    throwError (InsufficientBalance a)
-                unless (balanceCount b > 0) $ throwError (InsufficientOutputs a)
-                return
-                    b
-                        { balanceZero = balanceZero b - fromIntegral v
-                        , balanceCount = balanceCount b - 1
-                        }
+reduceBalance net i c a v =
+    getBalance i a >>= \case
+        Nothing -> do
+            $(logErrorS) "BlockLogic" $
+                "Balance not found: " <> addrToString net a
+            throwError (BalanceNotFound a)
+        Just b -> do
+            when
+                (v >
+                 if c
+                     then balanceAmount b
+                     else balanceZero b) $
+                $(logErrorS) "BlockLogic" $
+                "Insufficient balance: " <> addrToString net a
+            setBalance i $
+                b
+                    { balanceAmount =
+                          balanceAmount b -
+                          if c
+                              then v
+                              else 0
+                    , balanceZero =
+                          balanceZero b -
+                          if c
+                              then 0
+                              else v
+                    , balanceCount = balanceCount b - 1
+                    }
 
 increaseBalance ::
-       (MonadError ImportException m, StoreRead i m, StoreWrite i m)
-    => i
-    -> Bool -- ^ confirmed
+       ( MonadError ImportException m
+       , StoreRead i m
+       , StoreWrite i m
+       , BalanceRead i m
+       , BalanceWrite i m
+       , MonadLogger m
+       )
+    => Network
+    -> i
+    -> Bool -- ^ add confirmed output
     -> Address
     -> Word64
     -> m ()
-increaseBalance i c a v = do
-    b <- getBalance i a
+increaseBalance _net i c a v = do
+    b <-
+        getBalance i a >>= \case
+            Nothing ->
+                return
+                    Balance
+                        { balanceAddress = a
+                        , balanceAmount = 0
+                        , balanceZero = 0
+                        , balanceCount = 0
+                        }
+            Just b -> return b
     setBalance i $
-        if c
-            then b
-                     { balanceAmount = balanceAmount b + v
-                     , balanceCount = balanceCount b + 1
-                     }
-            else b
-                     { balanceZero = balanceZero b + fromIntegral v
-                     , balanceCount = balanceCount b + 1
-                     }
-
-pruneUnspentMap :: UnspentMap -> UnspentMap
-pruneUnspentMap um
-    | M.size um > 2000 * 1000 =
-        let f is = unspentBlock (head (I.elems is))
-            ls =
-                sortBy
-                    (compare `on` (f . snd))
-                    (filter (not . I.null . snd) (M.toList um))
-         in M.fromList (drop (1000 * 1000) ls)
-    | otherwise = um
+        b
+            { balanceAmount =
+                  balanceAmount b +
+                  if c
+                      then v
+                      else 0
+            , balanceZero =
+                  balanceZero b +
+                  if c
+                      then 0
+                      else v
+            , balanceCount = balanceCount b + 1
+            }
diff --git a/test/Spec.hs b/test/Spec.hs
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -74,6 +74,7 @@
                     w
                     defaultOptions
                         { createIfMissing = True
+                        , errorIfExists = True
                         , compression = SnappyCompression
                         }
             let cfg =