diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,11 @@
 # Revision history for erebos
 
+## 0.1.5 -- 2024-07-16
+
+* Public chatrooms for multiple participants
+* Send keep-alive packets on idle connection
+* Windows support
+
 ## 0.1.4 -- 2024-06-11
 
 * Added `/conversations` command to list and select conversations
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -60,7 +60,8 @@
 [1] PEER UPD discovery1.erebosprotocol.net [37.221.243.57 29665]
 ```
 
-Select the peer and send it a message, the public server just responds with automatic echo message:
+Select the peer and send it a message, the public server just responds with
+automatic echo message:
 ```
 > /1
 discovery1.erebosprotocol.net> hello
@@ -68,31 +69,58 @@
 [18:55] discovery1.erebosprotocol.net: Echo: hello
 ```
 
+List chatrooms known to the peers:
+```
+> /chatrooms
+[1] Test chatroom
+[2] Second test chatroom
+```
+
+Enter a chatroom and send a message there:
+```
+> /1
+Test chatroom> Hi
+Test chatroom [19:03] Some Name: Hi
+```
+
 ### Messaging
 
 `/peers`  
-List peers with direct network connection. Peers are discovered automatically
-on local network or can be manually added.
+: List peers with direct network connection. Peers are discovered automatically
+  on local network or can be manually added.
 
 `/contacts`  
-List known contacts (see below).
+: List known contacts (see below).
 
 `/conversations`  
-List started conversations with contacts or other peers.
+: List started conversations with contacts or other peers.
 
 `/<number>`  
-Select conversation, contact or peer `<number>` based on the last
-`/conversations`, `/contacts` or `/peers` output list.
+: Select conversation, contact or peer `<number>` based on the last
+  `/conversations`, `/contacts` or `/peers` output list.
 
 `<message>`  
-Send `<message>` to selected conversation.
+: Send `<message>` to selected conversation.
 
 `/history`  
-Show message history of the selected conversation.
+: Show message history of the selected conversation.
 
 `/details`  
-Show information about the selected conversations, contact or peer.
+: Show information about the selected conversations, contact or peer.
 
+### Chatrooms
+
+Currently only public unmoderated chatrooms are supported, which means that any
+network peer is allowed to read and post to the chatroom. Individual messages
+are signed, so message author can not be forged.
+
+`/chatrooms`  
+: List known chatrooms.
+
+`/chatroom-create-public [<name>]`  
+: Create public unmoderated chatroom. Room name can be passed as command
+  argument or entered interactively.
+
 ### Add contacts
 
 To ensure the identity of the contact and prevent man-in-the-middle attack,
@@ -101,21 +129,22 @@
 new contact, list peers using `/peers` command and select one with `/<number>`.
 
 `/contacts`  
-List already added contacts.
+: List already added contacts.
 
 `/contact-add`  
-Add selected peer as contact. Six-digit verification code will be computed
-based on peer keys, which will be displayed on both devices and needs to be
-checked that both numbers are same. After that it needs to be confirmed using
-`/contact-accept` to finish the process.
+: Add selected peer as contact. Six-digit verification code will be computed
+  based on peer keys, which will be displayed on both devices and needs to be
+  checked that both numbers are same. After that it needs to be confirmed using
+  `/contact-accept` to finish the process.
 
 `/contact-accept`  
-Confirm that displayed verification codes are same on both devices and add the
-selected peer as contact. The side, which did not initiate the contact adding
-process, needs to select the corresponding peer with `/<number>` command first.
+: Confirm that displayed verification codes are same on both devices and add
+  the selected peer as contact. The side, which did not initiate the contact
+  adding process, needs to select the corresponding peer with `/<number>`
+  command first.
 
 `/contact-reject`  
-Reject contact request or verification code of selected peer.
+: Reject contact request or verification code of selected peer.
 
 ### Attach other devices
 
@@ -134,37 +163,38 @@
 target device with `/<number>`.
 
 `/attach`  
-Attach current device to the selected peer. After the process completes the
-owner of the selected peer will become owner of this device as well. Six-digit
-verification code will be displayed on both devices and the user needs to check
-that both are the same before confirmation using the `/attach-accept` command.
+: Attach current device to the selected peer. After the process completes the
+  owner of the selected peer will become owner of this device as well.
+  Six-digit verification code will be displayed on both devices and the user
+  needs to check that both are the same before confirmation using the
+  `/attach-accept` command.
 
 `/attach-accept`  
-Confirm that displayed verification codes are same on both devices and complete
-the attachment process (or wait for the confirmation on the peer device). The
-side, which did not initiate the attachment process, needs to select the
-corresponding peer with `/<number>` command first.
+: Confirm that displayed verification codes are same on both devices and
+  complete the attachment process (or wait for the confirmation on the peer
+  device). The side, which did not initiate the attachment process, needs to
+  select the corresponding peer with `/<number>` command first.
 
 `/attach-reject`  
-Reject device attachment request or verification code of selected peer.
+: Reject device attachment request or verification code of selected peer.
 
 ### Other
 
 `/peer-add <host> [<port>]`  
-Manually add network peer with given hostname or IP address.
+: Manually add network peer with given hostname or IP address.
 
 `/peer-add-public`  
-Add known public network peer(s).
+: Add known public network peer(s).
 
 `/peer-drop`  
-Drop the currently selected peer. Afterwards, the connection can be
-re-established by either side.
+: Drop the currently selected peer. Afterwards, the connection can be
+  re-established by either side.
 
 `/update-identity`  
-Interactively update current identity information
+: Interactively update current identity information
 
 `/quit`  
-Quit the erebos tool.
+: Quit the erebos tool.
 
 
 Storage
diff --git a/erebos.cabal b/erebos.cabal
--- a/erebos.cabal
+++ b/erebos.cabal
@@ -1,7 +1,7 @@
-Cabal-Version:       2.2
+Cabal-Version:       3.0
 
 Name:                erebos
-Version:             0.1.4
+Version:             0.1.5
 Synopsis:            Decentralized messaging and synchronization
 Description:
     Library and simple CLI interface implementing the Erebos identity
@@ -117,6 +117,7 @@
     other-modules:
         Erebos.Flow
         Erebos.Storage.List
+        Erebos.Storage.Platform
         Erebos.Util
 
     c-sources:
@@ -147,9 +148,9 @@
         deepseq >= 1.4 && <1.6,
         directory >= 1.3 && <1.4,
         filepath >=1.4 && <1.6,
+        fsnotify ^>= { 0.4 },
         hashable >=1.3 && <1.5,
         hashtables >=1.2 && <1.4,
-        hinotify >=0.4 && <0.5,
         iproute >=1.7.12 && <1.8,
         memory >=0.14 && <0.19,
         mtl >=2.2 && <2.4,
@@ -157,10 +158,18 @@
         stm >=2.5 && <2.6,
         text >= 1.2 && <2.2,
         time >= 1.8 && <1.14,
-        unix >=2.7 && <2.9,
         uuid >=1.3 && <1.4,
         zlib >=0.6 && <0.8
 
+    if os(windows)
+        hs-source-dirs: src/windows
+        build-depends:
+            Win32 ^>= { 2.14 },
+    else
+        hs-source-dirs: src/unix
+        build-depends:
+            unix ^>= { 2.7, 2.8 },
+
 executable erebos
     import: common
     default-language:    Haskell2010
@@ -190,3 +199,4 @@
         text,
         time,
         transformers >= 0.5 && <0.7,
+        uuid,
diff --git a/main/Main.hs b/main/Main.hs
--- a/main/Main.hs
+++ b/main/Main.hs
@@ -24,6 +24,7 @@
 import Data.Text qualified as T
 import Data.Text.Encoding qualified as T
 import Data.Text.IO qualified as T
+import Data.Time.Format
 import Data.Time.LocalTime
 import Data.Typeable
 
@@ -37,6 +38,7 @@
 
 import Erebos.Attach
 import Erebos.Contact
+import Erebos.Chatroom
 import Erebos.Conversation
 #ifdef ENABLE_ICE_SUPPORT
 import Erebos.Discovery
@@ -59,6 +61,7 @@
 data Options = Options
     { optServer :: ServerOptions
     , optServices :: [ServiceOption]
+    , optChatroomAutoSubscribe :: Maybe Int
     , optDmBotEcho :: Maybe Text
     , optShowHelp :: Bool
     , optShowVersion :: Bool
@@ -75,6 +78,7 @@
 defaultOptions = Options
     { optServer = defaultServerOptions
     , optServices = availableServices
+    , optChatroomAutoSubscribe = Nothing
     , optDmBotEcho = Nothing
     , optShowHelp = False
     , optShowVersion = False
@@ -86,6 +90,8 @@
         True "attach (to) other devices"
     , ServiceOption "sync" (someService @SyncService Proxy)
         True "synchronization with attached devices"
+    , ServiceOption "chatroom" (someService @ChatroomService Proxy)
+        True "chatrooms with multiple participants"
     , ServiceOption "contact" (someService @ContactService Proxy)
         True "create contacts with network peers"
     , ServiceOption "dm" (someService @DirectMessage Proxy)
@@ -104,6 +110,9 @@
     , Option ['s'] ["silent"]
         (NoArg (so $ \opts -> opts { serverLocalDiscovery = False }))
         "do not send announce packets for local discovery"
+    , Option [] ["chatroom-auto-subscribe"]
+        (ReqArg (\count -> \opts -> opts { optChatroomAutoSubscribe = Just (read count) }) "<count>")
+        "automatically subscribe for up to <count> chatrooms"
     , Option [] ["dm-bot-echo"]
         (ReqArg (\prefix -> \opts -> opts { optDmBotEcho = Just (T.pack prefix) }) "<prefix>")
         "automatically reply to direct messages with the same text prefixed with <prefix>"
@@ -235,6 +244,7 @@
                             PeerIdentityRef wref _ -> "<" ++ BC.unpack (showRefDigest $ wrDigest wref) ++ ">"
                             PeerIdentityUnknown _  -> "<unknown>"
                         SelectedContact contact -> return $ T.unpack $ contactName contact
+                        SelectedChatroom rstate -> return $ T.unpack $ fromMaybe (T.pack "<unnamed>") $ roomName =<< roomStateRoom rstate
                         SelectedConversation conv -> return $ T.unpack $ conversationName conv
                     return $ pname ++ "> "
                 Right prompt -> return prompt
@@ -281,13 +291,20 @@
                         Right reply -> extPrintLn $ formatDirectMessage tzone $ fromStored reply
                         Left err -> extPrintLn $ "Failed to send dm echo: " <> err
 
+    peers <- liftIO $ newMVar []
+    contextOptions <- liftIO $ newMVar []
+    chatroomSetVar <- liftIO $ newEmptyMVar
+
+    let autoSubscribe = optChatroomAutoSubscribe opts
+        chatroomList = fromSetBy (comparing roomStateData) . lookupSharedValue . lsShared . headObject $ erebosHead
+    watched <- if isJust autoSubscribe || any roomStateSubscribe chatroomList
+        then fmap Just $ liftIO $ watchChatroomsForCli extPrintLn erebosHead chatroomSetVar contextOptions autoSubscribe
+        else return Nothing
+
     server <- liftIO $ do
         startServer (optServer opts) erebosHead extPrintLn $
             map soptService $ filter soptEnabled $ optServices opts
 
-    peers <- liftIO $ newMVar []
-    contextOptions <- liftIO $ newMVar []
-
     void $ liftIO $ forkIO $ void $ forever $ do
         peer <- getNextPeerChange server
         peerIdentity peer >>= \case
@@ -320,11 +337,14 @@
                 { ciServer = server
                 , ciLine = line
                 , ciPrint = extPrintLn
+                , ciOptions = opts
                 , ciPeers = liftIO $ modifyMVar peers $ \ps -> do
                     ps' <- filterM (fmap not . isPeerDropped . fst) ps
                     return (ps', ps')
                 , ciContextOptions = liftIO $ readMVar contextOptions
                 , ciSetContextOptions = \ctxs -> liftIO $ modifyMVar_ contextOptions $ const $ return ctxs
+                , ciContextOptionsVar = contextOptions
+                , ciChatroomSetVar = chatroomSetVar
                 }
             case res of
                 Right cstate'
@@ -343,6 +363,7 @@
         , csIceSessions = []
 #endif
         , csIcePeer = Nothing
+        , csWatchChatrooms = watched
         , csQuit = False
         }
 
@@ -351,9 +372,12 @@
     { ciServer :: Server
     , ciLine :: String
     , ciPrint :: String -> IO ()
+    , ciOptions :: Options
     , ciPeers :: CommandM [(Peer, String)]
     , ciContextOptions :: CommandM [CommandContext]
     , ciSetContextOptions :: [CommandContext] -> Command
+    , ciContextOptionsVar :: MVar [ CommandContext ]
+    , ciChatroomSetVar :: MVar (Set ChatroomState)
     }
 
 data CommandState = CommandState
@@ -363,12 +387,14 @@
     , csIceSessions :: [IceSession]
 #endif
     , csIcePeer :: Maybe Peer
+    , csWatchChatrooms :: Maybe WatchedHead
     , csQuit :: Bool
     }
 
 data CommandContext = NoContext
                     | SelectedPeer Peer
                     | SelectedContact Contact
+                    | SelectedChatroom ChatroomState
                     | SelectedConversation Conversation
 
 newtype CommandM a = CommandM (ReaderT CommandInput (StateT CommandState (ExceptT String IO)) a)
@@ -410,6 +436,10 @@
     SelectedContact contact -> case contactIdentity contact of
         Just cid -> directMessageConversation cid
         Nothing -> throwError "contact without erebos identity"
+    SelectedChatroom rstate ->
+        chatroomConversation rstate >>= \case
+            Just conv -> return conv
+            Nothing -> throwError "invalid chatroom"
     SelectedConversation conv -> reloadConversation conv
     _ -> throwError "no contact, peer or conversation selected"
 
@@ -425,6 +455,8 @@
     , ("attach", cmdAttach)
     , ("attach-accept", cmdAttachAccept)
     , ("attach-reject", cmdAttachReject)
+    , ("chatrooms", cmdChatrooms)
+    , ("chatroom-create-public", cmdChatroomCreatePublic)
     , ("contacts", cmdContacts)
     , ("contact-add", cmdContactAdd)
     , ("contact-accept", cmdContactAccept)
@@ -496,16 +528,24 @@
 cmdSelectContext = do
     n <- read <$> asks ciLine
     join (asks ciContextOptions) >>= \ctxs -> if
-        | n > 0, (ctx : _) <- drop (n - 1) ctxs -> modify $ \s -> s { csContext = ctx }
+        | n > 0, (ctx : _) <- drop (n - 1) ctxs -> do
+            modify $ \s -> s { csContext = ctx }
+            case ctx of
+                SelectedChatroom rstate -> do
+                    when (not (roomStateSubscribe rstate)) $ do
+                        chatroomSetSubscribe (head $ roomStateData rstate) True
+                _ -> return ()
         | otherwise -> throwError "invalid index"
 
 cmdSend :: Command
 cmdSend = void $ do
     text <- asks ciLine
     conv <- getSelectedConversation
-    msg <- sendMessage conv $ T.pack text
-    tzone <- liftIO $ getCurrentTimeZone
-    liftIO $ putStrLn $ formatMessage tzone msg
+    sendMessage conv (T.pack text) >>= \case
+        Just msg -> do
+            tzone <- liftIO $ getCurrentTimeZone
+            liftIO $ putStrLn $ formatMessage tzone msg
+        Nothing -> return ()
 
 cmdHistory :: Command
 cmdHistory = void $ do
@@ -530,6 +570,110 @@
 cmdAttachReject :: Command
 cmdAttachReject = attachReject =<< getSelectedPeer
 
+watchChatroomsForCli :: (String -> IO ()) -> Head LocalState -> MVar (Set ChatroomState) -> MVar [ CommandContext ] -> Maybe Int -> IO WatchedHead
+watchChatroomsForCli eprint h chatroomSetVar contextVar autoSubscribe = do
+    subscribedNumVar <- newEmptyMVar
+
+    let ctxUpdate updateType (idx :: Int) rstate = \case
+            SelectedChatroom rstate' : rest
+                | currentRoots <- filterAncestors (concatMap storedRoots $ roomStateData rstate)
+                , any ((`intersectsSorted` currentRoots) . storedRoots) $ roomStateData rstate'
+                -> do
+                    eprint $ "[" <> show idx <> "] CHATROOM " <> updateType <> " " <> name
+                    return (SelectedChatroom rstate : rest)
+            selected : rest
+                -> do
+                    (selected : ) <$> ctxUpdate updateType (idx + 1) rstate rest
+            []
+                -> do
+                    eprint $ "[" <> show idx <> "] CHATROOM " <> updateType <> " " <> name
+                    return [ SelectedChatroom rstate ]
+          where
+            name = maybe "<unnamed>" T.unpack $ roomName =<< roomStateRoom rstate
+
+    watchChatrooms h $ \set -> \case
+        Nothing -> do
+            let chatroomList = fromSetBy (comparing roomStateData) set
+                (subscribed, notSubscribed) = partition roomStateSubscribe chatroomList
+                subscribedNum = length subscribed
+
+            putMVar chatroomSetVar set
+            putMVar subscribedNumVar subscribedNum
+
+            case autoSubscribe of
+                Nothing -> return ()
+                Just num -> do
+                    forM_ (take (num - subscribedNum) notSubscribed) $ \rstate -> do
+                        (runExceptT $ flip runReaderT h $ chatroomSetSubscribe (head $ roomStateData rstate) True) >>= \case
+                             Right () -> return ()
+                             Left err -> eprint err
+
+        Just diff -> do
+            modifyMVar_ chatroomSetVar $ return . const set
+            forM_ diff $ \case
+                AddedChatroom rstate -> do
+                    modifyMVar_ contextVar $ ctxUpdate "NEW" 1 rstate
+                    modifyMVar_ subscribedNumVar $ return . if roomStateSubscribe rstate then (+ 1) else id
+
+                RemovedChatroom rstate -> do
+                    modifyMVar_ contextVar $ ctxUpdate "DEL" 1 rstate
+                    modifyMVar_ subscribedNumVar $ return . if roomStateSubscribe rstate then subtract 1 else id
+
+                UpdatedChatroom oldroom rstate -> do
+                    when (any ((\rsd -> not (null (rsdRoom rsd))) . fromStored) (roomStateData rstate)) $ do
+                        modifyMVar_ contextVar $ ctxUpdate "UPD" 1 rstate
+                    when (any (not . null . rsdMessages . fromStored) (roomStateData rstate)) $ do
+                        tzone <- getCurrentTimeZone
+                        forM_ (reverse $ getMessagesSinceState rstate oldroom) $ \msg -> do
+                            eprint $ concat $
+                                [ maybe "<unnamed>" T.unpack $ roomName =<< cmsgRoom msg
+                                , formatTime defaultTimeLocale " [%H:%M] " $ utcToLocalTime tzone $ zonedTimeToUTC $ cmsgTime msg
+                                , maybe "<unnamed>" T.unpack $ idName $ cmsgFrom msg
+                                , ": "
+                                , maybe "<no message>" T.unpack $ cmsgText msg
+                                ]
+                    modifyMVar_ subscribedNumVar $ return
+                        . (if roomStateSubscribe rstate then (+ 1) else id)
+                        . (if roomStateSubscribe oldroom then subtract 1 else id)
+
+ensureWatchedChatrooms :: Command
+ensureWatchedChatrooms = do
+    gets csWatchChatrooms >>= \case
+        Nothing -> do
+            eprint <- asks ciPrint
+            h <- gets csHead
+            chatroomSetVar <- asks ciChatroomSetVar
+            contextVar <- asks ciContextOptionsVar
+            autoSubscribe <- asks $ optChatroomAutoSubscribe . ciOptions
+            watched <- liftIO $ watchChatroomsForCli eprint h chatroomSetVar contextVar autoSubscribe
+            modify $ \s -> s { csWatchChatrooms = Just watched }
+        Just _ -> return ()
+
+cmdChatrooms :: Command
+cmdChatrooms = do
+    ensureWatchedChatrooms
+    chatroomSetVar <- asks ciChatroomSetVar
+    chatroomList <- fromSetBy (comparing roomStateData) <$> liftIO (readMVar chatroomSetVar)
+    set <- asks ciSetContextOptions
+    set $ map SelectedChatroom chatroomList
+    forM_ (zip [1..] chatroomList) $ \(i :: Int, rstate) -> do
+        liftIO $ putStrLn $ "[" ++ show i ++ "] " ++ maybe "<unnamed>" T.unpack (roomName =<< roomStateRoom rstate)
+
+cmdChatroomCreatePublic :: Command
+cmdChatroomCreatePublic = do
+    name <- asks ciLine >>= \case
+        line | not (null line) -> return $ T.pack line
+        _ -> liftIO $ do
+            T.putStr $ T.pack "Name: "
+            hFlush stdout
+            T.getLine
+
+    ensureWatchedChatrooms
+    void $ createChatroom
+        (if T.null name then Nothing else Just name)
+        Nothing
+
+
 cmdContacts :: Command
 cmdContacts = do
     args <- words <$> asks ciLine
@@ -586,6 +730,9 @@
         SelectedContact contact -> do
             printContactDetails contact
 
+        SelectedChatroom rstate -> do
+            liftIO $ putStrLn $ "Chatroom: " <> (T.unpack $ fromMaybe (T.pack "<unnamed>") $ roomName =<< roomStateRoom rstate)
+
         SelectedConversation conv -> do
             case conversationPeer conv of
                 Just pid -> printContactOrIdentityDetails pid
@@ -703,3 +850,10 @@
 
 cmdQuit :: Command
 cmdQuit = modify $ \s -> s { csQuit = True }
+
+
+intersectsSorted :: Ord a => [a] -> [a] -> Bool
+intersectsSorted (x:xs) (y:ys) | x < y     = intersectsSorted xs (y:ys)
+                               | x > y     = intersectsSorted (x:xs) ys
+                               | otherwise = True
+intersectsSorted _ _ = False
diff --git a/main/Test.hs b/main/Test.hs
--- a/main/Test.hs
+++ b/main/Test.hs
@@ -12,6 +12,7 @@
 
 import Crypto.Random
 
+import Data.Bool
 import Data.ByteString qualified as B
 import Data.ByteString.Char8 qualified as BC
 import Data.ByteString.Lazy qualified as BL
@@ -22,6 +23,7 @@
 import Data.Text.Encoding
 import Data.Text.IO qualified as T
 import Data.Typeable
+import Data.UUID qualified as U
 
 import Network.Socket
 
@@ -50,6 +52,8 @@
 data TestState = TestState
     { tsHead :: Maybe (Head LocalState)
     , tsServer :: Maybe RunningServer
+    , tsWatchedHeads :: [ ( Int, WatchedHead ) ]
+    , tsWatchedHeadNext :: Int
     , tsWatchedLocalIdentity :: Maybe WatchedHead
     , tsWatchedSharedIdentity :: Maybe WatchedHead
     }
@@ -64,6 +68,8 @@
 initTestState = TestState
     { tsHead = Nothing
     , tsServer = Nothing
+    , tsWatchedHeads = []
+    , tsWatchedHeadNext = 1
     , tsWatchedLocalIdentity = Nothing
     , tsWatchedSharedIdentity = Nothing
     }
@@ -242,6 +248,10 @@
     , ("stored-roots", cmdStoredRoots)
     , ("stored-set-add", cmdStoredSetAdd)
     , ("stored-set-list", cmdStoredSetList)
+    , ("head-create", cmdHeadCreate)
+    , ("head-replace", cmdHeadReplace)
+    , ("head-watch", cmdHeadWatch)
+    , ("head-unwatch", cmdHeadUnwatch)
     , ("create-identity", cmdCreateIdentity)
     , ("start-server", cmdStartServer)
     , ("stop-server", cmdStopServer)
@@ -271,6 +281,8 @@
     , ("chatroom-list-local", cmdChatroomListLocal)
     , ("chatroom-watch-local", cmdChatroomWatchLocal)
     , ("chatroom-set-name", cmdChatroomSetName)
+    , ("chatroom-subscribe", cmdChatroomSubscribe)
+    , ("chatroom-unsubscribe", cmdChatroomUnsubscribe)
     , ("chatroom-message-send", cmdChatroomMessageSend)
     ]
 
@@ -318,6 +330,58 @@
         cmdOut $ "stored-set-item" ++ concatMap ((' ':) . show . refDigest . storedRef) item
     cmdOut $ "stored-set-done"
 
+cmdHeadCreate :: Command
+cmdHeadCreate = do
+    [ ttid, tref ] <- asks tiParams
+    st <- asks tiStorage
+    Just tid <- return $ fromUUID <$> U.fromText ttid
+    Just ref <- liftIO $ readRef st (encodeUtf8 tref)
+
+    h <- storeHeadRaw st tid ref
+    cmdOut $ unwords $ [ "head-create-done", show (toUUID tid), show (toUUID h) ]
+
+cmdHeadReplace :: Command
+cmdHeadReplace = do
+    [ ttid, thid, told, tnew ] <- asks tiParams
+    st <- asks tiStorage
+    Just tid <- return $ fmap fromUUID $ U.fromText ttid
+    Just hid <- return $ fmap fromUUID $ U.fromText thid
+    Just old <- liftIO $ readRef st (encodeUtf8 told)
+    Just new <- liftIO $ readRef st (encodeUtf8 tnew)
+
+    replaceHeadRaw st tid hid old new >>= cmdOut . unwords . \case
+        Left Nothing  -> [ "head-replace-fail", T.unpack ttid, T.unpack thid, T.unpack told, T.unpack tnew ]
+        Left (Just r) -> [ "head-replace-fail", T.unpack ttid, T.unpack thid, T.unpack told, T.unpack tnew, show (refDigest r) ]
+        Right _       -> [ "head-replace-done", T.unpack ttid, T.unpack thid, T.unpack told, T.unpack tnew ]
+
+cmdHeadWatch :: Command
+cmdHeadWatch = do
+    [ ttid, thid ] <- asks tiParams
+    st <- asks tiStorage
+    Just tid <- return $ fmap fromUUID $ U.fromText ttid
+    Just hid <- return $ fmap fromUUID $ U.fromText thid
+
+    out <- asks tiOutput
+    wid <- gets tsWatchedHeadNext
+
+    watched <- liftIO $ watchHeadRaw st tid hid id $ \r -> do
+        outLine out $ unwords [ "head-watch-cb", show wid, show $ refDigest r ]
+
+    modify $ \s -> s
+        { tsWatchedHeads = ( wid, watched ) : tsWatchedHeads s
+        , tsWatchedHeadNext = wid + 1
+        }
+
+    cmdOut $ unwords $ [ "head-watch-done", T.unpack ttid, T.unpack thid, show wid ]
+
+cmdHeadUnwatch :: Command
+cmdHeadUnwatch = do
+    [ twid ] <- asks tiParams
+    let wid = read (T.unpack twid)
+    Just watched <- lookup wid <$> gets tsWatchedHeads
+    liftIO $ unwatchHead watched
+    cmdOut $ unwords [ "head-unwatch-done", show wid ]
+
 initTestHead :: Head LocalState -> Command
 initTestHead h = do
     _ <- liftIO . watchReceivedMessages h . dmReceivedWatcher =<< asks tiOutput
@@ -655,17 +719,18 @@
             AddedChatroom room -> outLine out $ unwords $ "chatroom-watched-added" : chatroomInfo room
             RemovedChatroom room -> outLine out $ unwords $ "chatroom-watched-removed" : chatroomInfo room
             UpdatedChatroom oldroom room -> do
-                when (any (not . null . rsdRoom . fromStored) (roomStateData room)) $ do
+                when (any ((\rsd -> not (null (rsdRoom rsd)) || not (null (rsdSubscribe rsd))) . fromStored) (roomStateData room)) $ do
                     outLine out $ unwords $ concat
                         [ [ "chatroom-watched-updated" ], chatroomInfo room
                         , [ "old" ], map (show . refDigest . storedRef) (roomStateData oldroom)
                         , [ "new" ], map (show . refDigest . storedRef) (roomStateData room)
                         ]
                 when (any (not . null . rsdMessages . fromStored) (roomStateData room)) $ do
-                    forM_ (getMessagesSinceState room oldroom) $ \msg -> do
+                    forM_ (reverse $ getMessagesSinceState room oldroom) $ \msg -> do
                         outLine out $ unwords $ concat
                             [ [ "chatroom-message-new" ]
                             , [ show . refDigest . storedRef . head . filterAncestors . concatMap storedRoots . toComponents $ room ]
+                            , [ "room", maybe "<unnamed>" T.unpack $ roomName =<< cmsgRoom msg ]
                             , [ "from", maybe "<unnamed>" T.unpack $ idName $ cmsgFrom msg ]
                             , maybe [] (("text":) . (:[]) . T.unpack) $ cmsgText msg
                             ]
@@ -674,10 +739,23 @@
 chatroomInfo room =
     [ show . refDigest . storedRef . head . filterAncestors . concatMap storedRoots . toComponents $ room
     , maybe "<unnamed>" T.unpack $ roomName =<< roomStateRoom room
+    , "sub " <> bool "false" "true" (roomStateSubscribe room)
     ]
 
+cmdChatroomSubscribe :: Command
+cmdChatroomSubscribe = do
+    [ cid ] <- asks tiParams
+    to <- getChatroomStateData cid
+    void $ chatroomSetSubscribe to True
+
+cmdChatroomUnsubscribe :: Command
+cmdChatroomUnsubscribe = do
+    [ cid ] <- asks tiParams
+    to <- getChatroomStateData cid
+    void $ chatroomSetSubscribe to False
+
 cmdChatroomMessageSend :: Command
 cmdChatroomMessageSend = do
     [cid, msg] <- asks tiParams
     to <- getChatroomStateData cid
-    void $ chatroomMessageByStateData to msg
+    void $ sendChatroomMessageByStateData to msg
diff --git a/src/Erebos/Chatroom.hs b/src/Erebos/Chatroom.hs
--- a/src/Erebos/Chatroom.hs
+++ b/src/Erebos/Chatroom.hs
@@ -10,14 +10,18 @@
     listChatrooms,
     findChatroomByRoomData,
     findChatroomByStateData,
+    chatroomSetSubscribe,
     getMessagesSinceState,
 
     ChatroomSetChange(..),
     watchChatrooms,
 
-    ChatMessage, cmsgFrom, cmsgReplyTo, cmsgTime, cmsgText, cmsgLeave,
+    ChatMessage,
+    cmsgFrom, cmsgReplyTo, cmsgTime, cmsgText, cmsgLeave,
+    cmsgRoom, cmsgRoomData,
     ChatMessageData(..),
-    chatroomMessageByStateData,
+    sendChatroomMessage,
+    sendChatroomMessageByStateData,
 
     ChatroomService(..),
 ) where
@@ -27,6 +31,8 @@
 import Control.Monad.Except
 import Control.Monad.IO.Class
 
+import Data.Bool
+import Data.Either
 import Data.IORef
 import Data.List
 import Data.Maybe
@@ -109,6 +115,11 @@
     { cmsgData :: Stored (Signed ChatMessageData)
     }
 
+validateSingleMessage :: Stored (Signed ChatMessageData) -> Maybe ChatMessage
+validateSingleMessage sdata = do
+    guard $ fromStored sdata `isSignedBy` idKeyMessage (mdFrom (fromSigned sdata))
+    return $ ChatMessage sdata
+
 cmsgFrom :: ChatMessage -> ComposedIdentity
 cmsgFrom = mdFrom . fromSigned . cmsgData
 
@@ -124,6 +135,12 @@
 cmsgLeave :: ChatMessage -> Bool
 cmsgLeave = mdLeave . fromSigned . cmsgData
 
+cmsgRoom :: ChatMessage -> Maybe Chatroom
+cmsgRoom = either (const Nothing) Just . runExcept . validateChatroom . cmsgRoomData
+
+cmsgRoomData :: ChatMessage -> [ Stored (Signed ChatroomData) ]
+cmsgRoomData = concat . findProperty ((\case [] -> Nothing; xs -> Just xs) . mdRoom . fromStored . signedData) . (: []) . cmsgData
+
 instance Storable ChatMessageData where
     store' ChatMessageData {..} = storeRec $ do
         mapM_ (storeRef "SPREV") mdPrev
@@ -144,23 +161,26 @@
         mdLeave <- isJust <$> loadMbEmpty "leave"
         return ChatMessageData {..}
 
-threadToList :: [Stored (Signed ChatMessageData)] -> [ChatMessage]
-threadToList thread = helper S.empty $ thread
+threadToListSince :: [ Stored (Signed ChatMessageData) ] -> [ Stored (Signed ChatMessageData) ] -> [ ChatMessage ]
+threadToListSince since thread = helper (S.fromList since) thread
   where
     helper :: S.Set (Stored (Signed ChatMessageData)) -> [Stored (Signed ChatMessageData)] -> [ChatMessage]
     helper seen msgs
         | msg : msgs' <- filter (`S.notMember` seen) $ reverse $ sortBy (comparing cmpView) msgs =
-            messageFromData msg : helper (S.insert msg seen) (msgs' ++ mdPrev (fromSigned msg))
+            maybe id (:) (validateSingleMessage msg) $
+               helper (S.insert msg seen) (msgs' ++ mdPrev (fromSigned msg))
         | otherwise = []
     cmpView msg = (zonedTimeToUTC $ mdTime $ fromSigned msg, msg)
 
-    messageFromData :: Stored (Signed ChatMessageData) -> ChatMessage
-    messageFromData sdata = ChatMessage { cmsgData = sdata }
+sendChatroomMessage
+    :: (MonadStorage m, MonadHead LocalState m, MonadError String m)
+    => ChatroomState -> Text -> m ()
+sendChatroomMessage rstate msg = sendChatroomMessageByStateData (head $ roomStateData rstate) msg
 
-chatroomMessageByStateData
+sendChatroomMessageByStateData
     :: (MonadStorage m, MonadHead LocalState m, MonadError String m)
     => Stored ChatroomStateData -> Text -> m ()
-chatroomMessageByStateData lookupData msg = void $ findAndUpdateChatroomState $ \cstate -> do
+sendChatroomMessageByStateData lookupData msg = void $ findAndUpdateChatroomState $ \cstate -> do
     guard $ any (lookupData `precedesOrEquals`) $ roomStateData cstate
     Just $ do
         self <- finalOwner . localIdentity . fromStored <$> getLocalHead
@@ -168,7 +188,9 @@
         time <- liftIO getZonedTime
         mdata <- mstore =<< sign secret =<< mstore ChatMessageData
             { mdPrev = roomStateMessageData cstate
-            , mdRoom = []
+            , mdRoom = if null (roomStateMessageData cstate)
+                          then maybe [] roomData (roomStateRoom cstate)
+                          else []
             , mdFrom = self
             , mdReplyTo = Nothing
             , mdTime = time
@@ -178,6 +200,7 @@
         mergeSorted . (:[]) <$> mstore ChatroomStateData
             { rsdPrev = roomStateData cstate
             , rsdRoom = []
+            , rsdSubscribe = Just True
             , rsdMessages = [ mdata ]
             }
 
@@ -185,6 +208,7 @@
 data ChatroomStateData = ChatroomStateData
     { rsdPrev :: [Stored ChatroomStateData]
     , rsdRoom :: [Stored (Signed ChatroomData)]
+    , rsdSubscribe :: Maybe Bool
     , rsdMessages :: [Stored (Signed ChatMessageData)]
     }
 
@@ -192,6 +216,7 @@
     { roomStateData :: [Stored ChatroomStateData]
     , roomStateRoom :: Maybe Chatroom
     , roomStateMessageData :: [Stored (Signed ChatMessageData)]
+    , roomStateSubscribe :: Bool
     , roomStateMessages :: [ChatMessage]
     }
 
@@ -199,11 +224,13 @@
     store' ChatroomStateData {..} = storeRec $ do
         forM_ rsdPrev $ storeRef "PREV"
         forM_ rsdRoom $ storeRef "room"
+        forM_ rsdSubscribe $ storeInt "subscribe" . bool @Int 0 1
         forM_ rsdMessages $ storeRef "msg"
 
     load' = loadRec $ do
         rsdPrev <- loadRefs "PREV"
         rsdRoom <- loadRefs "room"
+        rsdSubscribe <- fmap ((/=) @Int 0) <$> loadMbInt "subscribe"
         rsdMessages <- loadRefs "msg"
         return ChatroomStateData {..}
 
@@ -216,7 +243,8 @@
             roomStateMessageData = filterAncestors $ concat $ flip findProperty roomStateData $ \case
                 ChatroomStateData {..} | null rsdMessages -> Nothing
                                        | otherwise        -> Just rsdMessages
-            roomStateMessages = threadToList $ concatMap (rsdMessages . fromStored) roomStateData
+            roomStateSubscribe = fromMaybe False $ findPropertyFirst rsdSubscribe roomStateData
+            roomStateMessages = threadToListSince [] $ concatMap (rsdMessages . fromStored) roomStateData
          in ChatroomState {..}
 
     toComponents = roomStateData
@@ -232,6 +260,7 @@
     cstate <- mergeSorted . (:[]) <$> mstore ChatroomStateData
         { rsdPrev = []
         , rsdRoom = [ rdata ]
+        , rsdSubscribe = Just True
         , rsdMessages = []
         }
 
@@ -278,6 +307,7 @@
         mergeSorted . (:[]) <$> mstore ChatroomStateData
             { rsdPrev = roomStateData cstate
             , rsdRoom = [ rdata ]
+            , rsdSubscribe = Just True
             , rsdMessages = []
             }
 
@@ -298,11 +328,21 @@
 findChatroomByStateData :: MonadHead LocalState m => Stored ChatroomStateData -> m (Maybe ChatroomState)
 findChatroomByStateData cdata = findChatroom $ any (cdata `precedesOrEquals`) . roomStateData
 
+chatroomSetSubscribe
+    :: (MonadStorage m, MonadHead LocalState m, MonadError String m)
+    => Stored ChatroomStateData -> Bool -> m ()
+chatroomSetSubscribe lookupData subscribe = void $ findAndUpdateChatroomState $ \cstate -> do
+    guard $ any (lookupData `precedesOrEquals`) $ roomStateData cstate
+    Just $ do
+        mergeSorted . (:[]) <$> mstore ChatroomStateData
+            { rsdPrev = roomStateData cstate
+            , rsdRoom = []
+            , rsdSubscribe = Just subscribe
+            , rsdMessages = []
+            }
+
 getMessagesSinceState :: ChatroomState -> ChatroomState -> [ChatMessage]
-getMessagesSinceState cur old = takeWhile notOld (roomStateMessages cur)
-  where
-    notOld msg = cmsgData msg `notElem` roomStateMessageData old
-    -- TODO: parallel message threads
+getMessagesSinceState cur old = threadToListSince (roomStateMessageData old) (roomStateMessageData cur)
 
 
 data ChatroomSetChange = AddedChatroom ChatroomState
@@ -342,13 +382,18 @@
 data ChatroomService = ChatroomService
     { chatRoomQuery :: Bool
     , chatRoomInfo :: [Stored (Signed ChatroomData)]
+    , chatRoomSubscribe :: [Stored (Signed ChatroomData)]
+    , chatRoomUnsubscribe :: [Stored (Signed ChatroomData)]
     , chatRoomMessage :: [Stored (Signed ChatMessageData)]
     }
+    deriving (Eq)
 
 emptyPacket :: ChatroomService
 emptyPacket = ChatroomService
     { chatRoomQuery = False
     , chatRoomInfo = []
+    , chatRoomSubscribe = []
+    , chatRoomUnsubscribe = []
     , chatRoomMessage = []
     }
 
@@ -356,17 +401,22 @@
     store' ChatroomService {..} = storeRec $ do
         when  chatRoomQuery $ storeEmpty "room-query"
         forM_ chatRoomInfo $ storeRef "room-info"
+        forM_ chatRoomSubscribe $ storeRef "room-subscribe"
+        forM_ chatRoomUnsubscribe $ storeRef "room-unsubscribe"
         forM_ chatRoomMessage $ storeRef "room-message"
 
     load' = loadRec $ do
         chatRoomQuery <- isJust <$> loadMbEmpty "room-query"
         chatRoomInfo <- loadRefs "room-info"
+        chatRoomSubscribe <- loadRefs "room-subscribe"
+        chatRoomUnsubscribe <- loadRefs "room-unsubscribe"
         chatRoomMessage <- loadRefs "room-message"
         return ChatroomService {..}
 
 data PeerState = PeerState
     { psSendRoomUpdates :: Bool
     , psLastList :: [(Stored ChatroomStateData, ChatroomState)]
+    , psSubscribedTo :: [ Stored (Signed ChatroomData) ] -- least root for each room
     }
 
 instance Service ChatroomService where
@@ -376,12 +426,18 @@
     emptyServiceState _ = PeerState
         { psSendRoomUpdates = False
         , psLastList = []
+        , psSubscribedTo = []
         }
 
     serviceHandler spacket = do
         let ChatroomService {..} = fromStored spacket
+
+        previouslyUpdated <- psSendRoomUpdates <$> svcGet
         svcModify $ \s -> s { psSendRoomUpdates = True }
 
+        when (not previouslyUpdated) $ do
+            syncChatroomsToPeer . lookupSharedValue . lsShared . fromStored =<< getLocalHead
+
         when chatRoomQuery $ do
             rooms <- listChatrooms
             replyPacket emptyPacket
@@ -394,10 +450,10 @@
                     upd set (roomInfo :: Stored (Signed ChatroomData)) = do
                         let currentRoots = storedRoots roomInfo
                             isCurrentRoom = any ((`intersectsSorted` currentRoots) . storedRoots) .
-                                concatMap (rsdRoom . fromStored) . roomStateData
+                                maybe [] roomData . roomStateRoom
 
                         let prev = concatMap roomStateData $ filter isCurrentRoom rooms
-                            prevRoom = concatMap (rsdRoom . fromStored) prev
+                            prevRoom = filterAncestors $ concat $ findProperty ((\case [] -> Nothing; xs -> Just xs) . rsdRoom) prev
                             room = filterAncestors $ (roomInfo : ) prevRoom
 
                         -- update local state only if we got roomInfo not present there
@@ -406,12 +462,58 @@
                             sdata <- mstore ChatroomStateData
                                 { rsdPrev = prev
                                 , rsdRoom = room
+                                , rsdSubscribe = Nothing
                                 , rsdMessages = []
                                 }
                             storeSetAddComponent sdata set
                           else return set
                 foldM upd roomSet chatRoomInfo
 
+        forM_ chatRoomSubscribe $ \subscribeData -> do
+            mbRoomState <- findChatroomByRoomData subscribeData
+            forM_ mbRoomState $ \roomState ->
+                forM (roomStateRoom roomState) $ \room -> do
+                    let leastRoot = head . filterAncestors . concatMap storedRoots . roomData $ room
+                    svcModify $ \ps -> ps { psSubscribedTo = leastRoot : psSubscribedTo ps }
+                    replyPacket emptyPacket
+                        { chatRoomMessage = roomStateMessageData roomState
+                        }
+
+        forM_ chatRoomUnsubscribe $ \unsubscribeData -> do
+            mbRoomState <- findChatroomByRoomData unsubscribeData
+            forM_ (mbRoomState >>= roomStateRoom) $ \room -> do
+                let leastRoot = head . filterAncestors . concatMap storedRoots . roomData $ room
+                svcModify $ \ps -> ps { psSubscribedTo = filter (/= leastRoot) (psSubscribedTo ps) }
+
+        when (not (null chatRoomMessage)) $ do
+            updateLocalHead_ $ updateSharedState_ $ \roomSet -> do
+                let rooms = fromSetBy (comparing $ roomName <=< roomStateRoom) roomSet
+                    upd set (msgData :: Stored (Signed ChatMessageData))
+                        | Just msg <- validateSingleMessage msgData = do
+                            let roomInfo = cmsgRoomData msg
+                                currentRoots = filterAncestors $ concatMap storedRoots roomInfo
+                                isCurrentRoom = any ((`intersectsSorted` currentRoots) . storedRoots) .
+                                    maybe [] roomData . roomStateRoom
+
+                            let prevData = concatMap roomStateData $ filter isCurrentRoom rooms
+                                prev = mergeSorted prevData
+                                prevMessages = roomStateMessageData prev
+                                messages = filterAncestors $ msgData : prevMessages
+
+                            -- update local state only if subscribed and we got some new messages
+                            if roomStateSubscribe prev && messages /= prevMessages
+                              then do
+                                sdata <- mstore ChatroomStateData
+                                    { rsdPrev = prevData
+                                    , rsdRoom = []
+                                    , rsdSubscribe = Nothing
+                                    , rsdMessages = messages
+                                    }
+                                storeSetAddComponent sdata set
+                              else return set
+                        | otherwise = return set
+                foldM upd roomSet chatRoomMessage
+
     serviceNewPeer = do
         replyPacket emptyPacket { chatRoomQuery = True }
 
@@ -423,11 +525,50 @@
     ps@PeerState {..} <- svcGet
     when psSendRoomUpdates $ do
         let curList = chatroomSetToList set
-        updates <- fmap (concat . catMaybes) $
-            forM (makeChatroomDiff psLastList curList) $ return . \case
+            diff = makeChatroomDiff psLastList curList
+
+        roomUpdates <- fmap (concat . catMaybes) $
+            forM diff $ return . \case
                 AddedChatroom room -> roomData <$> roomStateRoom room
                 RemovedChatroom {} -> Nothing
-                UpdatedChatroom _ room -> roomData <$> roomStateRoom room
-        when (not $ null updates) $ do
-            replyPacket $ emptyPacket { chatRoomInfo = updates }
+                UpdatedChatroom oldroom room
+                    | roomStateData oldroom /= roomStateData room -> roomData <$> roomStateRoom room
+                    | otherwise -> Nothing
+
+        (subscribe, unsubscribe) <- fmap (partitionEithers . concat . catMaybes) $
+            forM diff $ return . \case
+                AddedChatroom room
+                    | roomStateSubscribe room
+                    -> map Left . roomData <$> roomStateRoom room
+                RemovedChatroom oldroom
+                    | roomStateSubscribe oldroom
+                    -> map Right . roomData <$> roomStateRoom oldroom
+                UpdatedChatroom oldroom room
+                    | roomStateSubscribe oldroom /= roomStateSubscribe room
+                    -> map (if roomStateSubscribe room then Left else Right) . roomData <$> roomStateRoom room
+                _ -> Nothing
+
+        messages <- fmap concat $ do
+            let leastRootFor = head . filterAncestors . concatMap storedRoots . roomData
+            forM diff $ return . \case
+                AddedChatroom rstate
+                    | Just room <- roomStateRoom rstate
+                    , leastRootFor room `elem` psSubscribedTo
+                    -> roomStateMessageData rstate
+                UpdatedChatroom oldstate rstate
+                    | Just room <- roomStateRoom rstate
+                    , leastRootFor room `elem` psSubscribedTo
+                    , roomStateMessageData oldstate /= roomStateMessageData rstate
+                    -> roomStateMessageData rstate
+                _ -> []
+
+        let packet = emptyPacket
+                { chatRoomInfo = roomUpdates
+                , chatRoomSubscribe = subscribe
+                , chatRoomUnsubscribe = unsubscribe
+                , chatRoomMessage = messages
+                }
+
+        when (packet /= emptyPacket) $ do
+            replyPacket packet
         svcSet $ ps { psLastList = curList }
diff --git a/src/Erebos/Conversation.hs b/src/Erebos/Conversation.hs
--- a/src/Erebos/Conversation.hs
+++ b/src/Erebos/Conversation.hs
@@ -1,12 +1,15 @@
 module Erebos.Conversation (
     Message,
     messageFrom,
+    messageTime,
     messageText,
     messageUnread,
     formatMessage,
 
     Conversation,
     directMessageConversation,
+    chatroomConversation,
+    chatroomConversationByStateData,
     reloadConversation,
     lookupConversations,
 
@@ -23,30 +26,45 @@
 import Data.Maybe
 import Data.Text (Text)
 import Data.Text qualified as T
+import Data.Time.Format
 import Data.Time.LocalTime
 
 import Erebos.Identity
+import Erebos.Chatroom
 import Erebos.Message hiding (formatMessage)
 import Erebos.State
 import Erebos.Storage
 
 
 data Message = DirectMessageMessage DirectMessage Bool
+             | ChatroomMessage ChatMessage Bool
 
 messageFrom :: Message -> ComposedIdentity
 messageFrom (DirectMessageMessage msg _) = msgFrom msg
+messageFrom (ChatroomMessage msg _) = cmsgFrom msg
 
+messageTime :: Message -> ZonedTime
+messageTime (DirectMessageMessage msg _) = msgTime msg
+messageTime (ChatroomMessage msg _) = cmsgTime msg
+
 messageText :: Message -> Maybe Text
 messageText (DirectMessageMessage msg _) = Just $ msgText msg
+messageText (ChatroomMessage msg _) = cmsgText msg
 
 messageUnread :: Message -> Bool
 messageUnread (DirectMessageMessage _ unread) = unread
+messageUnread (ChatroomMessage _ unread) = unread
 
 formatMessage :: TimeZone -> Message -> String
-formatMessage tzone (DirectMessageMessage msg _) = formatDirectMessage tzone msg
+formatMessage tzone msg = concat
+    [ formatTime defaultTimeLocale "[%H:%M] " $ utcToLocalTime tzone $ zonedTimeToUTC $ messageTime msg
+    , maybe "<unnamed>" T.unpack $ idName $ messageFrom msg
+    , maybe "" ((": "<>) . T.unpack) $ messageText msg
+    ]
 
 
 data Conversation = DirectMessageConversation DirectMessageThread
+                  | ChatroomConversation ChatroomState
 
 directMessageConversation :: MonadHead LocalState m => ComposedIdentity -> m Conversation
 directMessageConversation peer = do
@@ -54,8 +72,16 @@
         Just thread -> return $ DirectMessageConversation thread
         Nothing -> return $ DirectMessageConversation $ DirectMessageThread peer [] [] []
 
+chatroomConversation :: MonadHead LocalState m => ChatroomState -> m (Maybe Conversation)
+chatroomConversation rstate = chatroomConversationByStateData (head $ roomStateData rstate)
+
+chatroomConversationByStateData :: MonadHead LocalState m => Stored ChatroomStateData -> m (Maybe Conversation)
+chatroomConversationByStateData sdata = fmap ChatroomConversation <$> findChatroomByStateData sdata
+
 reloadConversation :: MonadHead LocalState m => Conversation -> m Conversation
 reloadConversation (DirectMessageConversation thread) = directMessageConversation (msgPeer thread)
+reloadConversation cur@(ChatroomConversation rstate) =
+    fromMaybe cur <$> chatroomConversation rstate
 
 lookupConversations :: MonadHead LocalState m => m [Conversation]
 lookupConversations = map DirectMessageConversation . toThreadList . lookupSharedValue . lsShared . fromStored <$> getLocalHead
@@ -63,13 +89,17 @@
 
 conversationName :: Conversation -> Text
 conversationName (DirectMessageConversation thread) = fromMaybe (T.pack "<unnamed>") $ idName $ msgPeer thread
+conversationName (ChatroomConversation rstate) = fromMaybe (T.pack "<unnamed>") $ roomName =<< roomStateRoom rstate
 
 conversationPeer :: Conversation -> Maybe ComposedIdentity
 conversationPeer (DirectMessageConversation thread) = Just $ msgPeer thread
+conversationPeer (ChatroomConversation _) = Nothing
 
 conversationHistory :: Conversation -> [Message]
 conversationHistory (DirectMessageConversation thread) = map (\msg -> DirectMessageMessage msg False) $ threadToList thread
+conversationHistory (ChatroomConversation rstate) = map (\msg -> ChatroomMessage msg False) $ roomStateMessages rstate
 
 
-sendMessage :: (MonadHead LocalState m, MonadError String m) => Conversation -> Text -> m Message
-sendMessage (DirectMessageConversation thread) text = DirectMessageMessage <$> (fromStored <$> sendDirectMessage (msgPeer thread) text) <*> pure False
+sendMessage :: (MonadHead LocalState m, MonadError String m) => Conversation -> Text -> m (Maybe Message)
+sendMessage (DirectMessageConversation thread) text = fmap Just $ DirectMessageMessage <$> (fromStored <$> sendDirectMessage (msgPeer thread) text) <*> pure False
+sendMessage (ChatroomConversation rstate) text = sendChatroomMessage rstate text >> return Nothing
diff --git a/src/Erebos/Network.hs b/src/Erebos/Network.hs
--- a/src/Erebos/Network.hs
+++ b/src/Erebos/Network.hs
@@ -301,10 +301,11 @@
 
             forkServerThread server $ forever $ do
                 (paddr, msg) <- readFlowIO serverRawPath
-                case paddr of
-                    DatagramAddress addr -> void $ S.sendTo sock msg addr
+                handle (\(e :: IOException) -> atomically . logd $ "failed to send packet to " ++ show paddr ++ ": " ++ show e) $ do
+                    case paddr of
+                        DatagramAddress addr -> void $ S.sendTo sock msg addr
 #ifdef ENABLE_ICE_SUPPORT
-                    PeerIceSession ice   -> iceSend ice msg
+                        PeerIceSession ice   -> iceSend ice msg
 #endif
 
             forkServerThread server $ forever $ do
@@ -922,6 +923,9 @@
             w <- peekElemOff ptr i
             if w == 0 then return []
                       else (SockAddrInet port w:) <$> parse (i + 1)
-    addrs <- parse 0
-    cFree ptr
-    return addrs
+    if ptr == nullPtr
+      then return []
+      else do
+        addrs <- parse 0
+        cFree ptr
+        return addrs
diff --git a/src/Erebos/Network/Protocol.hs b/src/Erebos/Network/Protocol.hs
--- a/src/Erebos/Network/Protocol.hs
+++ b/src/Erebos/Network/Protocol.hs
@@ -68,7 +68,10 @@
 protocolVersions :: [Text]
 protocolVersions = [protocolVersion]
 
+keepAliveInternal :: TimeSpec
+keepAliveInternal = fromNanoSecs $ 30 * 10^(9 :: Int)
 
+
 data TransportPacket a = TransportPacket TransportHeader [a]
 
 data TransportHeader = TransportHeader [TransportHeaderItem]
@@ -186,6 +189,7 @@
     , cReservedPackets :: TVar Int
     , cSentPackets :: TVar [SentPacket]
     , cToAcknowledge :: TVar [Integer]
+    , cNextKeepAlive :: TVar (Maybe TimeSpec)
     , cInStreams :: TVar [(Word8, Stream)]
     , cOutStreams :: TVar [(Word8, Stream)]
     }
@@ -440,7 +444,7 @@
     mStorage <- memoryStorage
     gStorage <- derivePartialStorage mStorage
 
-    startTime <- getTime MonotonicRaw
+    startTime <- getTime Monotonic
     gNowVar <- newTVarIO startTime
     gNextTimeout <- newTVarIO startTime
     gInitConfig <- store mStorage $ (Rec [] :: Object)
@@ -448,7 +452,7 @@
     let gs = GlobalState {..}
 
     let signalTimeouts = forever $ do
-            now <- getTime MonotonicRaw
+            now <- getTime Monotonic
             next <- atomically $ do
                 writeTVar gNowVar now
                 readTVar gNextTimeout
@@ -487,6 +491,7 @@
     cReservedPackets <- newTVar 0
     cSentPackets <- newTVar []
     cToAcknowledge <- newTVar []
+    cNextKeepAlive <- newTVar Nothing
     cInStreams <- newTVar []
     cOutStreams <- newTVar []
     let conn = Connection {..}
@@ -548,6 +553,7 @@
 
                 Nothing -> throwError "empty packet"
 
+        now <- getTime Monotonic
         runExceptT parse >>= \case
             Right (Left (secure, objs, mbcounter))
                 | hobj:content <- objs
@@ -562,6 +568,7 @@
                             case mbup of
                                 Just up -> putTMVar gNextUp (conn, (secure, up))
                                 Nothing -> return ()
+                            updateKeepAlive conn now
                             processAcknowledgements gs conn items
                         ioAfter
                     Nothing -> return ()
@@ -571,8 +578,9 @@
                       gLog $ show objs
 
             Right (Right (snum, seq8, content, counter))
-                | Just Connection {..} <- mbconn
+                | Just conn@Connection {..} <- mbconn
                 -> atomically $ do
+                    updateKeepAlive conn now
                     (lookup snum <$> readTVar cInStreams) >>= \case
                         Nothing ->
                             gLog $ "unexpected stream number " ++ show snum
@@ -713,9 +721,9 @@
     return $ ReservedToSend Nothing (return ()) (atomically $ connClose conn)
 
 resendBytes :: Connection addr -> Maybe ReservedToSend -> SentPacket -> IO ()
-resendBytes Connection {..} reserved sp = do
+resendBytes conn@Connection {..} reserved sp = do
     let GlobalState {..} = cGlobalState
-    now <- getTime MonotonicRaw
+    now <- getTime Monotonic
     atomically $ do
         when (isJust reserved) $ do
             modifyTVar' cReservedPackets (subtract 1)
@@ -726,6 +734,7 @@
                 , spRetryCount = spRetryCount sp + 1
                 }
         writeFlow gDataFlow (cAddress, spData sp)
+        updateKeepAlive conn now
 
 sendBytes :: Connection addr -> Maybe ReservedToSend -> ByteString -> IO ()
 sendBytes conn reserved bs = resendBytes conn reserved
@@ -738,6 +747,12 @@
         , spData = bs
         }
 
+updateKeepAlive :: Connection addr -> TimeSpec -> STM ()
+updateKeepAlive Connection {..} now = do
+    let next = now + keepAliveInternal
+    writeTVar cNextKeepAlive $ Just next
+
+
 processOutgoing :: forall addr. GlobalState addr -> STM (IO ())
 processOutgoing gs@GlobalState {..} = do
 
@@ -777,11 +792,12 @@
                 let onAck = sequence_ $ map (streamAccepted conn) $
                         catMaybes (map (\case StreamOpen n -> Just n; _ -> Nothing) hitems)
 
-                let mkPlain extraHeaders =
-                        let header = TransportHeader $ map AcknowledgedSingle acknowledge ++ extraHeaders ++ hitems
-                         in BL.concat $
-                            (serializeObject $ transportToObject gStorage header)
-                            : map lazyLoadBytes content
+                let mkPlain extraHeaders
+                        | combinedHeaderItems@(_:_) <- map AcknowledgedSingle acknowledge ++ extraHeaders ++ hitems =
+                             BL.concat $
+                                (serializeObject $ transportToObject gStorage $ TransportHeader combinedHeaderItems)
+                                : map lazyLoadBytes content
+                        | otherwise = BL.empty
 
                 let usePlaintext = do
                         plain <- mkPlain <$> generateCookieHeaders conn channel
@@ -811,6 +827,13 @@
                         sendBytes conn mbReserved' bs
                     Nothing -> return ()
 
+    let waitUntil :: TimeSpec -> TimeSpec -> STM ()
+        waitUntil now till = do
+            nextTimeout <- readTVar gNextTimeout
+            if nextTimeout <= now || till < nextTimeout
+               then writeTVar gNextTimeout till
+               else retry
+
     let retransmitPacket :: Connection addr -> STM (IO ())
         retransmitPacket conn@Connection {..} = do
             now <- readTVar gNowVar
@@ -819,11 +842,8 @@
                 _         -> retry
             let nextTry = spTime sp + fromNanoSecs 1000000000
             if | now < nextTry -> do
-                    nextTimeout <- readTVar gNextTimeout
-                    if nextTimeout <= now || nextTry < nextTimeout
-                       then do writeTVar gNextTimeout nextTry
-                               return $ return ()
-                       else retry
+                    waitUntil now nextTry
+                    return $ return ()
                | spRetryCount sp < 2 -> do
                     reserved <- reservePacket conn
                     writeTVar cSentPackets rest
@@ -863,11 +883,27 @@
                 writeTVar gIdentity (nid, cur : past)
                 return $ return ()
 
+    let sendKeepAlive :: Connection addr -> STM (IO ())
+        sendKeepAlive Connection {..} = do
+            readTVar cNextKeepAlive >>= \case
+                Nothing -> retry
+                Just next -> do
+                    now <- readTVar gNowVar
+                    if next <= now
+                      then do
+                        identity <- fst <$> readTVar gIdentity
+                        let header = TransportHeader [ AnnounceSelf $ refDigest $ storedRef $ idData identity ]
+                        writeTQueue cSecureOutQueue (EncryptedOnly, TransportPacket header [], [])
+                      else do
+                        waitUntil now next
+                    return $ return ()
+
     conns <- readTVar gConnections
     msum $ concat $
         [ map retransmitPacket conns
         , map sendNextPacket conns
         , [ handleControlRequests ]
+        , map sendKeepAlive conns
         ]
 
 processAcknowledgements :: GlobalState addr -> Connection addr -> [TransportHeaderItem] -> STM (IO ())
diff --git a/src/Erebos/Network/ifaddrs.c b/src/Erebos/Network/ifaddrs.c
--- a/src/Erebos/Network/ifaddrs.c
+++ b/src/Erebos/Network/ifaddrs.c
@@ -1,5 +1,7 @@
 #include "ifaddrs.h"
 
+#ifndef _WIN32
+
 #include <arpa/inet.h>
 #include <ifaddrs.h>
 #include <net/if.h>
@@ -39,3 +41,51 @@
 	ret[count] = 0;
 	return ret;
 }
+
+#else // _WIN32
+
+#include <winsock2.h>
+#include <ws2tcpip.h>
+
+#pragma comment(lib, "ws2_32.lib")
+
+uint32_t * broadcast_addresses(void)
+{
+	uint32_t * ret = NULL;
+	SOCKET wsock = INVALID_SOCKET;
+
+	struct WSAData wsaData;
+	if (WSAStartup(MAKEWORD(2, 2), &wsaData) != 0)
+		return NULL;
+
+	wsock = WSASocket(AF_INET, SOCK_DGRAM, IPPROTO_UDP, NULL, 0, 0);
+	if (wsock == INVALID_SOCKET)
+		goto cleanup;
+
+	INTERFACE_INFO InterfaceList[32];
+	unsigned long nBytesReturned;
+
+	if (WSAIoctl(wsock, SIO_GET_INTERFACE_LIST, 0, 0,
+				InterfaceList, sizeof(InterfaceList),
+				&nBytesReturned, 0, 0) == SOCKET_ERROR)
+		goto cleanup;
+
+	int numInterfaces = nBytesReturned / sizeof(INTERFACE_INFO);
+
+	size_t capacity = 16, count = 0;
+	ret = malloc(sizeof(uint32_t) * capacity);
+
+	for (int i = 0; i < numInterfaces && count < capacity - 1; i++)
+		if (InterfaceList[i].iiFlags & IFF_BROADCAST)
+			ret[count++] = InterfaceList[i].iiBroadcastAddress.AddressIn.sin_addr.s_addr;
+
+	ret[count] = 0;
+cleanup:
+	if (wsock != INVALID_SOCKET)
+		closesocket(wsock);
+	WSACleanup();
+
+	return ret;
+}
+
+#endif
diff --git a/src/Erebos/Storage.hs b/src/Erebos/Storage.hs
--- a/src/Erebos/Storage.hs
+++ b/src/Erebos/Storage.hs
@@ -21,9 +21,11 @@
     headId, headStorage, headRef, headObject, headStoredObject,
     loadHeads, loadHead, reloadHead,
     storeHead, replaceHead, updateHead, updateHead_,
+    loadHeadRaw, storeHeadRaw, replaceHeadRaw,
 
     WatchedHead,
     watchHead, watchHeadWith, unwatchHead,
+    watchHeadRaw,
 
     MonadStorage(..),
 
@@ -62,7 +64,6 @@
 ) where
 
 import Control.Applicative
-import Control.Arrow
 import Control.Concurrent
 import Control.Exception
 import Control.Monad
@@ -72,6 +73,7 @@
 
 import Crypto.Hash
 
+import Data.Bifunctor
 import Data.ByteString (ByteString)
 import qualified Data.ByteArray as BA
 import qualified Data.ByteString as B
@@ -101,8 +103,8 @@
 import qualified Data.UUID.V4 as U
 
 import System.Directory
+import System.FSNotify
 import System.FilePath
-import System.INotify
 import System.IO.Error
 import System.IO.Unsafe
 
@@ -117,25 +119,30 @@
 
 openStorage :: FilePath -> IO Storage
 openStorage path = modifyIOError annotate $ do
-    let versionPath = path </> "erebos-storage"
-    doesFileExist versionPath >>= \case
-        True -> readFile versionPath >>= \case
-            content | (ver:_) <- lines content, ver == storageVersion -> return ()
-                    | otherwise -> fail "unsupported storage version"
+    let versionFileName = "erebos-storage"
+    let versionPath = path </> versionFileName
+    let writeVersionFile = writeFile versionPath $ storageVersion <> "\n"
+
+    doesDirectoryExist path >>= \case
+        True -> do
+            listDirectory path >>= \case
+                files@(_:_)
+                    | versionFileName `elem` files -> do
+                        readFile versionPath >>= \case
+                            content | (ver:_) <- lines content, ver == storageVersion -> return ()
+                                    | otherwise -> fail "unsupported storage version"
+
+                    | "objects" `notElem` files || "heads" `notElem` files -> do
+                        fail "directory is neither empty, nor an existing erebos storage"
+
+                _ -> writeVersionFile
         False -> do
-            doesDirectoryExist path >>= \case
-                True -> do
-                    listDirectory path >>= \case
-                        contents@(_:_) | "objects" `notElem` contents || "heads" `notElem` contents
-                            -> fail "directory is neither empty, nor an existing erebos storage"
-                        _ -> return ()
-                False -> do
-                    createDirectoryIfMissing True $ path
-            writeFile versionPath $ storageVersion <> "\n"
+            createDirectoryIfMissing True $ path
+            writeVersionFile
 
     createDirectoryIfMissing True $ path </> "objects"
     createDirectoryIfMissing True $ path </> "heads"
-    watchers <- newMVar ([], WatchList 1 [])
+    watchers <- newMVar (Nothing, [], WatchList 1 [])
     refgen <- newMVar =<< HT.new
     refroots <- newMVar =<< HT.new
     return $ Storage
@@ -431,57 +438,70 @@
     catMaybes . map toHead <$> readMVar theads
 
 loadHead :: forall a m. (HeadType a, MonadIO m) => Storage -> HeadID -> m (Maybe (Head a))
-loadHead s@(Storage { stBacking = StorageDir { dirPath = spath }}) hid = liftIO $ do
+loadHead st hid = fmap (Head hid . wrappedLoad) <$> loadHeadRaw st (headTypeID @a Proxy) hid
+
+loadHeadRaw :: forall m. MonadIO m => Storage -> HeadTypeID -> HeadID -> m (Maybe Ref)
+loadHeadRaw s@(Storage { stBacking = StorageDir { dirPath = spath }}) tid hid = liftIO $ do
     handleJust (guard . isDoesNotExistError) (const $ return Nothing) $ do
-        (h:_) <- BC.lines <$> B.readFile (headPath spath (headTypeID @a Proxy) hid)
+        (h:_) <- BC.lines <$> B.readFile (headPath spath tid hid)
         Just ref <- readRef s h
-        return $ Just $ Head hid $ wrappedLoad ref
-loadHead Storage { stBacking = StorageMemory { memHeads = theads } } hid = liftIO $ do
-    fmap (Head hid . wrappedLoad) . lookup (headTypeID @a Proxy, hid) <$> readMVar theads
+        return $ Just ref
+loadHeadRaw Storage { stBacking = StorageMemory { memHeads = theads } } tid hid = liftIO $ do
+    lookup (tid, hid) <$> readMVar theads
 
 reloadHead :: (HeadType a, MonadIO m) => Head a -> m (Maybe (Head a))
 reloadHead (Head hid (Stored (Ref st _) _)) = loadHead st hid
 
 storeHead :: forall a m. MonadIO m => HeadType a => Storage -> a -> m (Head a)
-storeHead st obj = liftIO $ do
+storeHead st obj = do
     let tid = headTypeID @a Proxy
-    hid <- HeadID <$> U.nextRandom
     stored <- wrappedStore st obj
+    hid <- storeHeadRaw st tid (storedRef stored)
+    return $ Head hid stored
+
+storeHeadRaw :: forall m. MonadIO m => Storage -> HeadTypeID -> Ref -> m HeadID
+storeHeadRaw st tid ref = liftIO $ do
+    hid <- HeadID <$> U.nextRandom
     case stBacking st of
          StorageDir { dirPath = spath } -> do
              Right () <- writeFileChecked (headPath spath tid hid) Nothing $
-                 showRef (storedRef stored) `B.append` BC.singleton '\n'
+                 showRef ref `B.append` BC.singleton '\n'
              return ()
          StorageMemory { memHeads = theads } -> do
-             modifyMVar_ theads $ return . (((tid, hid), storedRef stored) :)
-    return $ Head hid stored
+             modifyMVar_ theads $ return . (((tid, hid), ref) :)
+    return hid
 
 replaceHead :: forall a m. (HeadType a, MonadIO m) => Head a -> Stored a -> m (Either (Maybe (Head a)) (Head a))
 replaceHead prev@(Head hid pobj) stored' = liftIO $ do
     let st = headStorage prev
         tid = headTypeID @a Proxy
     stored <- copyStored st stored'
+    bimap (fmap $ Head hid . wrappedLoad) (const $ Head hid stored) <$>
+        replaceHeadRaw st tid hid (storedRef pobj) (storedRef stored)
+
+replaceHeadRaw :: forall m. MonadIO m => Storage -> HeadTypeID -> HeadID -> Ref -> Ref -> m (Either (Maybe Ref) Ref)
+replaceHeadRaw st tid hid prev new = liftIO $ do
     case stBacking st of
          StorageDir { dirPath = spath } -> do
              let filename = headPath spath tid hid
                  showRefL r = showRef r `B.append` BC.singleton '\n'
 
-             writeFileChecked filename (Just $ showRefL $ headRef prev) (showRefL $ storedRef stored) >>= \case
+             writeFileChecked filename (Just $ showRefL prev) (showRefL new) >>= \case
                  Left Nothing -> return $ Left Nothing
                  Left (Just bs) -> do Just oref <- readRef st $ BC.takeWhile (/='\n') bs
-                                      return $ Left $ Just $ Head hid $ wrappedLoad oref
-                 Right () -> return $ Right $ Head hid stored
+                                      return $ Left $ Just oref
+                 Right () -> return $ Right new
 
          StorageMemory { memHeads = theads, memWatchers = twatch } -> do
              res <- modifyMVar theads $ \hs -> do
                  ws <- map wlFun . filter ((==(tid, hid)) . wlHead) . wlList <$> readMVar twatch
                  return $ case partition ((==(tid, hid)) . fst) hs of
                      ([] , _  ) -> (hs, Left Nothing)
-                     ((_, r):_, hs') | r == storedRef pobj -> (((tid, hid), storedRef stored) : hs',
-                                                                  Right (Head hid stored, ws))
-                                     | otherwise -> (hs, Left $ Just $ Head hid $ wrappedLoad r)
+                     ((_, r):_, hs') | r == prev -> (((tid, hid), new) : hs',
+                                                                  Right (new, ws))
+                                     | otherwise -> (hs, Left $ Just r)
              case res of
-                  Right (h, ws) -> mapM_ ($ headRef h) ws >> return (Right h)
+                  Right (r, ws) -> mapM_ ($ r) ws >> return (Right r)
                   Left x -> return $ Left x
 
 updateHead :: (HeadType a, MonadIO m) => Head a -> (Stored a -> m (Stored a, b)) -> m (Maybe (Head a), b)
@@ -502,41 +522,46 @@
 watchHead h = watchHeadWith h id
 
 watchHeadWith :: forall a b. (HeadType a, Eq b) => Head a -> (Head a -> b) -> (b -> IO ()) -> IO WatchedHead
-watchHeadWith oh@(Head hid (Stored (Ref st _) _)) sel cb = do
+watchHeadWith (Head hid (Stored (Ref st _) _)) sel cb = do
+    watchHeadRaw st (headTypeID @a Proxy) hid (sel . Head hid . wrappedLoad) cb
+
+watchHeadRaw :: forall b. Eq b => Storage -> HeadTypeID -> HeadID -> (Ref -> b) -> (b -> IO ()) -> IO WatchedHead
+watchHeadRaw st tid hid sel cb = do
     memo <- newEmptyMVar
-    let tid = headTypeID @a Proxy
-        addWatcher wl = (wl', WatchedHead st (wlNext wl) memo)
+    let addWatcher wl = (wl', WatchedHead st (wlNext wl) memo)
             where wl' = wl { wlNext = wlNext wl + 1
                            , wlList = WatchListItem
                                { wlID = wlNext wl
                                , wlHead = (tid, hid)
                                , wlFun = \r -> do
-                                   let x = sel $ Head hid $ wrappedLoad r
+                                   let x = sel r
                                    modifyMVar_ memo $ \prev -> do
-                                       when (x /= prev) $ cb x
-                                       return x
+                                       when (Just x /= prev) $ cb x
+                                       return $ Just x
                                } : wlList wl
                            }
 
     watched <- case stBacking st of
-         StorageDir { dirPath = spath, dirWatchers = mvar } -> modifyMVar mvar $ \(ilist, wl) -> do
-             ilist' <- case lookup tid ilist of
-                 Just _ -> return ilist
-                 Nothing -> do
-                     inotify <- initINotify
-                     void $ addWatch inotify [Move] (BC.pack $ headTypePath spath tid) $ \case
-                         MovedIn { filePath = fpath } | Just ihid <- HeadID <$> U.fromASCIIBytes fpath -> do
-                             loadHead @a st ihid >>= \case
-                                 Just h -> mapM_ ($ headRef h) . map wlFun . filter ((== (tid, ihid)) . wlHead) . wlList . snd =<< readMVar mvar
+         StorageDir { dirPath = spath, dirWatchers = mvar } -> modifyMVar mvar $ \(mbmanager, ilist, wl) -> do
+             manager <- maybe startManager return mbmanager
+             ilist' <- case tid `elem` ilist of
+                 True -> return ilist
+                 False -> do
+                     void $ watchDir manager (headTypePath spath tid) (const True) $ \case
+                         Added { eventPath = fpath } | Just ihid <- HeadID <$> U.fromString (takeFileName fpath) -> do
+                             loadHeadRaw st tid ihid >>= \case
+                                 Just ref -> do
+                                     (_, _, iwl) <- readMVar mvar
+                                     mapM_ ($ ref) . map wlFun . filter ((== (tid, ihid)) . wlHead) . wlList $ iwl
                                  Nothing -> return ()
                          _ -> return ()
-                     return $ (tid, inotify) : ilist
-             return $ first (ilist',) $ addWatcher wl
+                     return $ tid : ilist
+             return $ first ( Just manager, ilist', ) $ addWatcher wl
 
          StorageMemory { memWatchers = mvar } -> modifyMVar mvar $ return . addWatcher
 
-    cur <- sel . maybe oh id <$> reloadHead oh
-    cb cur
+    cur <- fmap sel <$> loadHeadRaw st tid hid
+    maybe (return ()) cb cur
     putMVar memo cur
 
     return watched
diff --git a/src/Erebos/Storage/Internal.hs b/src/Erebos/Storage/Internal.hs
--- a/src/Erebos/Storage/Internal.hs
+++ b/src/Erebos/Storage/Internal.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE CPP #-}
-
 module Erebos.Storage.Internal where
 
 import Codec.Compression.Zlib
@@ -33,15 +31,15 @@
 import Foreign.Storable (peek)
 
 import System.Directory
+import System.FSNotify (WatchManager)
 import System.FilePath
-import System.INotify (INotify)
 import System.IO
 import System.IO.Error
 import System.IO.Unsafe (unsafePerformIO)
-import System.Posix.Files
-import System.Posix.IO
 
+import Erebos.Storage.Platform
 
+
 data Storage' c = Storage
     { stBacking :: StorageBacking c
     , stParent :: Maybe (Storage' Identity)
@@ -62,7 +60,7 @@
 
 data StorageBacking c
          = StorageDir { dirPath :: FilePath
-                      , dirWatchers :: MVar ([(HeadTypeID, INotify)], WatchList c)
+                      , dirWatchers :: MVar ( Maybe WatchManager, [ HeadTypeID ], WatchList c )
                       }
          | StorageMemory { memHeads :: MVar [((HeadTypeID, HeadID), Ref' c)]
                          , memObjs :: MVar (Map RefDigest BL.ByteString)
@@ -230,16 +228,7 @@
 openLockFile :: FilePath -> IO Handle
 openLockFile path = do
     createDirectoryIfMissing True (takeDirectory path)
-    fd <- retry 10 $
-#if MIN_VERSION_unix(2,8,0)
-        openFd path WriteOnly defaultFileFlags
-            { creat = Just $ unionFileModes ownerReadMode ownerWriteMode
-            , exclusive = True
-            }
-#else
-        openFd path WriteOnly (Just $ unionFileModes ownerReadMode ownerWriteMode) (defaultFileFlags { exclusive = True })
-#endif
-    fdToHandle fd
+    retry 10 $ createFileExclusive path
   where
     retry :: Int -> IO a -> IO a
     retry 0 act = act
@@ -249,34 +238,34 @@
 writeFileOnce :: FilePath -> BL.ByteString -> IO ()
 writeFileOnce file content = bracket (openLockFile locked)
     hClose $ \h -> do
-        fileExist file >>= \case
-            True  -> removeLink locked
+        doesFileExist file >>= \case
+            True  -> removeFile locked
             False -> do BL.hPut h content
                         hFlush h
-                        rename locked file
+                        renameFile locked file
     where locked = file ++ ".lock"
 
 writeFileChecked :: FilePath -> Maybe ByteString -> ByteString -> IO (Either (Maybe ByteString) ())
 writeFileChecked file prev content = bracket (openLockFile locked)
     hClose $ \h -> do
-        (prev,) <$> fileExist file >>= \case
+        (prev,) <$> doesFileExist file >>= \case
             (Nothing, True) -> do
                 current <- B.readFile file
-                removeLink locked
+                removeFile locked
                 return $ Left $ Just current
             (Nothing, False) -> do B.hPut h content
                                    hFlush h
-                                   rename locked file
+                                   renameFile locked file
                                    return $ Right ()
             (Just expected, True) -> do
                 current <- B.readFile file
                 if current == expected then do B.hPut h content
                                                hFlush h
-                                               rename locked file
+                                               renameFile locked file
                                                return $ return ()
-                                       else do removeLink locked
+                                       else do removeFile locked
                                                return $ Left $ Just current
             (Just _, False) -> do
-                removeLink locked
+                removeFile locked
                 return $ Left Nothing
     where locked = file ++ ".lock"
diff --git a/src/unix/Erebos/Storage/Platform.hs b/src/unix/Erebos/Storage/Platform.hs
new file mode 100644
--- /dev/null
+++ b/src/unix/Erebos/Storage/Platform.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE CPP #-}
+
+module Erebos.Storage.Platform (
+    createFileExclusive,
+) where
+
+import System.IO
+import System.Posix.Files
+import System.Posix.IO
+
+createFileExclusive :: FilePath -> IO Handle
+createFileExclusive path = fdToHandle =<< do
+#if MIN_VERSION_unix(2,8,0)
+    openFd path WriteOnly defaultFileFlags
+        { creat = Just $ unionFileModes ownerReadMode ownerWriteMode
+        , exclusive = True
+        }
+#else
+    openFd path WriteOnly (Just $ unionFileModes ownerReadMode ownerWriteMode) (defaultFileFlags { exclusive = True })
+#endif
diff --git a/src/windows/Erebos/Storage/Platform.hs b/src/windows/Erebos/Storage/Platform.hs
new file mode 100644
--- /dev/null
+++ b/src/windows/Erebos/Storage/Platform.hs
@@ -0,0 +1,13 @@
+module Erebos.Storage.Platform (
+    createFileExclusive,
+) where
+
+import Data.Bits
+
+import System.IO
+import System.Win32.File
+import System.Win32.Types
+
+createFileExclusive :: FilePath -> IO Handle
+createFileExclusive path = do
+    hANDLEToHandle =<< createFile path gENERIC_WRITE (fILE_SHARE_READ .|. fILE_SHARE_DELETE) Nothing cREATE_NEW fILE_ATTRIBUTE_NORMAL Nothing