diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,12 @@
 # Revision history for erebos
 
+## 0.2.4 -- 2026-10-15
+
+* Added `--command` command-line option to run initial commands after starting the server.
+* Discovery is now working also on localhost without the need for external interface.
+* Fixed tunnel offer for peers without inet addresses.
+* Fixed status indicator for new messages not being updated in some situations.
+
 ## 0.2.3 -- 2026-08-19
 
 * Discovery service handles situation when search target joins later.
diff --git a/erebos.cabal b/erebos.cabal
--- a/erebos.cabal
+++ b/erebos.cabal
@@ -1,7 +1,7 @@
 Cabal-Version:       3.0
 
 Name:                erebos
-Version:             0.2.3
+Version:             0.2.4
 Synopsis:            Decentralized messaging and synchronization
 Description:
     Library and simple CLI interface implementing the Erebos identity
@@ -53,6 +53,7 @@
 
     default-extensions:
         DefaultSignatures
+        DataKinds
         ExistentialQuantification
         FlexibleContexts
         FlexibleInstances
@@ -205,6 +206,7 @@
         Terminal
         Test
         Test.Service
+        Test.State
         Version
         Version.Git
         WebSocket
diff --git a/main/Main.hs b/main/Main.hs
--- a/main/Main.hs
+++ b/main/Main.hs
@@ -64,9 +64,10 @@
 
 data Options = Options
     { optServer :: ServerOptions
-    , optServices :: [ServiceOption]
+    , optServices :: [ ServiceOption ]
     , optStorage :: StorageOption
     , optCreateIdentity :: Maybe ( Maybe Text, [ Maybe Text ] )
+    , optCommands :: [ Text ]
     , optChatroomAutoSubscribe :: Maybe Int
     , optDmBotEcho :: Maybe Text
     , optWebSocketServer :: Maybe Int
@@ -93,6 +94,7 @@
     , optServices = availableServices
     , optStorage = DefaultStorage
     , optCreateIdentity = Nothing
+    , optCommands = []
     , optChatroomAutoSubscribe = Nothing
     , optDmBotEcho = Nothing
     , optWebSocketServer = Nothing
@@ -147,6 +149,9 @@
                  in maybe (Just ( Nothing, [ ownerName ] )) (Just . second (ownerName :)) (optCreateIdentity opts)
             }) "<name>")
         "create owner for a new device identity"
+    , Option [ 'c' ] [ "command" ]
+        (ReqArg (\value -> \opts -> return opts { optCommands = optCommands opts ++ [ T.pack value ] }) "<command>")
+        "run given <command> after starting the server"
     , Option [] [ "chatroom-auto-subscribe" ]
         (ReqArg (\count -> \opts -> return opts { optChatroomAutoSubscribe = Just (read count) }) "<count>")
         "automatically subscribe for up to <count> chatrooms"
@@ -396,21 +401,20 @@
                     | tui       -> KeepPrompt mzero
                     | otherwise -> KeepPrompt $ liftIO $ forever $ threadDelay 100000000
 
-        getInputCommandTui cstate = do
-            let parseCommand cmdline =
-                    case dropWhile isSpace <$> span (\c -> isAlphaNum c || c == '-') cmdline of
-                        ( scmd, args )
-                            | not (null scmd) && all isDigit scmd
-                            -> ( cmdSelectContext, scmd )
+        parseCommand cmdline =
+            case dropWhile isSpace <$> span (\c -> isAlphaNum c || c == '-') cmdline of
+                ( scmd, args )
+                    | not (null scmd) && all isDigit scmd
+                    -> ( cmdSelectContext, scmd )
 
-                            | otherwise
-                            -> ( fromMaybe (cmdUnknown scmd) $ lookup scmd commands, args )
+                    | otherwise
+                    -> ( fromMaybe (cmdUnknown scmd) $ lookup scmd commands, args )
 
-            ( CommandM cmd, line ) <- getInputLinesTui cstate >>= return . \case
+        getInputCommandTui cstate = do
+            getInputLinesTui cstate >>= return . \case
                 '/' : input     -> parseCommand input
                 input | not tui -> parseCommand input
                 input           -> ( cmdSend, input )
-            return ( cmd, line )
 
     let getInputCommand = getInputCommandTui . Left
 
@@ -449,7 +453,7 @@
 
                 case optDmBotEcho opts of
                     Just prefix
