diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -4,6 +4,13 @@
 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).
 
+## [2.0.0] - 2026-10-31
+
+### Changed
+
+- Replace monad-logger with fast-logger. Configuration records take a `Logger`,
+  and functions need only `MonadIO` or `MonadUnliftIO`.
+
 ## [1.4.4] - 2026-08-31
 
 ### Added
diff --git a/haskoin-node.cabal b/haskoin-node.cabal
--- a/haskoin-node.cabal
+++ b/haskoin-node.cabal
@@ -5,7 +5,7 @@
 -- see: https://github.com/sol/hpack
 
 name:           haskoin-node
-version:        1.4.4
+version:        2.0.0
 synopsis:       P2P library for Bitcoin and Bitcoin Cash
 description:    Please see the README on GitHub at <https://github.com/jprupp/haskoin-node#readme>
 category:       Bitcoin, Finance, Network
@@ -29,6 +29,8 @@
       Haskoin.Node
   other-modules:
       Haskoin.Node.Chain
+      Haskoin.Node.Logger
+      Haskoin.Node.Loop
       Haskoin.Node.Peer
       Haskoin.Node.PeerMgr
       Paths_haskoin_node
@@ -43,9 +45,9 @@
     , conduit-extra
     , containers
     , data-default
+    , fast-logger
     , hashable
     , haskoin-core >=1.3.0
-    , monad-logger
     , mtl
     , network
     , nqe >=0.6.3
@@ -80,11 +82,11 @@
     , conduit-extra
     , containers
     , data-default
+    , fast-logger
     , hashable
     , haskoin-core >=1.3.0
     , haskoin-node
     , hspec
-    , monad-logger
     , mtl
     , network
     , nqe >=0.6.3
diff --git a/src/Haskoin/Node.hs b/src/Haskoin/Node.hs
--- a/src/Haskoin/Node.hs
+++ b/src/Haskoin/Node.hs
@@ -12,6 +12,7 @@
   ( module Haskoin.Node.Peer,
     module Haskoin.Node.PeerMgr,
     module Haskoin.Node.Chain,
+    module Haskoin.Node.Logger,
     NodeConfig (..),
     NodeEvent (..),
     Node (..),
@@ -20,9 +21,7 @@
   )
 where
 
-import Control.Monad (forever)
 import Control.Monad.Cont (ContT (..), MonadCont (callCC), cont, runCont, runContT)
-import Control.Monad.Logger
 import Control.Monad.Trans (lift)
 import Data.Conduit.Network
 import Data.String.Conversions (cs)
@@ -30,6 +29,8 @@
 import Database.RocksDB (ColumnFamily, DB)
 import Haskoin
 import Haskoin.Node.Chain
+import Haskoin.Node.Logger
+import Haskoin.Node.Loop (loopForever)
 import Haskoin.Node.Peer
 import Haskoin.Node.PeerMgr
 import NQE
@@ -59,7 +60,9 @@
     timeout :: !NominalDiffTime,
     -- | peer disconnect after seconds
     maxPeerLife :: !NominalDiffTime,
-    connect :: !(SockAddr -> WithConnection)
+    connect :: !(SockAddr -> WithConnection),
+    -- | log messages here
+    logger :: !Logger
   }
 
 data Node = Node
@@ -95,7 +98,7 @@
 
 chainEvents ::
   (MonadIO m) => PeerMgr -> Inbox ChainEvent -> Publisher NodeEvent -> m ()
-chainEvents mgr input output = forever $ do
+chainEvents mgr input output = loopForever $ do
   event <- receive input
   case event of
     ChainBestBlock bb -> peerMgrBest mgr bb.height
@@ -103,9 +106,9 @@
   publish (ChainEvent event) output
 
 peerEvents ::
-  (MonadLoggerIO m) =>
+  (MonadIO m) =>
   Chain -> PeerMgr -> Inbox PeerEvent -> Publisher NodeEvent -> m ()
-peerEvents ch mgr input output = forever $ do
+peerEvents ch mgr input output = loopForever $ do
   event <- receive input
   case event of
     PeerConnected p ->
@@ -132,14 +135,16 @@
 
 -- | Launch node process in the foreground.
 withNode ::
-  (MonadUnliftIO m, MonadLoggerIO m) => NodeConfig -> (Node -> m a) -> m a
+  (MonadUnliftIO m) => NodeConfig -> (Node -> m a) -> m a
 withNode NodeConfig {..} action = flip runContT return $ do
   peerPub <- ContT withPublisher
   peerSub <- ContT (withSubscription peerPub)
   chainPub <- ContT withPublisher
   chainSub <- ContT (withSubscription chainPub)
-  let peerMgrCfg = PeerMgrConfig {pub = peerPub, ..}
-  let chainCfg = ChainConfig {pub = chainPub, ..}
+  let peerMgrCfg =
+        PeerMgrConfig {pub = peerPub, logger = withSource "PeerMgr" logger, ..}
+  let chainCfg =
+        ChainConfig {pub = chainPub, logger = withSource "Chain" logger, ..}
   chain <- ContT (withChain chainCfg)
   peerMgr <- ContT $ withPeerMgr peerMgrCfg
   link =<< ContT (withAsync $ chainEvents peerMgr chainSub pub)
