diff --git a/app/Main.hs b/app/Main.hs
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -68,10 +68,16 @@
 import System.Exit (exitSuccess)
 import System.FilePath ((</>))
 import System.Metrics.StatsD
-    ( defStatConfig,
-      withStats,
-      StatConfig(statsdPort, statsdServer, namespace, reportSamples,
-                 reportStats) )
+  ( StatConfig
+      ( namespace,
+        reportSamples,
+        reportStats,
+        statsdPort,
+        statsdServer
+      ),
+    defStatConfig,
+    withStats,
+  )
 import Text.Read (readMaybe)
 import UnliftIO (MonadIO)
 import UnliftIO.Directory
diff --git a/haskoin-store.cabal b/haskoin-store.cabal
--- a/haskoin-store.cabal
+++ b/haskoin-store.cabal
@@ -5,7 +5,7 @@
 -- see: https://github.com/sol/hpack
 
 name:           haskoin-store
-version:        1.4.0
+version:        1.5.0
 synopsis:       Storage and index for Bitcoin and Bitcoin Cash
 description:    Please see the README on GitHub at <https://github.com/haskoin/haskoin-store#readme>
 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,7 +27,7 @@
     getTransaction,
     getDefaultBalance,
     getActiveTxData,
-    blockAtOrBefore
+    blockAtOrBefore,
   )
 where
 
diff --git a/src/Haskoin/Store/BlockStore.hs b/src/Haskoin/Store/BlockStore.hs
--- a/src/Haskoin/Store/BlockStore.hs
+++ b/src/Haskoin/Store/BlockStore.hs
@@ -238,8 +238,11 @@
 newStoreMetrics cfg =
   forM cfg.stats $ \s -> liftIO $ do
     m <- withDB cfg.db getMempool
-    b <- fmap (maybe 0 (.height)) $ withDB cfg.db $ runMaybeT $
-        MaybeT getBestBlock >>= MaybeT . getBlock
+    b <-
+      fmap (maybe 0 (.height)) $
+        withDB cfg.db $
+          runMaybeT $
+            MaybeT getBestBlock >>= MaybeT . getBlock
     h <- chainGetBest cfg.chain
     p <- getPeers cfg.peerMgr
     blocks <- g s "blocks" (fromIntegral b)
diff --git a/src/Haskoin/Store/Common.hs b/src/Haskoin/Store/Common.hs
--- a/src/Haskoin/Store/Common.hs
+++ b/src/Haskoin/Store/Common.hs
@@ -54,6 +54,8 @@
 import Control.Monad.Trans.Reader (runReaderT)
 import Data.ByteString (ByteString)
 import Data.Default (Default (..))
+import Data.Graph qualified as G
+import Data.HashMap.Strict qualified as M
 import Data.HashSet qualified as H
 import Data.Hashable (Hashable)
 import Data.Map.Strict qualified as Map
@@ -196,13 +198,13 @@
     rx = sum [b.balance.received | b <- xt]
 
 getTransaction ::
-  ( StoreReadBase m) =>TxHash -> m (Maybe Transaction)
+  (StoreReadBase m) => TxHash -> m (Maybe Transaction)
 getTransaction h = do
   ctx <- getCtx
   fmap (toTransaction ctx) <$> getTxData h
 
 getNumTransaction ::
-  ( StoreReadExtra m) =>Word64 -> m [Transaction]
+  (StoreReadExtra m) => Word64 -> m [Transaction]
 getNumTransaction i =
   getCtx >>= \ctx ->
     map (toTransaction ctx) <$> getNumTxData i
@@ -286,17 +288,21 @@
 applyLimitC l = takeC (fromIntegral l)
 
 sortTxs :: [Tx] -> [(Word32, Tx)]
-sortTxs txs = go [] thset $ zip [0 ..] txs
+sortTxs txs = ts
   where
-    thset = H.fromList (map txHash txs)
-    go [] _ [] = []
-    go orphans ths [] = go [] ths orphans
-    go orphans ths ((i, tx) : xs) =
-      let ops = map (.outpoint.hash) tx.inputs
-          orp = any (`H.member` ths) ops
-       in if orp
-            then go ((i, tx) : orphans) ths xs
-            else (i, tx) : go orphans (txHash tx `H.delete` ths) xs
+    hm :: M.HashMap TxHash Int
+    hm = M.fromList $ zip (map txHash txs) [0 ..]
+    ns :: [(Tx, Int, [Int])]
+    ns =
+      let is tx = nub' $ map (.outpoint.hash) tx.inputs
+          hs tx = mapMaybe (`M.lookup` hm) (is tx)
+          tp i tx = (tx, i, hs tx)
+       in zipWith tp [0 ..] txs
+    (g, n, _) = G.graphFromEdges ns
+    vs = G.reverseTopSort g
+    ts =
+      let f (tx, i, _) = (fromIntegral i, tx)
+       in map (f . n) vs
 
 nub' :: (Hashable a) => [a] -> [a]
 nub' = H.toList . H.fromList
diff --git a/src/Haskoin/Store/Logic.hs b/src/Haskoin/Store/Logic.hs
--- a/src/Haskoin/Store/Logic.hs
+++ b/src/Haskoin/Store/Logic.hs
@@ -39,7 +39,8 @@
   )
 import qualified Data.ByteString as B
 import Data.Either (rights)