-                        | not (msgFrom msg `sameIdentity` self)
+                        | new && not (msgFrom msg `sameIdentity` self)
                         -> do
                             void $ forkIO $ do
                                 res <- runExceptT $ flip runReaderT erebosHead $ sendDirectMessage (msgFrom msg) (prefix <> msgText msg)
@@ -515,9 +519,8 @@
                     cur -> return cur
             _ -> return ()
 
-    let process :: CommandState -> MaybeT IO CommandState
-        process cstate = do
-            (cmd, line) <- getInputCommand cstate
+    let process :: CommandState -> ( Command, String ) -> MaybeT IO CommandState
+        process cstate ( CommandM cmd, line ) = do
             h <- liftIO (reloadHead $ csHead cstate) >>= \case
                 Just h  -> return h
                 Nothing -> do lift $ extPrintLn "current head deleted"
@@ -548,9 +551,12 @@
                     lift $ extPrintLn $ withStyle (setForegroundColor BrightRed noStyle) $ plainText $ T.pack $ "Error: " ++ showErebosError err
                     return cstate
 
-    let loop (Just cstate) = runMaybeT (process cstate) >>= loop
-        loop Nothing = return ()
-    loop $ Just $ CommandState
+    let loop [] (Just cstate) = do
+            loop [] =<< runMaybeT (process cstate =<< getInputCommand cstate)
+        loop (c : cs) (Just cstate) = do
+            loop cs =<< runMaybeT (process cstate $ parseCommand $ T.unpack c)
+        loop _ Nothing = return ()
+    loop (optCommands opts) $ Just $ CommandState
         { csHead = erebosHead
         , csContext = NoContext
         , csWatchChatrooms = watched
@@ -770,17 +776,25 @@
     forM_ (zip [1..] peers) $ \(i :: Int, (_, name)) -> do
         printSelectOption i $ plainText name
 
+peerAddressFromText :: (MonadIO m, MonadError ErebosError m) => Text -> m SockAddr
+peerAddressFromText taddr = do
+    ( hostname, port ) <- case words (T.unpack taddr) of
+        hostname : p : _ -> return ( hostname, p )
+        [ single ]
+            | all isDigit single -> return ( "localhost", single )
+            | otherwise -> return ( single, show discoveryPort )
+        [] -> throwOtherError "missing peer address"
+    liftIO (getAddrInfo (Just $ defaultHints { addrSocketType = Datagram }) (Just hostname) (Just port)) >>= \case
+        addr : _ -> return (addrAddress addr)
+        [] -> throwOtherError "address not found"
+
 cmdPeerAdd :: Command
 cmdPeerAdd = void $ do
     server <- asks ciServer
-    (hostname, port) <- (words <$> asks ciLine) >>= \case
-        hostname:p:_ -> return (hostname, p)
-        [hostname] -> return (hostname, show discoveryPort)
-        [] -> throwOtherError "missing peer address"
-    addr:_ <- liftIO $ getAddrInfo (Just $ defaultHints { addrSocketType = Datagram }) (Just hostname) (Just port)
+    addr <- peerAddressFromText . T.pack =<< asks ciLine
     contextOptsVar <- asks ciContextOptionsVar
     liftIO $ modifyMVar_ contextOptsVar $ return . first (const $ Just WatchPeers)
-    liftIO $ serverPeer server (addrAddress addr)
+    liftIO $ serverPeer server addr
 
 cmdPeerAddPublic :: Command
 cmdPeerAddPublic = do
diff --git a/main/Test.hs b/main/Test.hs
--- a/main/Test.hs
+++ b/main/Test.hs
@@ -19,6 +19,7 @@
 import Data.ByteString.Char8 qualified as BC
 import Data.ByteString.Lazy qualified as BL
 import Data.ByteString.Lazy.Char8 qualified as BL
+import Data.Char
 import Data.Foldable
 import Data.Ord
 import Data.Text (Text)
@@ -28,6 +29,8 @@
 import Data.Typeable
 import Data.UUID.Types qualified as U
 
+import GHC.TypeLits
+
 import Network.Socket
 
 import System.IO
@@ -57,6 +60,7 @@
 import Erebos.Sync
 
 import Test.Service
+import Test.State
 
 
 data TestState = TestState
@@ -238,6 +242,20 @@
     { discoveryProvideTunnel = \_ _ -> False
     }
 
+discoveryTracer :: Output -> Peer -> PeerAddress -> Stored DiscoveryService -> IO ()
+discoveryTracer out _ paddr spacket = case fromStored spacket of
+    DiscoverySearch dgst -> do
+        outLine out $ "discovery-packet " <> show paddr <> " search " <> show (either refDigest id dgst)
+    DiscoveryResult dgst results via -> do
+        outLine out $ "discovery-packet " <> show paddr <> " result " <> show (either refDigest id dgst)
+        forM_ results $ \addr -> do
+            outLine out $ "discovery-packet-result result " <> T.unpack (toText addr)
+        forM_ via $ \DiscoveryVia {..} -> do
+            forM_ viaAddress $ \addr -> do
+                outLine out $ "discovery-packet-result via " <> show viaIdentity <> " addr " <> T.unpack (toText addr)
+        outLine out $ "discovery-packet-result done"
+    _ -> return ()
+
 inviteAttributes :: Output -> InviteServiceAttributes
 inviteAttributes out = (defaultServiceAttributes Proxy)
     { inviteHookAccepted = \Invite {..} -> do
@@ -320,6 +338,7 @@
     , ( "peer-add", cmdPeerAdd )
     , ( "peer-drop", cmdPeerDrop )
     , ( "peer-list", cmdPeerList )
+    , ( "peer-get-by-addr", cmdPeerGetByAddr )
     , ( "test-message-send", cmdTestMessageSend )
     , ( "test-stream-open", cmdTestStreamOpen )
     , ( "test-stream-close", cmdTestStreamClose )
@@ -329,6 +348,8 @@
     , ( "local-state-wait", cmdLocalStateWait )
     , ( "shared-state-get", cmdSharedStateGet )
     , ( "shared-state-wait", cmdSharedStateWait )
+    , ( "shared-state-val-get", cmdSharedStateValGet )
+    , ( "shared-state-val-set", cmdSharedStateValSet )
     , ( "watch-local-identity", cmdWatchLocalIdentity )
     , ( "watch-shared-identity", cmdWatchSharedIdentity )
     , ( "update-local-identity", cmdUpdateLocalIdentity )
@@ -600,7 +621,11 @@
             , lsOther = []
             }
     initTestHead h
-    cmdOut $ unwords [ "create-identity-done", "ref", show $ refDigest $ storedRef $ lsIdentity $ headObject h ]
+    cmdOut $ unwords
+        [ "create-identity-done"
+        , "ref", show $ refDigest $ storedRef $ eiddStoredBase $ lsIdentity $ headObject h
+        , "extref", show $ refDigest $ storedRef $ lsIdentity $ headObject h
+        ]
 
 cmdIdentityInfo :: Command
 cmdIdentityInfo = do
@@ -644,7 +669,11 @@
         ( "chatroom", _ ) -> return $ someService @ChatroomService Proxy
         ( "contact", _ ) -> return $ someServiceAttr $ pairingAttributes (Proxy @ContactService) out rsPeers "contact"
         ( "discovery", params ) -> return $ someServiceAttr $ discoveryAttributes
-            { discoveryProvideTunnel = \_ _ -> "tunnel" `elem` params
+            { discoveryProvideTunnel
+                = \_ paddr -> or
+                    [ "tunnel" `elem` params
+                    , ("tunnel-" <> T.pack (takeWhile (not . isSpace) $ show paddr)) `elem` params
+                    ]
             }
         ( "dm", _ ) -> return $ someServiceAttr $ directMessageAttributes out
         ( "invite", _ ) -> return $ someServiceAttr $ inviteAttributes out
@@ -674,9 +703,17 @@
             }
         ( sname, _ ) -> throwOtherError $ "unknown service `" <> T.unpack sname <> "'"
 
+    serviceTracers <- forM (map fst $ filter (("trace" `elem`) . snd) serviceNames) $ \case
+        "discovery" -> return $ servicePacketTracer $ discoveryTracer out
+        sname -> throwOtherError $ "tracer not implemented for ‘" <> T.unpack sname <> "’"
+
+    let serverOptions' = serverOptions
+            { serverServicePacketTracers = serviceTracers
+            }
+
     let logPrint str = do BC.hPutStrLn stdout (BC.pack str)
                           hFlush stdout
-    rsServer <- liftIO $ startServer serverOptions h logPrint services
+    rsServer <- liftIO $ startServer serverOptions' h logPrint services
 
     rsPeerThread <- liftIO $ forkIO $ void $ forever $ do
         peer <- getNextPeerChange rsServer
@@ -705,6 +742,7 @@
         modifyMVar_ rsPeers update
 
     modify $ \s -> s { tsServer = Just RunningServer {..} }
+    cmdOut "start-server-done"
 
 cmdStopServer :: Command
 cmdStopServer = do
@@ -748,7 +786,17 @@
             ]
     cmdOut "peer-list-done"
 