diff --git a/src/Haskoin/Node/Chain.hs b/src/Haskoin/Node/Chain.hs
--- a/src/Haskoin/Node/Chain.hs
+++ b/src/Haskoin/Node/Chain.hs
@@ -11,7 +11,6 @@
 {-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE NoFieldSelectors #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
@@ -36,8 +35,7 @@
   )
 where
 
-import Control.Monad (forM_, forever, guard, when)
-import Control.Monad.Logger
+import Control.Monad (forM_, guard, when)
 import Control.Monad.Trans.Reader
 import Data.ByteString qualified as B
 import Data.Function (on)
@@ -52,6 +50,8 @@
 import Database.RocksDB qualified as R
 import Database.RocksDB.Query
 import Haskoin hiding (Key)
+import Haskoin.Node.Logger
+import Haskoin.Node.Loop (loopForever)
 import Haskoin.Node.Peer
 import Haskoin.Node.PeerMgr (myVersion)
 import NQE
@@ -70,7 +70,9 @@
     -- | send header chain events here
     pub :: !(Publisher ChainEvent),
     -- | timeout in seconds
-    timeout :: !NominalDiffTime
+    timeout :: !NominalDiffTime,
+    -- | log messages here
+    logger :: !Logger
   }
 
 data ChainMessage
@@ -189,7 +191,7 @@
   addBlockHeaders bns = withReaderT (.config) (addBlockHeaders bns)
 
 withChain ::
-  (MonadLoggerIO m, MonadUnliftIO m) => ChainConfig -> (Chain -> m a) -> m a
+  (MonadUnliftIO m) => ChainConfig -> (Chain -> m a) -> m a
 withChain cfg action = do
   (inbox, mailbox) <- newMailbox
   st <-
@@ -208,73 +210,73 @@
       withSyncLoop ch.mailbox (run ch inbox)
     run ch inbox = do
       runReaderT getBestBlockHeader cfg
-        >>= chainEvent cfg.pub . ChainBestBlock
-      forever $ do
-        $(logDebugS) "Chain" "Awaiting event..."
+        >>= chainEvent cfg . ChainBestBlock
+      loopForever $ do
+        logDebug ch.config.logger "Awaiting event..."
         msg <- receive inbox
         chainConfigMessage ch msg
 
-chainEvent :: (MonadLoggerIO m) => Publisher ChainEvent -> ChainEvent -> m ()
-chainEvent pub e = do
+chainEvent :: (MonadIO m) => ChainConfig -> ChainEvent -> m ()
+chainEvent cfg e = do
   case e of
     ChainBestBlock b ->
-      $(logInfoS)
-        "Chain"
+      logInfo
+        cfg.logger
         ("Best block header at height " <> cs (show b.height))
     ChainSynced b ->
-      $(logInfoS)
-        "Chain"
+      logInfo
+        cfg.logger
         ("Headers in sync at height " <> cs (show b.height))
-  publish e pub
+  publish e cfg.pub
 
-processHeaders :: (MonadLoggerIO m) => Chain -> Peer -> [BlockHeader] -> m ()
+processHeaders :: (MonadIO m) => Chain -> Peer -> [BlockHeader] -> m ()
 processHeaders ch p hs = do
   let len = length hs
-  $(logDebugS)
-    "Chain"
+  logDebug
+    ch.config.logger
     ("Processing " <> cs (show len) <> " headers from peer " <> p.label)
   let net = ch.config.net
   now <- liftIO getCurrentTime
   pbest <- runReaderT getBestBlockHeader ch.config
   importHeaders ch now hs >>= \case
     Nothing -> do
-      $(logWarnS)
-        "Chain"
+      logWarn
+        ch.config.logger
         ("Could not connect headers from peer " <> p.label)
       killPeer p
     Just done -> do
       setLastReceived ch.state
       best <- runReaderT getBestBlockHeader ch.config
       when (pbest.header /= best.header) $
-        chainEvent ch.config.pub (ChainBestBlock best)
+        chainEvent ch.config (ChainBestBlock best)
       if done
         then do
           MSendHeaders `sendMessage` p
-          finishPeer ch.state p
+          finishPeer ch p
           syncNewPeer ch
           syncNotif ch
         else syncPeer ch p
 
-syncNewPeer :: (MonadLoggerIO m) => Chain -> m ()
+syncNewPeer :: (MonadIO m) => Chain -> m ()
 syncNewPeer ch =
   getSyncingPeer ch.state >>= \case
     Just _ -> return ()
     Nothing ->
-      nextPeer ch.state >>= \case
+      nextPeer ch >>= \case
         Nothing -> return ()
         Just p -> do
-          $(logDebugS) "Chain" ("Syncing against peer " <> p.label)
+          logDebug ch.config.logger ("Syncing against peer " <> p.label)
           syncPeer ch p
 
-syncNotif :: (MonadLoggerIO m) => Chain -> m ()
+syncNotif :: (MonadIO m) => Chain -> m ()
 syncNotif ch =
   notifySynced ch >>= \case
     False -> return ()
     True ->
       runReaderT getBestBlockHeader ch.config
-        >>= chainEvent ch.config.pub . ChainSynced
+        >>= chainEvent ch.config . ChainSynced
 