-import qualified Data.HashSet as HashSet
+import qualified Data.HashMap.Strict as M
+import qualified Data.HashSet as H
 import qualified Data.IntMap.Strict as I
 import Data.List (nub)
 import Data.Maybe
@@ -199,7 +200,9 @@
 
 importOrConfirm :: (MonadImport m) => BlockNode -> [Tx] -> m [TxData]
 importOrConfirm bn txns = do
+  $(logDebugS) "BlockStore" "Freeing outputs..."
   mapM_ (freeOutputs True False . snd) (reverse txs)
+  $(logDebugS) "BlockStore" "Outputs freed"
   mapM (uncurry action) txs
   where
     txs = sortTxs txns
@@ -441,12 +444,14 @@
   Tx ->
   m ()
 freeOutputs memonly rbfcheck tx = do
+  $(logDebugS) "BlockStore" $
+    "Freeing outputs for tx " <> txHashToHex (txHash tx) <> "..."
   let prevs = prevOuts tx
   unspents <- mapM getUnspent prevs
   let spents = [p | (p, Nothing) <- zip prevs unspents]
   spndrs <- catMaybes <$> mapM getSpender spents
-  let txids = HashSet.fromList $ filter (/= txHash tx) $ map (.txid) spndrs
-  mapM_ (deleteTx memonly rbfcheck) $ HashSet.toList txids
+  let txids = H.fromList $ filter (/= txHash tx) $ map (.txid) spndrs
+  mapM_ (deleteTx memonly rbfcheck) $ H.toList txids
 
 deleteConfirmedTx :: (MonadImport m) => TxHash -> m ()
 deleteConfirmedTx = deleteTx False False
@@ -487,7 +492,7 @@
 getChain memonly rbfcheck th' = do
   $(logDebugS) "BlockStore" $
     "Getting chain for tx " <> txHashToHex th'
-  sort_clean <$> go HashSet.empty (HashSet.singleton th')
+  sort_clean <$> go M.empty (H.singleton th')
   where
     sort_clean = reverse . map snd . sortTxs
     get_tx th =
@@ -511,18 +516,23 @@
                       <> txHashToHex th
                   throwError DoubleSpend
           | otherwise -> return $ Just td
-    go txs pdg = do
-      tds <- catMaybes <$> mapM get_tx (HashSet.toList pdg)
-      let txsn = HashSet.fromList $ fmap (.tx) tds
-          pdgn =
-            HashSet.fromList
-              . concatMap (map (.txid) . I.elems)
-              $ fmap (.spenders) tds
-          txs' = txsn <> txs
-          pdg' = pdgn `HashSet.difference` HashSet.map txHash txs'
-      if HashSet.null pdg'
-        then return $ HashSet.toList txs'
-        else go txs' pdg'
+    go txm pdg = do
+      let ths = filter (not . (`M.member` txm)) (H.toList pdg)
+      tds <- catMaybes <$> mapM get_tx ths
+      let txmn = M.fromList $ fmap (\d -> (txHash d.tx, d.tx)) tds
+          spds = concatMap (map (.txid) . I.elems . (.spenders)) tds
+          pdg' = H.fromList spds
+          txm' = txmn <> txm
+      if H.null pdg'
+        then do
+          $(logDebugS) "BlockStore" $
+            "Chain for tx "
+              <> txHashToHex th'
+              <> " contains "
+              <> cs (show (M.size txm'))
+              <> " txs"
+          return $ M.elems txm'
+        else go txm' pdg'
 
 deleteSingleTx :: (MonadImport m) => TxHash -> m ()
 deleteSingleTx th =
diff --git a/src/Haskoin/Store/Web.hs b/src/Haskoin/Store/Web.hs
--- a/src/Haskoin/Store/Web.hs
+++ b/src/Haskoin/Store/Web.hs
@@ -46,8 +46,9 @@
   ( forM_,
     forever,
     unless,
+    void,
     when,
-    (<=<), void,
+    (<=<),
   )
 import Control.Monad.Logger
   ( MonadLoggerIO,
@@ -196,6 +197,7 @@
     MonadUnliftIO,
     TVar,
     askRunInIO,
+    async,
     atomically,
     bracket,
     bracket_,
@@ -204,7 +206,7 @@
     newTVarIO,
     readTVarIO,
     withAsync,
-    writeTVar, async,
+    writeTVar,
   )
 import UnliftIO.Concurrent (threadDelay)
 import Web.Scotty.Trans qualified as S
diff --git a/test/Haskoin/StoreSpec.hs b/test/Haskoin/StoreSpec.hs
--- a/test/Haskoin/StoreSpec.hs
+++ b/test/Haskoin/StoreSpec.hs
@@ -17,8 +17,8 @@
 import Data.ByteString qualified as B
 import Data.ByteString.Base64
 import Data.Either
-import Data.List ( find )
-import Data.Maybe ( fromJust, fromMaybe, isJust, mapMaybe )
+import Data.List (find)
+import Data.Maybe (fromJust, fromMaybe, isJust, mapMaybe)
 import Data.Serialize
 import Data.Time.Clock.POSIX
 import Data.Word