+cmdPeerGetByAddr :: Command
+cmdPeerGetByAddr = do
+    Just RunningServer {..} <- gets tsServer
+    addr <- T.unwords <$> asks tiParams
+    ( _, peers ) <- liftIO $ readMVar rsPeers
+    forM_ peers $ \tpeer -> do
+        paddr <- getPeerAddress $ tpPeer tpeer
+        when (T.pack (show paddr) == addr) $ do
+            cmdOut $ "peer-get-by-addr " <> show (tpIndex tpeer)
 
+
 cmdTestMessageSend :: Command
 cmdTestMessageSend = do
     spidx : trefs <- asks tiParams
@@ -838,6 +886,25 @@
 cmdSharedStateWait :: Command
 cmdSharedStateWait = localStateWaitHelper "shared-state-wait" (lsShared . headObject)
 
+cmdSharedStateValGet :: Command
+cmdSharedStateValGet = do
+    [ stid ] <- asks tiParams
+    h <- getOrLoadHead
+    case someSymbolVal $ T.unpack stid of
+        SomeSymbol (_ :: Proxy tid) -> do
+            let value = lookupSharedValueH @(CustomSharedState tid) h
+            cmdOut $ unwords $ "shared-state-val-get" : T.unpack stid : map (BC.unpack . showRef . storedRef) (customStateComponents value)
+
+cmdSharedStateValSet :: Command
+cmdSharedStateValSet = do
+    stid : trefs <- asks tiParams
+    st <- asks tiStorage
+    Just refs <- liftIO $ fmap sequence $ mapM (readRef st . encodeUtf8) trefs
+    case someSymbolVal $ T.unpack stid of
+        SomeSymbol (_ :: Proxy tid) -> do
+            updateLocalState_ $ updateSharedState_ $ \_ -> do
+                return $ CustomSharedState @tid $ map wrappedLoad refs
+
 cmdWatchLocalIdentity :: Command
 cmdWatchLocalIdentity = do
     h <- getOrLoadHead