-syncPeer :: (MonadLoggerIO m) => Chain -> Peer -> m ()
+syncPeer :: (MonadIO m) => Chain -> Peer -> m ()
 syncPeer ch p = do
   t <- liftIO getCurrentTime
   m <-
@@ -284,16 +286,16 @@
         | otherwise -> return Nothing
       Nothing -> syncing_new t
   forM_ m $ \g -> do
-    $(logDebugS)
-      "Chain"
+    logDebug
+      ch.config.logger
       ("Requesting headers from peer " <> p.label)
     MGetHeaders g `sendMessage` p
   where
     syncing_new t =
-      setSyncingPeer ch.state p >>= \case
+      setSyncingPeer ch p >>= \case
         False -> return Nothing
         True -> do
-          $(logDebugS) "Chain" ("Locked peer " <> p.label)
+          logDebug ch.config.logger ("Locked peer " <> p.label)
           h <- runReaderT getBestBlockHeader ch.config
           Just <$> syncHeaders ch t h p
     syncing_me t m = do
@@ -302,26 +304,26 @@
         Just h -> return h
       Just <$> syncHeaders ch t h p
 
-chainConfigMessage :: (MonadLoggerIO m) => Chain -> ChainMessage -> m ()
+chainConfigMessage :: (MonadIO m) => Chain -> ChainMessage -> m ()
 chainConfigMessage ch (ChainHeaders p hs) =
   processHeaders ch p hs
 chainConfigMessage ch (ChainPeerConnected p) = do
-  $(logDebugS) "Chain" ("Connected peer " <> p.label)
+  logDebug ch.config.logger ("Connected peer " <> p.label)
   addPeer ch.state p
   syncNewPeer ch
 chainConfigMessage ch (ChainPeerDisconnected p) = do
-  $(logDebugS) "Chain" ("Disconnected peer " <> p.label)
-  finishPeer ch.state p
+  logDebug ch.config.logger ("Disconnected peer " <> p.label)
+  finishPeer ch p
   syncNewPeer ch
 chainConfigMessage ch ChainPing = do
-  $(logDebugS) "Chain" "Internal clock event"
+  logDebug ch.config.logger "Internal clock event"
   let to = ch.config.timeout
   now <- liftIO getCurrentTime
   chainSyncingPeer ch.state >>= \case
     Just ChainSync {peer = p, timestamp = t}
       | now `diffUTCTime` t > to -> do
-          $(logWarnS)
-            "Chain"
+          logWarn
+            ch.config.logger
             ("Syncing peer " <> p.label <> " timed out")
           killPeer p
       | otherwise -> return ()
@@ -332,7 +334,7 @@
   withAsync go $ \a ->
     link a >> mf
   where
-    go = forever $ do
+    go = loopForever $ do
       delay <- randomRIO (2 * 10 ^ 6, 2 * 10 ^ 7)
       threadDelay delay
       ChainPing `send` mbox
@@ -381,11 +383,11 @@
 -- headers is less than 2000, which means that there are no more headers to sync
 -- from the peer that delivered these.
 importHeaders ::
-  (MonadLoggerIO m) => Chain -> UTCTime -> [BlockHeader] -> m (Maybe Bool)
+  (MonadIO m) => Chain -> UTCTime -> [BlockHeader] -> m (Maybe Bool)
 importHeaders ch now hs =
   connect >>= \case
     Left e -> do
-      $(logErrorS) "Chain" ("connectBlocks: " <> cs e)
+      logError ch.config.logger ("connectBlocks: " <> cs e)
       return Nothing
     Right bns
       | null bns -> return (Just False)
@@ -426,12 +428,12 @@
       posixSecondsToUTCTime . fromIntegral . (.header.timestamp)
 
 -- | Get next peer to sync against from the queue.
-nextPeer :: (MonadLoggerIO m) => TVar ChainState -> m (Maybe Peer)
-nextPeer st = fmap (.peers) (readTVarIO st) >>= go
+nextPeer :: (MonadIO m) => Chain -> m (Maybe Peer)
+nextPeer ch = fmap (.peers) (readTVarIO ch.state) >>= go
   where
     go [] = return Nothing
     go (p : ps) =
-      setSyncingPeer st p >>= \case
+      setSyncingPeer ch p >>= \case
         True -> return (Just p)
         False -> go ps
 
@@ -481,23 +483,23 @@
     ChainState {syncing = Just ChainSync {peer}} -> return (Just peer)
     _ -> return Nothing
 
-setSyncingPeer :: (MonadLoggerIO m) => TVar ChainState -> Peer -> m Bool
-setSyncingPeer st p =
+setSyncingPeer :: (MonadIO m) => Chain -> Peer -> m Bool
+setSyncingPeer ch p =
   setBusy p >>= \case
     False -> do
-      $(logDebugS)
-        "Chain"
+      logDebug
+        ch.config.logger
         ("Could not lock peer: " <> p.label)
       return False
     True -> do
-      $(logDebugS) "Chain" $
+      logDebug ch.config.logger $
         ("Locked peer: " <> p.label)
       set_it
       return True
   where
     set_it = do
       now <- liftIO getCurrentTime
