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:        0.40.10
+version:        0.40.11
 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/Cache.hs b/src/Haskoin/Store/Cache.hs
--- a/src/Haskoin/Store/Cache.hs
+++ b/src/Haskoin/Store/Cache.hs
@@ -24,10 +24,10 @@
     ) where
 
 import           Control.DeepSeq           (NFData)
-import           Control.Monad             (forM, forM_, forever, unless, void,
-                                            when)
+import           Control.Monad             (forM, forM_, forever, guard, unless,
+                                            void, when)
 import           Control.Monad.Logger      (MonadLoggerIO, logDebugS, logErrorS,
-                                            logWarnS)
+                                            logInfoS, logWarnS)
 import           Control.Monad.Reader      (ReaderT (..), ask, asks)
 import           Control.Monad.Trans       (lift)
 import           Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)
@@ -468,7 +468,9 @@
             $(logErrorS) "Cache" $
                 "Unexpected status acquiring lock: " <> cs s
             return Nothing
-        Left (Redis.Bulk Nothing) -> return Nothing
+        Left (Redis.Bulk Nothing) -> do
+            $(logDebugS) "Cache" "Lock already taken"
+            return Nothing
         Left e -> do
             $(logErrorS) "Cache"
                 "Error when trying to acquire lock"
@@ -522,8 +524,12 @@
     :: (MonadLoggerIO m, MonadUnliftIO m)
     => CacheX m a
     -> CacheX m a
-withLockForever go = withLock go >>= \case
-    Nothing -> smallDelay >> go
+withLockForever go =
+    withLock go >>= \case
+    Nothing -> do
+        smallDelay
+        $(logDebugS) "Cache" "Retrying lock aquisition without limits"
+        withLockForever go
     Just x -> return x
 
 withLockRetry
@@ -534,8 +540,13 @@
 withLockRetry i f
   | i <= 0 = return Nothing
   | otherwise = withLock f >>= \case
-        Nothing -> smallDelay >> withLockRetry (i - 1) f
-        Just x -> return (Just x)
+        Nothing -> do
+            smallDelay
+            $(logDebugS) "Cache" $
+                "Retrying lock acquisition: " <>
+                cs (show i) <> " tries remaining"
+            withLockRetry (i - 1) f
+        x -> return x
 
 pruneDB :: (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m)
         => CacheX m Integer
@@ -639,47 +650,42 @@
 newBlockC :: (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m)
           => CacheX m ()
 newBlockC =
-    lift getBestBlock >>= \m ->
-    forM_ m $ \bb -> withLock $ f bb
+    inSync >>= \s -> when s $
+    lift getBestBlock >>= \case
+    Nothing -> $(logDebugS) "Cache" "No best block"
+    Just bb -> cacheGetHead >>= \case
+        Nothing -> do
+            $(logInfoS) "Cache" "Initializing best cache block"
+            importBlockC bb
+        Just cb
+            | cb == bb -> $(logDebugS) "Cache" "Cache in sync"
+            | otherwise -> sync bb cb
   where
-    f bb = cacheGetHead >>= go bb
-    go bb Nothing =
-        importBlockC bb
-    go bb (Just cb)
-        | cb == bb =
-              $(logDebugS) "Cache" "Cache in sync"
-        | otherwise =
-              sync bb cb
     sync bb cb =
         asks cacheChain >>= \ch ->
-        chainBlockMain bb ch >>= \case
-        False ->
+        chainGetBlock cb ch >>= \case
+        Nothing ->
             $(logErrorS) "Cache" $
-            "New head not in main chain: " <> blockHashToHex bb
-        True ->
-            chainGetBlock cb ch >>= \case
-            Nothing ->
-                $(logErrorS) "Cache" $
-                "Cache head block node not found: " <>
-                blockHashToHex cb
-            Just cn ->
-                chainBlockMain cb ch >>= \case
-                False -> do
-                    $(logDebugS) "Cache" $
-                        "Reverting cache head not in main chain: " <>
-                        blockHashToHex cb
-                    removeHeadC >> f bb
-                True ->
-                    chainGetBlock bb ch >>= \case
-                    Just nn -> next bb nn cn
-                    Nothing -> do
-                        $(logErrorS) "Cache" $
-                            "Cache head node not found: "
-                            <> blockHashToHex bb
-                        throwIO $
-                            LogicError $
-                            "Cache head node not found: "
-                            <> cs (blockHashToHex bb)
+            "Cache head block node not found: " <>
+            blockHashToHex cb
+        Just cn ->
+            chainBlockMain cb ch >>= \case
+            False -> do
+                $(logDebugS) "Cache" $
+                    "Reverting cache head not in main chain: " <>
+                    blockHashToHex cb
+                removeHeadC cb >> newBlockC
+            True ->
+                chainGetBlock bb ch >>= \case
+                Just nn -> next bb nn cn
+                Nothing -> do
+                    $(logErrorS) "Cache" $
+                        "Cache head node not found: "
+                        <> blockHashToHex bb
+                    throwIO $
+                        LogicError $
+                        "Cache head node not found: "
+                        <> cs (blockHashToHex bb)
     next bb nn cn =
         asks cacheChain >>= \ch ->
         chainGetAncestor (nodeHeight cn + 1) nn ch >>= \case
@@ -690,11 +696,12 @@
             <> " for block: "
             <> blockHashToHex (headerHash (nodeHeader nn))
         Just cn' ->
-            importBlockC (headerHash (nodeHeader cn')) >> f bb
+            importBlockC (headerHash (nodeHeader cn')) >> newBlockC
 
 importBlockC :: (MonadUnliftIO m, StoreReadExtra m, MonadLoggerIO m)
              => BlockHash -> CacheX m ()
 importBlockC bh =
+    withLockForever $
     lift (getBlock bh) >>= \case
     Just bd -> do
         let ths = blockDataTxs bd
@@ -718,10 +725,12 @@
             <> blockHashToHex bh
 
 removeHeadC :: (StoreReadExtra m, MonadUnliftIO m, MonadLoggerIO m)
-            => CacheX m ()
-removeHeadC =
+            => BlockHash -> CacheX m ()
+removeHeadC cb =
+    withLockForever $
     void . runMaybeT $ do
     bh <- MaybeT cacheGetHead
+    guard (cb == bh)
     bd <- MaybeT (lift (getBlock bh))
     lift $ do
         tds <- sortTxData . catMaybes <$>
@@ -944,9 +953,16 @@
          -> CacheX m a
          -> CacheX m (Maybe a)
 withCool key milliseconds run =
-    is_cool >>= \c -> if c
-                      then run >>= \x -> cooldown >> return (Just x)
-                      else return Nothing
+    is_cool >>= \c ->
+    if c
+    then do
+        $(logDebugS) "Cache" $ "Cooldown reached for key: " <> cs (show key)
+        x <- run
+        cooldown
+        return (Just x)
+    else do
+        $(logDebugS) "Cache" $ "Cooldown NOT reached for key: " <> cs (show key)
+        return Nothing
   where
     is_cool = isNothing <$> runRedis (Redis.get key)
     cooldown =