@@ -845,7 +912,7 @@
 
     out <- asks tiOutput
     w <- liftIO $ watchHeadWith h headLocalIdentity $ \idt -> do
-        outLine out $ unwords $ "local-identity" : map (maybe "<unnamed>" T.unpack . idName) (unfoldOwners idt)
+        outLine out $ unwords $ "local-identity" : show (refDigest $ storedRef $ idExtData idt) : map (maybe "<unnamed>" T.unpack . idName) (unfoldOwners idt)
     modify $ \s -> s { tsWatchedLocalIdentity = Just w }
 
 cmdWatchSharedIdentity :: Command
diff --git a/main/Test/State.hs b/main/Test/State.hs
new file mode 100644
--- /dev/null
+++ b/main/Test/State.hs
@@ -0,0 +1,24 @@
+module Test.State (
+    CustomSharedState(..),
+) where
+
+import Data.Proxy
+
+import GHC.TypeLits
+
+import Erebos.Object
+import Erebos.State
+import Erebos.Storage.Merge
+
+
+data CustomSharedState (tid :: Symbol) = CustomSharedState
+    { customStateComponents :: StoredTips Object
+    }
+
+instance Mergeable (CustomSharedState tid) where
+    type Component (CustomSharedState tid) = Object
+    toComponents = customStateComponents
+    mergeSorted = CustomSharedState
+
+instance KnownSymbol tid => SharedType (CustomSharedState tid) where
+    sharedTypeID _ = mkSharedTypeID (symbolVal @tid Proxy)
diff --git a/src/Erebos/Discovery.hs b/src/Erebos/Discovery.hs
--- a/src/Erebos/Discovery.hs
+++ b/src/Erebos/Discovery.hs
@@ -3,6 +3,7 @@
 
 module Erebos.Discovery (
     DiscoveryService(..),
+    DiscoveryAddress, DiscoveryVia(..),
     DiscoveryAttributes(..),
     DiscoveryConnection(..),
 
@@ -59,7 +60,8 @@
     | DiscoveryConnectionResponse DiscoveryConnection
 
 data DiscoveryAddress
-    = DiscoveryIP InetAddress PortNumber
+    = DiscoveryLocalhost PortNumber
+    | DiscoveryIP InetAddress PortNumber
     | DiscoveryICE
     | DiscoveryTunnel
     | DiscoveryOther Text
@@ -184,6 +186,7 @@
 
 instance StorableText DiscoveryAddress where
     toText = \case
+        DiscoveryLocalhost port -> T.unwords [ "localhost", T.pack $ show port ]
         DiscoveryIP addr port -> T.unwords [ T.pack $ show addr, T.pack $ show port ]
         DiscoveryICE -> "ICE"
         DiscoveryTunnel -> "tunnel"
@@ -191,6 +194,11 @@
 
     fromText str = return $ if
         | [ addrStr, portStr ] <- T.words str
+        , addrStr == "localhost"
+        , Just port <- readMaybe $ T.unpack portStr
+        -> DiscoveryLocalhost port
+
+        | [ addrStr, portStr ] <- T.words str
         , Just addr <- readMaybe $ T.unpack addrStr
         , Just port <- readMaybe $ T.unpack portStr
         -> DiscoveryIP addr port
@@ -218,6 +226,7 @@
     { dpPriority :: Int
     , dpPeer :: Maybe Peer
     , dpAddress :: [ DiscoveryAddress ]
+    , dpLocalhost :: Maybe PortNumber
     , dpIceSession :: Maybe IceSession
     }
 
@@ -226,20 +235,21 @@
     { dpPriority = 0
     , dpPeer = Nothing
     , dpAddress = []
+    , dpLocalhost = Nothing
     , dpIceSession = Nothing
     }
 
 viaFromPeer :: DiscoveryAttributes -> Peer -> DiscoveryPeer -> IO (Maybe DiscoveryVia)
 viaFromPeer attrs peer DiscoveryPeer {..}
     | Just dpeer <- dpPeer
-    , _ : _ <- dpAddress
     = do
         getPeerIdentity dpeer >>= \case
             PeerIdentityFull pid -> do
                 offerTunnel <- offerTunnelBetween attrs peer dpeer
                 let viaAddress = (if offerTunnel then (++ [ DiscoveryTunnel ]) else id) dpAddress
                 let viaIdentity = refDigest $ storedRef $ idData pid
-                return $ Just DiscoveryVia {..}
+                return $ if null viaAddress then Nothing
+                                            else Just DiscoveryVia {..}
             _ -> return Nothing
     | otherwise
     = return Nothing
@@ -313,24 +323,28 @@
             peer <- asks svcPeer
             paddrs <- getPeerAddresses peer
 
+            let matchedAddrs = flip filter addrs $ \case
+                    DiscoveryICE -> True
+                    DiscoveryIP ipaddr port ->
+                        DatagramAddress (inetToSockAddr ( ipaddr, port )) `elem` paddrs
+                    _ -> False
+                localhostPort = getLocalhostPortFromPeerAddresses paddrs
+
             debugLog $ unwords
                 [ "new peer"
                 , show [ refDigest $ storedRef $ idData pid, refDigest $ storedRef $ idExtData pid ]
                 , show $ map (refDigest . storedRef) $ idDataF $ finalOwner pid
                 , show paddrs
+                , show (map toText matchedAddrs)
+                , show localhostPort
                 ]
 
-            let matchedAddrs = flip filter addrs $ \case
-                    DiscoveryICE -> True
-                    DiscoveryIP ipaddr port ->
-                        DatagramAddress (inetToSockAddr ( ipaddr, port )) `elem` paddrs
-                    _ -> False
-
             forM_ (idDataF =<< unfoldOwners pid) $ \sdata -> do
                 let dp = DiscoveryPeer
                         { dpPriority = fromMaybe 0 priority
                         , dpPeer = Just peer
                         , dpAddress = matchedAddrs
+                        , dpLocalhost = localhostPort
                         , dpIceSession = Nothing
                         }
                     rv = ResultValue
@@ -359,10 +373,19 @@
                             st <- getStorage
                             forM_ dgsts $ \dgst -> do
                                 when (dgst `M.member` peerSearchingFor) $ do
-                                    offerTunnel <- offerTunnelBetween attrs peer sp >>= return . \case
-                                        True  -> (++ [ DiscoveryTunnel ])
-                                        False -> id
-                                    let discoveryAddrs = offerTunnel matchedAddrs
+                                    discoveryAddrs <- concat <$> sequence
+                                        [ case localhostPort of
+                                              Just port -> getPeerAddresses sp >>= \case
+                                                  spaddrs
+                                                      | isJust $ getLocalhostPortFromPeerAddresses spaddrs
+                                                      -> return [ DiscoveryLocalhost port ]
+                                                  _ -> return []
+                                              _ -> return []
+                                        , return matchedAddrs
+                                        , offerTunnelBetween attrs peer sp >>= return . \case
+                                            True  -> [ DiscoveryTunnel ]
+                                            False -> []
+                                        ]
                                     let ( results, via )
                                             | dgst == (refDigest $ storedRef $ idData pid)
                                             = ( discoveryAddrs, [] )
@@ -402,6 +425,7 @@
             let dgst = either refDigest id edgst
             peer <- asks svcPeer
             pid <- asks svcPeerIdentity
+            paddrs <- getPeerAddresses peer
             (M.lookup dgst . dgsPeers <$> svcGetGlobal) >>= \case
                 Just rv
                   | direct <- (\p -> Just p <* guard (p /= peer)) =<< dpPeer =<< rvDirect rv
@@ -411,14 +435,19 @@
                   , isJust direct || not (null rvia)
                   -> do
                     attrs <- asks svcAttributes
-                    offerTunnel <- case direct of
-                        Just dpeer -> offerTunnelBetween attrs peer dpeer >>= return . \case
-                            True  -> (++ [ DiscoveryTunnel ])
-                            False -> id
-                        Nothing -> return id
-                    let results
-                            | isJust direct = offerTunnel $ maybe [] dpAddress $ rvDirect rv
-                            | otherwise = []
+                    results <- if
+                        | isJust direct -> concat <$> sequence
+                            [ case ( dpLocalhost =<< rvDirect rv, getLocalhostPortFromPeerAddresses paddrs ) of
+                                ( Just port, Just _ ) -> return [ DiscoveryLocalhost port ]
+                                _ -> return []
+                            , return $ maybe [] dpAddress $ rvDirect rv
+                            , case direct of
+                                Just dpeer -> offerTunnelBetween attrs peer dpeer >>= return . \case
+                                    True  -> [ DiscoveryTunnel ]
+                                    False -> []
+                                Nothing -> return []
+                            ]
+                        | otherwise -> return []
                     via <- liftIO $ fmap catMaybes $ mapM (viaFromPeer attrs peer) rvia
                     replyPacket $ DiscoveryResult edgst results via
                     debugLog $ "search by " <> show (refDigest $ storedRef $ idData pid) <>
@@ -463,6 +492,14 @@
             let runAsService = runPeerService @DiscoveryService @IO discoveryPeer
 
             let tryAddresses = \case
+                    DiscoveryLocalhost port : _ -> do
+                        void $ liftIO $ forkIO $ do
+                            let saddr = makeLocalhostAddress port
+                            peer <- serverPeer server saddr
+                            runAsService $ do
+                                let upd rv = rv { rvDirect = Just $ (fromMaybe emptyPeer $ rvDirect rv) { dpPeer = Just peer } }
+                                svcModifyGlobal $ \s -> s { dgsPeers = M.alter (Just . upd . fromMaybe mempty) dgst $ dgsPeers s }
+
                     DiscoveryIP ipaddr port : _ -> do
                         void $ liftIO $ forkIO $ do
                             let saddr = inetToSockAddr ( ipaddr, port )
@@ -785,16 +822,16 @@
             Just (UnhandledService svc) | svc == serviceID (Proxy @DiscoveryService) -> return ()
             _ -> throwError e) $ do
         peers <- liftIO $ getCurrentPeerList server