-      atomically $ modifyTVar st $ \s ->
+      atomically $ modifyTVar ch.state $ \s ->
         s
           { syncing =
               Just
@@ -510,22 +512,22 @@
 
 -- | Remove a peer from the queue of peers to sync and unset the syncing peer if
 -- it is set to the provided peer.
-finishPeer :: (MonadLoggerIO m) => TVar ChainState -> Peer -> m ()
-finishPeer st p =
+finishPeer :: (MonadIO m) => Chain -> Peer -> m ()
+finishPeer ch p =
   remove_peer >>= \case
     False ->
-      $(logDebugS)
-        "Chain"
+      logDebug
+        ch.config.logger
         ("Removed peer " <> p.label <> " from queue")
     True -> do
-      $(logDebugS)
-        "Chain"
+      logDebug
+        ch.config.logger
         ("Releasing syncing peer " <> p.label)
       setFree p
   where
     remove_peer =
       atomically $
-        readTVar st >>= \s -> case s.syncing of
+        readTVar ch.state >>= \s -> case s.syncing of
           Just ChainSync {peer = p'}
             | p == p' -> do
                 unset_syncing
@@ -534,10 +536,10 @@
             remove_from_queue
             return False
     unset_syncing =
-      modifyTVar st $ \x ->
+      modifyTVar ch.state $ \x ->
         x {syncing = Nothing}
     remove_from_queue =
-      modifyTVar st $ \x ->
+      modifyTVar ch.state $ \x ->
         x {peers = delete p x.peers}
 
 -- | Return syncing peer data.
diff --git a/src/Haskoin/Node/Logger.hs b/src/Haskoin/Node/Logger.hs
new file mode 100644
--- /dev/null
+++ b/src/Haskoin/Node/Logger.hs
@@ -0,0 +1,71 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoFieldSelectors #-}
+
+-- | Logging to standard error. A 'Logger' is a plain value carried in
+-- configuration records, so code that logs only needs 'MonadIO'.
+module Haskoin.Node.Logger
+  ( Logger (..),
+    LogLevel (..),
+    withLogger,
+    withSource,
+    logAt,
+    logDebug,
+    logInfo,
+    logWarn,
+    logError,
+  )
+where
+
+import Control.Monad (when)
+import Data.Text (Text)
+import Data.Text qualified as T
+import System.Log.FastLogger
+  ( LogStr,
+    LogType' (LogStderr),
+    defaultBufSize,
+    newFastLogger1,
+    toLogStr,
+  )
+import UnliftIO (MonadIO, bracket, liftIO)
+
+data LogLevel = LevelDebug | LevelInfo | LevelWarn | LevelError
+  deriving (Eq, Ord, Show)
+
+data Logger = Logger
+  { -- | messages below this level are dropped
+    level :: !LogLevel,
+    -- | tag printed with every message
+    source :: !Text,
+    -- | write one formatted line
+    push :: !(LogStr -> IO ())
+  }
+
+-- | Log to standard error in the order messages are logged. Buffered lines are
+-- written out when the action returns or throws.
+withLogger :: LogLevel -> (Logger -> IO a) -> IO a
+withLogger level go =
+  bracket (newFastLogger1 (LogStderr defaultBufSize)) snd $ \(push, _) ->
+    go Logger {level, source = "", push}
+
+-- | Same output with a different tag.
+withSource :: Text -> Logger -> Logger
+withSource source logger = logger {source}
+
+-- | Lines look like monad-logger's: @[Info#Chain] message@.
+logAt :: (MonadIO m) => LogLevel -> Logger -> Text -> m ()
+logAt l logger msg =
+  when (l >= logger.level) . liftIO . logger.push $
+    "[" <> toLogStr (drop 5 (show l)) <> tag <> "] " <> toLogStr msg <> "\n"
+  where
+    tag
+      | T.null logger.source = ""
+      | otherwise = "#" <> toLogStr logger.source
+
+logDebug, logInfo, logWarn, logError :: (MonadIO m) => Logger -> Text -> m ()
+logDebug = logAt LevelDebug
+logInfo = logAt LevelInfo
+logWarn = logAt LevelWarn
+logError = logAt LevelError
diff --git a/src/Haskoin/Node/Loop.hs b/src/Haskoin/Node/Loop.hs
new file mode 100644
--- /dev/null
+++ b/src/Haskoin/Node/Loop.hs
@@ -0,0 +1,19 @@
+-- | A replacement for 'Control.Monad.forever' that stays a flat loop in any
+-- monad.
+--
+-- @forever a = let a' = a *> a' in a'@ relies on @*>@ being a tail call. When
+-- the monad is only known through a dictionary (a function polymorphic in
+-- @m@ that GHC did not specialise), @*>@ is whatever the instance defines.
+-- monad-logger's @LoggingT@ leaves it at the default @(id <$ a) <*> b@, and
+-- @ReaderT@ defines @>>@ as @*>@, so every iteration leaves an @<*>@
+-- continuation frame and two thunks behind for the lifetime of the loop.
+--
+-- This version sequences with @>>=@ only, which is a tail call in all these
+-- stacks, so it never accumulates.
+module Haskoin.Node.Loop (loopForever) where
+
+loopForever :: (Monad m) => m a -> m b
+loopForever action = go
+  where
+    go = action >>= \_ -> go
+{-# INLINE loopForever #-}
diff --git a/src/Haskoin/Node/Peer.hs b/src/Haskoin/Node/Peer.hs
--- a/src/Haskoin/Node/Peer.hs
+++ b/src/Haskoin/Node/Peer.hs
@@ -8,7 +8,6 @@
 {-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE NoFieldSelectors #-}
 
@@ -35,7 +34,6 @@
 import Conduit
 import Control.Exception
 import Control.Monad
-import Control.Monad.Logger
 import Control.Monad.Trans.Maybe
 import Data.Bool (bool)
 import Data.ByteString (ByteString)
@@ -48,6 +46,7 @@
 import Data.Text (Text)
 import Data.Word (Word32)
 import Haskoin
+import Haskoin.Node.Logger
 import NQE
 import System.Random
 import UnliftIO
@@ -63,7 +62,8 @@
   { pub :: !(Publisher PeerEvent),
     net :: !Network,
     label :: !Text,
-    connect :: !WithConnection
+    connect :: !WithConnection,
+    logger :: !Logger
   }
 
 data PeerEvent
@@ -106,17 +106,17 @@
 
 -- | Run peer process in current thread.
 peer ::
-  (MonadLoggerIO m, MonadUnliftIO m) =>
+  (MonadUnliftIO m) =>
   PeerConfig ->
   TVar Bool ->
   Inbox PeerMessage ->
   m ()
-peer cfg@PeerConfig {label, net, connect, pub} busy inbox = do
+peer cfg@PeerConfig {label, net, connect, pub, logger} busy inbox = do
   let p = wrapPeer cfg busy (inboxToMailbox inbox)
   withRunInIO $ \run -> connect (run . peer_session p)
   where
     go = do
-      $(logDebugS) "Peer " $ label <> " awaiting event..."
+      logDebug logger $ label <> " awaiting event..."
       msg <- receive inbox
       dispatchMessage cfg msg >>= bool (return ()) go
     peer_session p ad = do
@@ -135,51 +135,51 @@
 
 -- | Internal function to dispatch peer messages.
 dispatchMessage ::
-  (MonadLoggerIO m) =>
+  (MonadIO m) =>
   PeerConfig ->
   PeerMessage ->
   ConduitT i Message m Bool
-dispatchMessage PeerConfig {label} (SendMessage msg) = do
-  $(logDebugS) "Peer" (label <> " sending: " <> cs (show msg))
+dispatchMessage PeerConfig {label, logger} (SendMessage msg) = do
+  logDebug logger (label <> " sending: " <> cs (show msg))
   yield msg
   return True
-dispatchMessage PeerConfig {label} KillPeer = do
-  $(logInfoS) "Peer" (label <> " disconnecting")
+dispatchMessage PeerConfig {label, logger} KillPeer = do
+  logInfo logger (label <> " disconnecting")
   return False
 
 -- | Internal conduit to parse messages coming from peer.
 inPeerConduit ::
-  (MonadLoggerIO m) => PeerConfig -> ConduitT ByteString Message m ()
-inPeerConduit pc@PeerConfig {label, net} = forever $ do
-  $(logDebugS) "Peer" (label <> " awaiting message...")
+  (MonadIO m) => PeerConfig -> ConduitT ByteString Message m ()
+inPeerConduit pc@PeerConfig {label, net, logger} = forever $ do
+  logDebug logger (label <> " awaiting message...")
   x <- takeCE 24 .| foldC
   when (B.null x) $ do
-    $(logErrorS) "Peer" (label <> " sent empty message header")
+    logError logger (label <> " sent empty message header")
     error "Peer sent empty message header"
   case decode x of
     Left e -> do
-      $(logErrorS) "Peer" (label <> " sent invalid message header")
+      logError logger (label <> " sent invalid message header")
       error "Peer sent invalid message header"
     Right (MessageHeader _ cmd len _)
       | len > 32 * 2 ^ (20 :: Int) ->
-          $(logWarnS) "Peer" $
+          logWarn logger $
             label
               <> " wants to send "
               <> cs (show len)
               <> " bytes (too large) for cmd "
               <> cs (show cmd)
       | otherwise -> do
-          $(logDebugS) "Peer" (label <> " sent cmd " <> cs (show cmd))
+          logDebug logger (label <> " sent cmd " <> cs (show cmd))
           y <- takeCE (fromIntegral len) .| foldC
           case runGet (getMessage net) $ x `B.append` y of
             Left e -> do
-              $(logErrorS)
-                "Peer"
+              logError
+                logger
                 (label <> " sent invalid payload for cmd " <> cs (show cmd))
               error "Peer sent invalid payload"
             Right msg -> do
-              $(logDebugS)
-                "Peer"
+              logDebug
+                logger
                 (label <> " sent payload for cmd " <> cs (show cmd))
               yield msg
 
diff --git a/src/Haskoin/Node/PeerMgr.hs b/src/Haskoin/Node/PeerMgr.hs
--- a/src/Haskoin/Node/PeerMgr.hs
+++ b/src/Haskoin/Node/PeerMgr.hs
@@ -8,7 +8,6 @@
 {-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE NoFieldSelectors #-}
 
@@ -37,7 +36,6 @@
 import Control.Applicative ((<|>))
 import Control.Arrow
 import Control.Monad
-import Control.Monad.Logger
 import Data.Bits ((.&.))
 import Data.Function (on)
 import Data.List (dropWhileEnd, elemIndex, find, nub, sort)
@@ -49,6 +47,8 @@
 import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
 import Data.Word (Word32, Word64)
 import Haskoin
+import Haskoin.Node.Logger
+import Haskoin.Node.Loop (loopForever)
 import Haskoin.Node.Peer
 import NQE
 import Network.Socket
@@ -65,7 +65,8 @@
     pub :: !(Publisher PeerEvent),
     timeout :: !NominalDiffTime,
     maxPeerLife :: !NominalDiffTime,
-    connect :: !(SockAddr -> WithConnection)
+    connect :: !(SockAddr -> WithConnection),
+    logger :: !Logger
   }
 
 data PeerMgr = PeerMgr
@@ -114,7 +115,7 @@
       f OnlinePeer {pings = pings} = fromMaybe 60 (median pings)
 
 withPeerMgr ::
-  (MonadLoggerIO m, MonadUnliftIO m) =>
+  (MonadUnliftIO m) =>
   PeerMgrConfig ->
   (PeerMgr -> m a) ->
   m a
@@ -140,14 +141,14 @@
       withConnectLoop mgr (link a >> action mgr)
 
 peerManager ::
-  (MonadLoggerIO m, MonadUnliftIO m) => PeerMgr -> Inbox PeerMgrMessage -> m ()
+  (MonadUnliftIO m) => PeerMgr -> Inbox PeerMgrMessage -> m ()
 peerManager mgr ibx = do
-  $(logDebugS) "PeerMgr" "Getting best block..."
+  logDebug mgr.config.logger "Getting best block..."
   putBestBlock mgr <=< receiveMatch ibx $ \case
     ManagerBest b -> Just b
     _ -> Nothing
-  forever $ do
-    $(logDebugS) "PeerMgr" "Awaiting event..."
+  loopForever $ do
+    logDebug mgr.config.logger "Awaiting event..."
     dispatch mgr =<< receive ibx
 
 putBestBlock :: (MonadIO m) => PeerMgr -> BlockHeight -> m ()
@@ -177,12 +178,12 @@
         <$> mapM (liftIO . toSockAddr mgr.config.net) mgr.config.net.seeds
     mapM_ (newPeer mgr) ss
 
-logConnectedPeers :: (MonadLoggerIO m) => PeerMgr -> m ()
+logConnectedPeers :: (MonadIO m) => PeerMgr -> m ()
 logConnectedPeers mgr = do
   let m = mgr.config.maxPeers
   l <- length <$> getConnectedPeers mgr
-  $(logInfoS)
-    "PeerMgr"
+  logInfo
+    mgr.config.logger
     ("Peers connected: " <> cs (show l) <> "/" <> cs (show m))
 
 getOnlinePeers :: (MonadIO m) => PeerMgr -> m [OnlinePeer]
@@ -195,73 +196,73 @@
 managerEvent mgr e = publish e mgr.config.pub
 
 dispatch ::
-  (MonadLoggerIO m, MonadUnliftIO m) => PeerMgr -> PeerMgrMessage -> m ()
+  (MonadUnliftIO m) => PeerMgr -> PeerMgrMessage -> m ()
 dispatch mgr (PeerVersion p v) = do
-  $(logDebugS)
-    "PeerMgr"
+  logDebug
+    mgr.config.logger
     ("Received peer " <> p.label <> " version " <> cs (show v))
   let b = mgr.peers
   atomically (setPeerVersion b p v) >>= \case
     Just o -> do
       when o.online (announcePeer mgr p)
-      $(logDebugS)
-        "PeerMgr"
+      logDebug
+        mgr.config.logger
         ("Sending version ack to peer " <> p.label)
       MVerAck `sendMessage` p
     Nothing -> do
-      $(logWarnS)
-        "PeerMgr"
+      logWarn
+        mgr.config.logger
         ("Version rejected for peer " <> p.label)
       killPeer p
 dispatch mgr (PeerVerAck p) = do
   atomically (setPeerVerAck mgr.peers p) >>= \case
     Just o -> do
-      $(logDebugS) "PeerMgr" ("Received version ack from peer " <> p.label)
+      logDebug mgr.config.logger ("Received version ack from peer " <> p.label)
       when o.online (announcePeer mgr p)
     Nothing -> do
-      $(logWarnS)
-        "PeerMgr"
+      logWarn
+        mgr.config.logger
         ("Received verack from unknown peer " <> p.label)
       killPeer p
 dispatch mgr (PeerAddrs p nas)
   | mgr.config.discover = do
       let sas = map (hostToSockAddr . (.address)) nas
           len = length sas
-      $(logDebugS)
-        "PeerMgr"
+      logDebug
+        mgr.config.logger
         ("Received " <> cs (show len) <> " addresses from peer " <> p.label)
       forM_ sas (newPeer mgr)
   | otherwise =
-      $(logDebugS) "PeerMgr" ("Ignoring addresses from peer " <> p.label)
+      logDebug mgr.config.logger ("Ignoring addresses from peer " <> p.label)
 dispatch mgr (PeerPong p n) = do
-  $(logDebugS)
-    "PeerMgr"
+  logDebug
+    mgr.config.logger
     ("Received pong " <> cs (show n) <> " from peer " <> p.label)
   now <- liftIO getCurrentTime
   atomically (gotPong mgr.peers n now p)
-dispatch _mgr (PeerPing p n) = do
-  $(logDebugS)
-    "PeerMgr"
+dispatch mgr (PeerPing p n) = do
+  logDebug
+    mgr.config.logger
     ("Responding to ping " <> cs (show n) <> " from peer " <> p.label)
   MPong (Pong n) `sendMessage` p
 dispatch mgr (ManagerBest h) = do
-  $(logDebugS) "PeerMgr" ("Setting best block to " <> cs (show h))
+  logDebug mgr.config.logger ("Setting best block to " <> cs (show h))
   putBestBlock mgr h
 dispatch mgr (Connect sa) = do
   connectPeer mgr sa
 dispatch mgr (PeerDied a) = do
   processPeerOffline mgr a
 dispatch mgr (CheckPeer p) = do
-  $(logDebugS) "PeerMgr" ("Housekeeping for peer " <> p.label)
+  logDebug mgr.config.logger ("Housekeeping for peer " <> p.label)
   checkPeer mgr p
 
-ticklePeer :: (MonadLoggerIO m) => PeerMgr -> Peer -> m ()
-ticklePeer m p = do
-  $(logDebugS) "PeerMgr" ("Tickling peer " <> p.label)
+ticklePeer :: (MonadIO m) => PeerMgr -> Peer -> m ()
+ticklePeer mgr p = do
+  logDebug mgr.config.logger ("Tickling peer " <> p.label)
   t <- liftIO getCurrentTime
-  atomically (modifyPeer m.peers p (\o -> o {tickled = t}))
+  atomically (modifyPeer mgr.peers p (\o -> o {tickled = t}))
 
-checkPeer :: (MonadLoggerIO m) => PeerMgr -> Peer -> m ()
+checkPeer :: (MonadIO m) => PeerMgr -> Peer -> m ()
 checkPeer mgr p =
   atomically (mgr.peers `findPeer` p) >>= \case
     Just o -> do
@@ -270,64 +271,64 @@
       let deadline = mgr.config.timeout `addUTCTime` o.tickled
       if
         | now > expired -> do
-            $(logErrorS) "PeerMgr" ("Peer " <> p.label <> " is too old")
+            logError mgr.config.logger ("Peer " <> p.label <> " is too old")
             killPeer p
         | now > deadline -> do
-            $(logErrorS) "PeerMgr" ("Peer " <> p.label <> " timed out")
+            logError mgr.config.logger ("Peer " <> p.label <> " timed out")
             killPeer p
         | isNothing o.ping -> sendPing mgr p
         | otherwise -> return ()
     Nothing -> do
-      $(logErrorS) "PeerMgr" ("Peer " <> p.label <> " is offline")
+      logError mgr.config.logger ("Peer " <> p.label <> " is offline")
 
-sendPing :: (MonadLoggerIO m) => PeerMgr -> Peer -> m ()
+sendPing :: (MonadIO m) => PeerMgr -> Peer -> m ()
 sendPing mgr p = do
   atomically (mgr.peers `findPeer` p) >>= \case
     Nothing ->
-      $(logWarnS) "PeerMgr" ("Will not ping unknown peer " <> p.label)
+      logWarn mgr.config.logger ("Will not ping unknown peer " <> p.label)
     Just o
       | o.online -> do
           n <- randomIO
           now <- liftIO getCurrentTime
           atomically (setPeerPing mgr.peers n now p)
-          $(logDebugS)
-            "PeerMgr"
+          logDebug
+            mgr.config.logger
             ("Sending ping " <> cs (show n) <> " to peer " <> p.label)
           MPing (Ping n) `sendMessage` p
       | otherwise ->
-          $(logDebugS)
-            "PeerMgr"
+          logDebug
+            mgr.config.logger
             ("Will not ping offline peer " <> p.label)
 
-processPeerOffline :: (MonadLoggerIO m) => PeerMgr -> Child -> m ()
+processPeerOffline :: (MonadIO m) => PeerMgr -> Child -> m ()
 processPeerOffline mgr a = do
   atomically (findPeerAsync mgr.peers a) >>= \case
-    Nothing -> $(logErrorS) "PeerMgr" "Disconnected unknown peer"
+    Nothing -> logError mgr.config.logger "Disconnected unknown peer"
     Just o -> do
       if o.online
         then do
-          $(logErrorS)
-            "PeerMgr"
+          logError
+            mgr.config.logger
             ("Disconnected peer " <> o.mailbox.label)
           managerEvent mgr (PeerDisconnected o.mailbox)
         else
-          $(logErrorS)
-            "PeerMgr"
+          logError
+            mgr.config.logger
             ("Could not connect to peer " <> o.mailbox.label)
       atomically (removePeer mgr.peers o.mailbox)
       logConnectedPeers mgr
 
-announcePeer :: (MonadLoggerIO m) => PeerMgr -> Peer -> m ()
+announcePeer :: (MonadIO m) => PeerMgr -> Peer -> m ()
 announcePeer mgr p = do
   atomically (findPeer mgr.peers p) >>= \case
     Just OnlinePeer {online = True} -> do
-      $(logInfoS) "PeerMgr" ("Connected to peer " <> p.label)
+      logInfo mgr.config.logger ("Connected to peer " <> p.label)
       managerEvent mgr (PeerConnected p)
       logConnectedPeers mgr
     Just OnlinePeer {online = False} ->
       return ()
     Nothing ->
-      $(logWarnS) "PeerMgr" ("Not announcing disconnected peer " <> p.label)
+      logWarn mgr.config.logger ("Not announcing disconnected peer " <> p.label)
 
 getNewPeer :: (MonadIO m) => PeerMgr -> m (Maybe SockAddr)
 getNewPeer mgr =
@@ -341,13 +342,13 @@
           mgr.addresses
           (first (listToMaybe . Set.elems) . Set.splitAt 1)
 
-connectPeer :: (MonadUnliftIO m, MonadLoggerIO m) => PeerMgr -> SockAddr -> m ()
+connectPeer :: (MonadUnliftIO m) => PeerMgr -> SockAddr -> m ()
 connectPeer mgr sa = do
   atomically (findPeerAddress mgr.peers sa) >>= \case
     Just _ ->
-      $(logWarnS) "PeerMgr" ("Duplicate connection to peer " <> cs (show sa))
+      logWarn mgr.config.logger ("Duplicate connection to peer " <> cs (show sa))
     Nothing -> do
-      $(logInfoS) "PeerMgr" ("Connecting to peer " <> cs (show sa))
+      logInfo mgr.config.logger ("Connecting to peer " <> cs (show sa))
       nonce <- randomIO
       bb <- getBestBlock mgr
       now <- liftIO getCurrentTime
@@ -361,7 +362,8 @@
               { pub = mgr.config.pub,
                 net = mgr.config.net,
                 label = text,
-                connect = mgr.config.connect sa
+                connect = mgr.config.connect sa,
+                logger = withSource "Peer" mgr.config.logger
               }
       busy <- newTVarIO False
       let p = wrapPeer pc busy mailbox
@@ -393,7 +395,7 @@
 
 withPeerLoop :: (MonadUnliftIO m) => PeerMgr -> Peer -> (Async a -> m a) -> m a
 withPeerLoop mgr p =
-  withAsync . forever $ do
+  withAsync . loopForever $ do
     let timeout = mgr.config.timeout
         ms = floor (timeout * 1000 * 1000)
     r <- randomRIO (ms `div` 4, ms `div` 2)
@@ -404,19 +406,28 @@
 withConnectLoop mgr act =
   withAsync go $ \a -> link a >> act
   where
-    go = forever $ do
+    go = loopForever $ do
       l <- length <$> getOnlinePeers mgr
       when
         (l < mgr.config.maxPeers)
         (getNewPeer mgr >>= mapM_ (managerConnect mgr))
       threadDelay =<< randomRIO (10 ^ 5, 5 * 10 ^ 6)
 
+-- | Upper bound on addresses remembered for future connections. Peers keep
+-- relaying addresses for as long as the node runs, and with every connection
+-- slot in use nothing ever removes them, so the pool must be bounded.
+maxKnownAddresses :: Int
+maxKnownAddresses = 4096
+
 newPeer :: (MonadIO m) => PeerMgr -> SockAddr -> m ()
 newPeer mgr sa =
   atomically $
     findPeerAddress mgr.peers sa >>= \case
       Just _ -> return ()
-      Nothing -> modifyTVar mgr.addresses $ Set.insert sa
+      Nothing -> modifyTVar' mgr.addresses $ \known ->
+        if Set.size known >= maxKnownAddresses
+          then known
+          else Set.insert sa known
 
 gotPong :: TVar [OnlinePeer] -> Word64 -> UTCTime -> Peer -> STM ()
 gotPong b nonce now p =
diff --git a/test/Haskoin/NodeSpec.hs b/test/Haskoin/NodeSpec.hs
--- a/test/Haskoin/NodeSpec.hs
+++ b/test/Haskoin/NodeSpec.hs
@@ -13,7 +13,6 @@
 import Conduit
 import Control.Monad (forM_, forever, replicateM)
 import Control.Monad.Cont
-import Control.Monad.Logger
 import Control.Monad.Trans (lift)
 import Data.ByteString (ByteString)
 import Data.ByteString qualified as B
@@ -189,7 +188,7 @@
 withTestNode ::
   (MonadUnliftIO m) =>
   Network -> String -> (TestNode -> m a) -> m a
-withTestNode net str f = runNoLoggingT $ flip runContT return $ do
+withTestNode net str f = flip runContT return $ do
   w <- ContT $ withSystemTempDirectory ("haskoin-node-test-" <> str <> "-")
   pub <- ContT withPublisher
   sub <- ContT $ withSubscription pub
@@ -214,10 +213,11 @@
             pub = pub,
             timeout = 120,
             maxPeerLife = 48 * 3600,
-            connect = dummyPeerConnect net ad
+            connect = dummyPeerConnect net ad,
+            logger = Logger {level = LevelError, source = "", push = \_ -> return ()}
           }
   Node mgr ch <- ContT $ withNode cfg'
-  lift . lift $
+  lift $
     f
       TestNode
         { testMgr = mgr,