-        match <- forM peers $ \peer -> do
+        peersFull <- fmap catMaybes $ forM peers $ \peer -> do
             getPeerIdentity peer >>= \case
-                PeerIdentityFull pid -> do
-                    return $ dgst `elem` identityDigests pid
-                _ -> return False
-        when (not $ or match) $ do
+                PeerIdentityFull pid -> return $ Just ( peer, pid )
+                _ -> return Nothing
+        let match = any ((dgst `elem`) . identityDigests . snd) peersFull
+        when (not match) $ do
             _ <- modifyServiceGlobalState server (Proxy @DiscoveryService) $ \s ->
                 ( s { dgsSearchingFor =  S.insert dgst $ dgsSearchingFor s }, () )
             now <- liftIO $ getTime Monotonic
-            forM_ peers $ \peer -> do
+            forM_ peersFull $ \( peer, _ ) -> do
                 runPeerService peer $ do
                     weAskedFor <- dpsWeAskedFor <$> svcGet
                     when (not $ M.member dgst weAskedFor) $ do
@@ -882,3 +919,6 @@
             (emptyConnection (Right self) (Right target))
             { dconnTunnel = True
             }
+
+getLocalhostPortFromPeerAddresses :: [ PeerAddress ] -> Maybe PortNumber
+getLocalhostPortFromPeerAddresses = msum . map (\case DatagramAddress a -> getLocalhostPort a; _ -> Nothing)
diff --git a/src/Erebos/Network.hs b/src/Erebos/Network.hs
--- a/src/Erebos/Network.hs
+++ b/src/Erebos/Network.hs
@@ -7,6 +7,7 @@
     getNextPeerChangeChan,
     getServerAddresses,
     ServerOptions(..), serverIdentity, defaultServerOptions,
+    ServicePacketTracer, servicePacketTracer,
 
     Peer, peerServer, peerStorage,
     PeerAddress(..), getPeerAddress, getPeerAddresses,
@@ -131,6 +132,7 @@
     , serverLocalDiscovery :: Bool
     , serverErrorPrefix :: String
     , serverTestLog :: Bool
+    , serverServicePacketTracers :: [ ServicePacketTracer ]
     }
 
 defaultServerOptions :: ServerOptions
@@ -140,9 +142,15 @@
     , serverLocalDiscovery = True
     , serverErrorPrefix = ""
     , serverTestLog = False
+    , serverServicePacketTracers = []
     }
 
+data ServicePacketTracer = forall s. Service s => ServicePacketTracer (Peer -> PeerAddress -> Stored s -> IO ())
 
+servicePacketTracer :: forall s. Service s => (Peer -> PeerAddress -> Stored s -> IO ()) -> ServicePacketTracer
+servicePacketTracer = ServicePacketTracer
+
+
 data Peer = Peer
     { peerAddress :: PeerAddress
     , peerServer_ :: Server
@@ -441,16 +449,16 @@
 
             erebosNetworkProtocol (headLocalIdentity serverOrigHead) logd logt protocolRawPath protocolControlFlow
 
-    forkServerThread server "main-loop" $ withSocketsDo $ do
+    withSocketsDo $ do
         let hints = defaultHints
-              { addrFlags = [AI_PASSIVE]
+              { addrFlags = [ AI_PASSIVE ]
               , addrFamily = AF_INET6
               , addrSocketType = Datagram
               }
         addr:_ <- getAddrInfo (Just hints) Nothing (Just $ show $ serverPort serverOptions)
         let open = socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
             closeAndNotify sock = close sock >> putMVar serverSocketClosed ()
-        bracket open closeAndNotify $ \sock -> do
+        bracketOnError open closeAndNotify $ \sock -> do
             withFdSocket sock setCloseOnExecIfNeeded
             setSocketOption sock Broadcast 1
             bind sock (addrAddress addr) `catchIOError` \e -> if
@@ -462,12 +470,18 @@
                       bind sock (SockAddrInet6 0 f h s)
                 | otherwise -> ioError e
             putMVar serverSocket sock
-            loop sock
+            forkServerThread server "main-loop" $ do
+                loop sock `finally` closeAndNotify sock
 
     forkServerThread server "service-handler" $ forever $ do
         ( peer, paddr, svc, ref, streams ) <- atomically $ readTQueue chanSvc
         case find ((svc ==) . someServiceID) serverServices of
-            Just service@(SomeService (_ :: Proxy s) attr) -> runPeerServiceOn (Just ( service, attr )) streams paddr peer (serviceHandler $ wrappedLoad @s ref)
+            Just service@(SomeService (_ :: Proxy s) attr) -> do
+                let packet = wrappedLoad @s ref
+                forM_ (serverServicePacketTracers serverOptions) $ \case
+                    ServicePacketTracer t | Just (t' :: Peer -> PeerAddress -> Stored s -> IO ()) <- cast t -> t' peer paddr packet
+                    _ -> return ()
+                runPeerServiceOn (Just ( service, attr )) streams paddr peer (serviceHandler packet)
             _ -> atomically $ logd $ "unhandled service '" ++ show (toUUID svc) ++ "'"
 
     return server
@@ -1102,7 +1116,7 @@
                                             putTMVar (serverServiceStates server) $ M.insert svc (SomeServiceGlobalState proxy gs') global
                                         return h'
                 _ -> do
-                    atomically $ logd $ "can't run service handler on peer with incomplete identity " ++ show paddr
+                    atomically $ logd $ "can't run service " <> show (toUUID svc) <> " handler on peer with incomplete identity " ++ show paddr
 
         _ -> atomically $ do
             logd $ "unhandled service '" ++ show (toUUID svc) ++ "'"
diff --git a/src/Erebos/Network/Address.hs b/src/Erebos/Network/Address.hs
--- a/src/Erebos/Network/Address.hs
+++ b/src/Erebos/Network/Address.hs
@@ -2,6 +2,8 @@
     InetAddress(..),
     inetFromSockAddr,
     inetToSockAddr,
+    makeLocalhostAddress,
+    getLocalhostPort,
 
     SockAddr, PortNumber,
 ) where
@@ -63,3 +65,11 @@
 
 inetToSockAddr :: ( InetAddress, PortNumber ) -> SockAddr
 inetToSockAddr = IP.toSockAddr . first fromInetAddress
+
+
+makeLocalhostAddress :: PortNumber -> SockAddr
+makeLocalhostAddress port = SockAddrInet6 port 0 ( 0, 0, 0, 1 ) 0
+
+getLocalhostPort :: SockAddr -> Maybe PortNumber
+getLocalhostPort (SockAddrInet6 port _ ( 0, 0, 0, 1 ) _) = Just port
+getLocalhostPort _                                       = Nothing
diff --git a/src/Erebos/State.hs b/src/Erebos/State.hs
--- a/src/Erebos/State.hs
+++ b/src/Erebos/State.hs
@@ -126,7 +126,10 @@
     updateLocalHead f = do
         h <- ask
         snd <$> updateHead' h (\h' -> local (const h') (f $ headStoredObject h'))
-    getLocalHeadCache _ = asks headCache
+
+    getLocalHeadCache _ = do
+        h <- ask
+        snd <$> updateHead' h (\h' -> return ( headStoredObject h', headCache h' ))
 
 
 newtype LocalHeadT h m a = LocalHeadT { runLocalHeadT_ :: Storage -> ( Stored h, HeadCacheType h ) -> m ( a, ( Stored h, HeadCacheType h ) ) }
diff --git a/src/Erebos/Storage/Graph.hs b/src/Erebos/Storage/Graph.hs
--- a/src/Erebos/Storage/Graph.hs
+++ b/src/Erebos/Storage/Graph.hs
@@ -127,12 +127,17 @@
 filterAncestors :: Storable a => [ Stored a ] -> StoredTips a
 filterAncestors [ x ] = [ x ]
 filterAncestors xs = let xs' = uniq $ sort xs
-                      in helper xs' xs'
-    where helper remains walk = case generationMax walk of
-                                     Just x -> let px = previous x
-                                                   remains' = filter (\r -> all (/=r) px) remains
-                                                in helper remains' $ uniq $ sort (px ++ filter (/=x) walk)
-                                     Nothing -> remains
+                      in sort $ helper xs' xs'
+  where
+    helper [] _ = []
+    helper remains walk =
+        case generationMax walk of
+            Just x ->
+                let px = previous x
+                    youngerThenX r = Just GT == compareGeneration (storedGeneration r) (storedGeneration x)
+                    ( returned, remains' ) = partition youngerThenX $ filter (\r -> all (/= r) px) remains
+                 in returned ++ helper remains' (uniq $ sort (px ++ filter (/= x) walk))
+            Nothing -> remains
 
 commonAncestors :: Storable a => [ Stored a ] -> [ Stored a ] -> StoredTips a
 commonAncestors [] _ = []