diff --git a/Config.hs b/Config.hs
new file mode 100644
--- /dev/null
+++ b/Config.hs
@@ -0,0 +1,120 @@
+{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances, TypeFamilies, FlexibleContexts, NoMonomorphismRestriction, CPP #-}
+
+module Config where
+
+import Control.Concurrent.STM
+import Control.Monad
+import Control.Monad.Reader
+import Data.ByteString as B
+import Data.ByteString.Lazy.Char8 as BLC
+import Data.Map.Strict as MS
+import Data.String.Class as S
+import Data.Text as Text
+import Data.Text.Encoding as E
+import Network.NineP
+import Network.NineP.File
+
+import Types
+
+class Configable a where
+	readcfg :: BLC.ByteString -> a
+	showcfg :: a -> BLC.ByteString
+
+instance Configable String where
+	readcfg = BLC.unpack
+	showcfg = BLC.pack
+instance Configable Text where
+	readcfg = E.decodeUtf8 . B.concat . toChunks
+	showcfg = fromChunks . (:[]) . E.encodeUtf8
+instance Configable Bool where
+	readcfg = Prelude.read . BLC.unpack	-- TODO
+	showcfg = BLC.pack . show
+instance Configable Integer where
+	readcfg = Prelude.read . BLC.unpack
+	showcfg = BLC.pack . show
+
+configTVarReadWith c acc = Just (liftM c . liftIO . readTVarIO . acc =<< ask)
+configTVarWriteWith c acc x = liftIO . atomically . flip writeTVar (c x) . acc =<< ask
+configTVarReadC = configTVarReadWith showcfg
+configTVarWriteC = configTVarWriteWith readcfg
+
+rwf n a b = (n, rwFile n a b)
+rwfc n a = rwf n (configTVarReadC a) (Just (configTVarWriteC a))
+
+configDir :: NineFile Hate
+configDir = boringDir "config" [
+		rwfc "server" server,
+		rwfc "username" username,
+		rwfc "password" password,
+		rwfc "resource" resource,
+		rwfc "muc_default_nick" muc_default_nick,
+		rwfc "muc_history_request" muc_history_request,
+		rwfc "status" status,
+		rwfc "stream_management" streamManagement,
+		rwfc "permit_all_certs" permitUnsafeCerts
+	]
+
+trimLn :: (Stringy s, Eq (StringCellChar s)) => s -> s
+trimLn s = maybe "" (\c -> if c == (S.fromChar '\n') then S.init s else s) $ S.safeLast s
+readVar :: TVar a -> Hate a
+readVar = liftIO . readTVarIO
+readVarH :: (GlobalState -> IO a) -> Hate a
+readVarH acc = do
+	s <- ask
+	liftIO $ acc s
+readSVar :: (Stringy a, Eq (StringCellChar a)) => TVar a -> Hate a
+readSVar = liftM trimLn . readVar
+writeVar v = liftIO . atomically . writeTVar v
+
+initState = do
+	st <- newTVarIO ""
+	ut <- newTVarIO ""
+	pt <- newTVarIO ""
+	priot <- newTVarIO ""
+	portt <- newTVarIO ""
+	rt <- newTVarIO ""
+	jnt <- newTVarIO "hatexmpp3"
+	jot <- newTVarIO ""
+	jvt <- newTVarIO ""
+	mdnt <- newTVarIO "hatexmpp3"
+	showt <- newTVarIO SNone
+	statust <- newTVarIO ""
+	streamManagementt <- newTVarIO False
+	permitUnsafeCertst <- newTVarIO False
+	mhrst <- newTVarIO (-1)
+	sesst <- newTVarIO undefined
+	featureStreamManagement3t <- newTVarIO False
+	logst <- newTVarIO MS.empty
+	mucst <- newTVarIO MS.empty
+	chatst <- newTVarIO MS.empty
+#ifdef UI_GTK
+	amt <- newTVarIO undefined
+	aut <- newTVarIO undefined
+#endif
+
+	return $ GlobalState
+		{ server = st
+		, username = ut
+		, password = pt
+		, priority = priot
+		, port = portt
+		, resource = rt
+		, jiv_name = jnt
+		, jiv_os = jot
+		, jiv_version = jvt
+		, muc_default_nick = mdnt
+		, showst = showt
+		, status = statust
+		, streamManagement = streamManagementt
+		, permitUnsafeCerts = permitUnsafeCertst
+		, muc_history_request = mhrst
+		, sess = sesst
+		, featureStreamManagement3 = featureStreamManagement3t
+		, logs = logst
+		, mucs = mucst
+		, chats = chatst
+#ifdef UI_GTK
+		, addMUCToRosterWindow = amt
+		, addUserToRosterWindow = aut
+#endif
+		}
diff --git a/GTK/Chat.hs b/GTK/Chat.hs
new file mode 100644
--- /dev/null
+++ b/GTK/Chat.hs
@@ -0,0 +1,104 @@
+{-# LANGUAGE OverloadedStrings #-}
+module GTK.Chat
+	( addChat
+	) where
+
+import Control.Concurrent.STM
+import Control.Monad.Loops
+import Control.Monad.Reader
+import Data.DateTime
+import qualified Data.Map.Strict as M
+import Data.Maybe
+import qualified Data.String.Class as S
+import Data.Text as T
+import Data.Time
+import Graphics.UI.Gtk
+import Network.Xmpp
+
+import Types
+
+renderMessage :: (UTCTime, Maybe Nickname, Msg) -> Text
+renderMessage (t, mn, m) = T.concat
+		[ "\n"
+		, S.fromString $ formatDateTime "[%T]" t
+		, "<"
+		, fromMaybe "" mn
+		, ">"
+		, m
+		]
+
+delChat :: TVar (M.Map Jid ChatHandler) -> Jid -> IO ()
+delChat chatv jid = do
+	atomically $ modifyTVar' chatv $ M.delete jid
+
+addChat :: Jid -> (Msg -> IO ()) -> Hate ()
+addChat jid message_cb = do
+	s <- ask
+	handler <- liftIO $ postGUISync $ do
+		w <- windowNew
+		set w [windowTitle := jidToText jid]
+		windowSetDefaultSize w 500 500
+		on w deleteEvent $ liftIO $ do
+			delChat (chats s) jid
+			pure False
+
+		logb <- textBufferNew Nothing
+		logv <- textViewNewWithBuffer logb
+		textViewSetWrapMode logv WrapWordChar
+		textViewSetEditable logv False
+		textViewSetCursorVisible logv False
+
+		inputb <- textBufferNew Nothing
+		inputv <- textViewNewWithBuffer inputb
+		textViewSetAcceptsTab inputv True
+		inputv `on` keyPressEvent $ inputKeyPressed inputb message_cb
+
+		logScroll <- scrolledWindowNew Nothing Nothing
+		scrolledWindowSetPolicy logScroll PolicyNever PolicyAutomatic
+		containerAdd logScroll logv
+
+		panels <- vPanedNew
+		panedPack1 panels logScroll True False
+		panedPack2 panels inputv True False
+
+		set w [ containerChild := panels ]
+		widgetShowAll w
+		Rectangle _ _ _ height <- widgetGetAllocation panels
+		panedSetPosition panels (round (0.9 * fromIntegral height))
+
+		-- wait for the widgets to pop up to catch the upcoming messages
+		whileM_ (fmap (> 0) eventsPending) $ mainIterationDo False
+	
+		pure (\entry -> postGUISync $ do
+			bufferAdd logb $ renderMessage entry
+			-- wait for the buffer to draw // https://stackoverflow.com/a/40917718/4095104
+			whileM_ (fmap (> 0) eventsPending) $ mainIterationDo False
+			-- scroll the log to the newly received message
+			ei <- textBufferGetEndIter logb
+			textViewScrollToIter logv ei 0 $ Just (1, 1)
+			pure ()
+			)
+	liftIO $ atomically $ modifyTVar (chats s) $ M.insert jid handler
+
+bufferGet :: TextBuffer -> IO Text
+bufferGet tb = do
+	si <- textBufferGetStartIter tb
+	ei <- textBufferGetEndIter tb
+	textBufferGetText tb si ei True
+
+bufferAdd :: TextBuffer -> Text -> IO ()
+bufferAdd tb s = do
+	ei <- textBufferGetEndIter tb
+	textBufferInsert tb ei s
+
+-- Keypress event handler
+inputKeyPressed inputb message_cb = do
+	key <- eventKeyName
+	mods <- eventModifier
+	liftIO $ if (key == "Return") && (notElem Shift mods)
+	then do
+		t <- bufferGet inputb
+		message_cb t
+		textBufferSetText inputb ("" :: Text)
+		return True
+	else return False
diff --git a/GTK/GTK.hs b/GTK/GTK.hs
new file mode 100644
--- /dev/null
+++ b/GTK/GTK.hs
@@ -0,0 +1,11 @@
+module GTK.GTK where
+
+import Control.Concurrent
+import Graphics.UI.Gtk
+
+initGTK :: IO ()
+initGTK = do
+	forkIO $ do
+		unsafeInitGUIForThreadedRTS
+		mainGUI
+	return ()
diff --git a/GTK/Roster.hs b/GTK/Roster.hs
new file mode 100644
--- /dev/null
+++ b/GTK/Roster.hs
@@ -0,0 +1,75 @@
+{-# LANGUAGE OverloadedStrings #-}
+module GTK.Roster
+	( spawnRosterWindow
+	) where
+
+import Control.Concurrent
+import Control.Concurrent.STM
+import Control.Monad.Reader
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Tree
+import Graphics.UI.Gtk hiding (eventKeyName, eventModifier)
+import qualified Graphics.UI.Gtk.ModelView as MView
+import Network.Xmpp as X
+
+import Types
+import GTK.Chat
+
+treeMUCIndex = 0
+treeUserIndex = 1
+
+data RosterTreeNode = MUCs | Users | JID X.MessageType Jid deriving (Eq, Show)
+
+defaultTree :: Forest RosterTreeNode
+defaultTree = [Node MUCs [], Node Users []]
+
+renderNode :: RosterTreeNode -> Text
+renderNode MUCs = "MUCs"
+renderNode Users = "Users"
+renderNode (JID _ jid) = jidToText jid
+
+spawnRosterWindow :: (X.MessageType -> Jid -> Text -> IO ()) -> Hate ()
+spawnRosterWindow sendMessage = do
+	s <- ask
+	addToRoster <- liftIO $ postGUISync $ do
+		w <- windowNew
+		set w [windowTitle := ("hatexmpp roster" :: Text)]
+		windowSetDefaultSize w 300 800
+
+		view <- MView.treeViewNew
+		treeViewSetHeadersVisible view False
+		store <- MView.treeStoreNew defaultTree
+		MView.treeViewSetModel view $ Just store
+
+		column <- MView.treeViewColumnNew
+		MView.treeViewAppendColumn view column
+		MView.treeViewColumnSetTitle column T.empty
+		cell <- cellRendererTextNew
+		MView.treeViewColumnPackStart column cell True
+		cellLayoutSetAttributes column cell store (\record -> [MView.cellText := renderNode record])
+
+		on view rowActivated $ \path _ -> do
+			val <- treeStoreGetValue store path
+			case val of
+				JID typ jid -> do
+					forkIO $ flip runHate s $ addChat jid (sendMessage typ jid)
+					pure ()
+				_ -> pure ()
+
+		scroll <- scrolledWindowNew Nothing Nothing
+		scrolledWindowSetPolicy scroll PolicyAutomatic PolicyAutomatic
+		containerAdd scroll view
+
+		containerAdd w scroll
+		widgetShowAll w
+		pure (\index typ jid -> postGUISync $ do
+			let path = [index]
+			pathIter <- treeModelGetIter store path
+			unusedIndex <- treeModelIterNChildren store pathIter
+			treeStoreInsert store path unusedIndex $ JID typ jid)
+	let addMUCToRoster = addToRoster treeMUCIndex GroupChat
+	let addUserToRoster = addToRoster treeUserIndex Chat
+	liftIO $ atomically $ do
+		writeTVar (addMUCToRosterWindow s) addMUCToRoster
+		writeTVar (addUserToRosterWindow s) addUserToRoster
diff --git a/HateXMPP.hs b/HateXMPP.hs
new file mode 100644
--- /dev/null
+++ b/HateXMPP.hs
@@ -0,0 +1,403 @@
+{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances, TypeFamilies, FlexibleContexts, CPP #-}
+
+module Main where
+
+import Control.Concurrent
+import Control.Concurrent.STM
+import Control.Exception
+import Control.Monad
+import Control.Monad.Reader
+import Control.Monad.Trans.Maybe
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString.Lazy.Char8 as BLC
+import Data.Default
+import Data.IORef
+import Data.List as L
+import qualified Data.Map as M
+import Data.Map.Strict (keys)
+import qualified Data.Map.Strict as MS
+import Data.Maybe
+import Data.String.Class (toText)
+import qualified Data.Text as T
+import Data.Time
+import Data.Word
+import Data.XML.Types as DXT
+import Network.NineP as NP
+import Network.NineP.Error
+import Network.NineP.File
+import Network.TLS
+import Network.Xmpp
+import Network.Xmpp.Extras.DateTime
+import Network.Xmpp.Extras.IQAvatar
+import Network.Xmpp.Extras.MUC
+import Network.Xmpp.Extras.VCardAvatar
+import Network.Xmpp.Internal hiding (priority, status)
+import qualified Network.Xmpp.IM.Presence as IMP
+import System.Console.GetOpt
+import System.Environment
+import System.Log.Logger
+import qualified Text.XML as TX
+
+import Config
+import Log
+import MUC
+import Types
+#ifdef UI_GTK
+import GTK.GTK
+import GTK.Chat
+import qualified GTK.Roster as GR
+#endif
+
+import Debug.Trace
+
+data Options = Options
+	{ oXMPPLogPrio :: Priority
+	, o9PLogPrio :: Priority
+	} deriving (Eq, Show)
+
+defaultOptions = Options
+	{ oXMPPLogPrio = WARNING
+	, o9PLogPrio = WARNING
+	}
+
+options :: [OptDescr (Options -> Options)]
+options =
+	[ Option ['d']	["debug-9p"]	(NoArg	(\o -> o { o9PLogPrio = DEBUG }))		"Debug 9P messages"
+	, Option ['v']	["verbose"]	(NoArg	(\o -> o { oXMPPLogPrio = DEBUG }))		"Be verbose on what's happening on the XMPP wire"
+	]
+
+getOpts :: IO (Options, [String])
+getOpts = do
+	args <- getArgs
+	pn <- getProgName
+	case getOpt Permute options args of
+		(o,n,[]  ) -> return (foldl (flip id) defaultOptions o, n)
+		(_,_,errs) -> ioError (userError (concat errs ++ usageInfo ("Usage: " ++ pn ++ " [options]") options))
+
+dbg = debugM "HateXMPP"
+
+catchXmpp :: Either XmppFailure Session -> IO Session
+catchXmpp = either throw return
+
+chatFileRead :: MessageType -> Jid -> Word64 -> Word32 -> Hate BLC.ByteString
+chatFileRead _ jid offset len = getLogLazyS jid (fromIntegral offset) (fromIntegral len)
+
+chatFileWrite :: MessageType -> Jid -> BL.ByteString -> Hate ()
+chatFileWrite typ jid text = do
+	s <- ask
+	se <- readVar $ sess s
+	liftIO $ do
+		result <- sendMsg se typ jid $ toText text
+		return $ either (throw . OtherError . show) (id) result
+
+chatFile jid = --simpleFile (T.unpack $ jidToText jid)
+	(rwFile (T.unpack $ jidToText jid) Nothing (Just $ chatFileWrite Chat jid)) { NP.read = chatFileRead Chat jid }
+
+vcAvatarRead jid = do
+	s <- ask
+	se <- readVar $ sess s
+	result <- liftIO $ askvCard jid se
+	liftIO $ traceIO $ show result
+	undefined
+vcAvatarWrite jid = undefined
+
+vcAvatarFile jid = rwFile "avatar" (Just $ vcAvatarRead jid) (Just $ vcAvatarWrite jid)
+
+vcardDir jid = (boringDir "vcard" []) {
+		getFiles = do
+			return [avatarFile jid],
+		descend = \name -> do
+			--maybe (throw $ ENoFile name) (return . chatFile) $
+				--jidFromText $ T.pack name
+			return $ vcAvatarFile jid
+	}
+
+avatarRead jid = do
+	s <- ask
+	se <- readVar $ sess s
+	result <- liftIO $ askIQAvatar jid se
+	liftIO $ traceIO $ show result
+	undefined
+avatarWrite jid = undefined
+
+avatarFile jid = rwFile "avatar" (Just $ avatarRead jid) (Just $ avatarWrite jid)
+
+rosterItem jid = (boringDir (T.unpack $ jidToText jid) []) {
+		getFiles = do
+			return [chatFile jid, vcardDir jid, avatarFile jid],
+		descend = \name -> do
+			case name of
+				"avatar" -> return $ avatarFile jid
+				"vcard" -> return $ vcardDir jid
+				_ -> maybe (throw $ ENoFile name) (return . chatFile) $
+					jidFromText $ T.pack name
+	}
+
+rosterDir :: NineFile Hate
+rosterDir = (boringDir "roster" []) {
+		getFiles = do
+			s <- ask
+			se <- readVar $ sess s
+			roster <- liftIO $ getRoster se
+			return $ fmap (rosterItem) $ keys $ items roster,
+		descend = \name -> do
+			s <- ask
+			se <- readVar $ sess s
+			maybe (throw $ ENoFile name) (return . rosterItem) $ do
+				jid <- jidFromText $ T.pack name
+				return jid
+	}
+
+readMUCChat jid = chatFileRead GroupChat jid
+writeMUCChat jid = chatFileWrite GroupChat jid
+
+mucChat jid = (rwFile "__chat" Nothing (Just $ writeMUCChat jid)) { NP.read = chatFileRead Chat jid }
+
+muc jid = boringDir (T.unpack $ jidToText jid) [("__chat", mucChat jid)]
+
+mucsmkdir name = do
+	s <- ask
+	se <- readVarH (readTVarIO . sess)
+	nick <- readVarH (readTVarIO . muc_default_nick)
+	let barejid = fromMaybe (throw EInval) $ jidFromText $ T.pack name
+	let (localp, domainp, _) = jidToTexts barejid
+	let jid = fromMaybe (throw EInval) $ jidFromTexts localp domainp (Just $ T.pack nick)
+#ifdef UI_GTK
+	-- TODO error reporting
+	let send text = sendMsg se GroupChat barejid text >> pure ()
+	addChat barejid send
+	add <- liftIO $ readTVarIO $ addMUCToRosterWindow s
+	liftIO $ add barejid
+#endif
+	historyRequestSeconds <- readVarH (readTVarIO . muc_history_request)
+	let historyRequest = if historyRequestSeconds < 0 then Nothing else Just $ def { mhrSeconds = Just historyRequestSeconds }
+	liftIO $ joinMUC jid historyRequest se
+	addMUC barejid nick
+	return $ muc barejid
+
+mucsDir :: NineFile Hate
+mucsDir = (boringDir "mucs" []) {
+		getFiles = do
+			s <- ask
+			ms <- readVar $ mucs s
+			return $ fmap (muc) $ keys ms,
+		descend = \name -> do
+			s <- ask
+			ms <- readVar $ mucs s
+			maybe (throw $ ENoFile name) (return . muc) $ do
+				jid <- jidFromText $ T.pack name
+				M.lookup jid ms
+				return jid,
+		create = \name perms -> if isDir perms then mucsmkdir name else throw EInval
+	}
+
+sendMsg se typ jid text = sendMessage ((simpleIM jid text) { messageType = typ }) se
+-- TODO error handling
+sendMsg_ se typ jid text = sendMsg se typ jid text >> pure ()
+
+sendRaw :: B.ByteString -> Session -> IO (Either XmppFailure ())
+sendRaw d s = semWrite (writeSemaphore s) d
+
+processOtherFeatures :: Session -> DXT.Element -> Hate ()
+processOtherFeatures _ e = do
+	s <- ask
+	forM_ (TX.nameNamespace $ DXT.elementName e) $ \ns -> do
+		case ns of
+			"urn:xmpp:sm:3" -> do
+				-- For client-to-server connections, the client MUST NOT attempt to enable stream management until after it has completed Resource Binding unless it is resuming a previous session (see Resumption).
+				writeVar (featureStreamManagement3 s) True
+			_ -> return ()
+
+handleReceivedMessage se from msg nick timestamp = do
+	s <- ask
+	let entry = (timestamp, nick, msg)
+#ifdef UI_GTK
+	chatHandlers <- liftIO $ readTVarIO $ chats s
+	let maybeChatWindow = MS.lookup from $ chatHandlers
+	let send text = sendMsg se Chat from text >> pure ()
+	when (isNothing maybeChatWindow) $ addChat from send
+	chatHandlers <- liftIO $ readTVarIO $ chats s
+	maybe (pure ()) (\handler -> liftIO $ handler entry) $ MS.lookup from $ chatHandlers
+#endif
+	putLog from msg nick timestamp
+
+receiver :: GlobalState -> Session -> IO ()
+receiver s se = flip runHate s $ forever $ do
+		(stanza, _) <- liftIO $ getStanza se
+		case stanza of
+			MessageS (Message id from to lang typ pld attr) -> void $ runMaybeT $ do
+					f <- MaybeT $ pure from
+					body <- MaybeT $ pure $ L.find (\DXT.Element { DXT.elementName = TX.Name n ns pre } -> n == "body") pld
+					let l = DXT.elementNodes body
+					content <- MaybeT $ pure $ L.find (const True) l
+					text <- case content of
+						DXT.NodeContent (ContentText t) -> pure t
+						_ -> mzero
+					now <- liftIO $ getCurrentTime
+					let delayed_ts = do
+						delaye <- L.find (\DXT.Element { DXT.elementName = TX.Name n ns pre } -> n == "delay") pld
+						stampa <- L.find (\(DXT.Name n ns pre, _) -> n == "stamp") $ DXT.elementAttributes delaye
+						content <- L.find (const True) $ snd stampa
+						t <- case content of
+							ContentText t -> pure t
+							_ -> mzero
+						fromDateTime $ T.unpack t :: Maybe UTCTime
+					let timestamp = fromMaybe now delayed_ts
+					let nick = if (typ == GroupChat)
+						then resourcepart f
+						else maybe (Just $ domainpart f) Just $ localpart f	-- TODO use nickname from roster
+					let saneFrom = if (typ == GroupChat)
+						then toBare f
+						else f
+					lift $ handleReceivedMessage se saneFrom text nick timestamp
+			PresenceS p@(Presence id from to lang typ pld attr) -> do
+				if L.null pld
+					then liftIO $ dbg $ show ("simple presence", from, typ)
+					else forM_ pld $ \e -> do
+						let en = DXT.elementName e
+						if TX.nameLocalName en == "x" && TX.nameNamespace en == Just "http://jabber.org/protocol/muc#user"
+							then liftIO $ dbg $ show ("a muc guy has changed presence", from, typ)
+							else liftIO $ dbg $ show ("unknown presence", from, typ, pld)
+			_ -> liftIO $ dbg $ show stanza
+
+connectS tsess = do
+	s <- ask
+	features <- liftIO $ getFeatures tsess
+	mapM_ (processOtherFeatures tsess) $ streamFeaturesOther features
+	-- Enable SM
+	sme <- readVar $ streamManagement s
+	when sme $ do
+		smf <- readVar $ featureStreamManagement3 s
+		when smf $ do
+			liftIO $ sendRaw "<enable xmlns='urn:xmpp:sm:3'/>" tsess
+			return ()
+	liftIO $ initRoster tsess
+	liftIO $ forkIO $ updateStatus tsess (status s) (mucs s)
+	writeVar (sess s) tsess
+	liftIO $ forkIO $ receiver s tsess
+
+updateStatus :: Session -> TVar String -> TVar MUCs -> IO ()
+updateStatus tsess statusVar mucsVar = do
+	initialStatus <- readTVarIO statusVar
+	let sendStatus s = do
+		let sendPresenceTo mjid = sendPresence (withIMPresence (def { IMP.status = Just $ toText s }) def { presenceTo = mjid }) tsess
+		sendPresenceTo Nothing
+		-- also send the presence update to all the MUCs we participate in
+		currentMUCs <- readTVarIO mucsVar
+		mapM_ (sendPresenceTo . Just) $ keys currentMUCs
+	void $ sendStatus initialStatus
+	fix (\again previousStatus -> do
+		changedStatus <- atomically $ do
+			newStatus <- readTVar statusVar
+			check (newStatus /= previousStatus)
+			pure newStatus
+		void $ sendStatus changedStatus
+		again changedStatus) initialStatus
+
+streamManagementPlugin :: IO Plugin
+streamManagementPlugin = do
+	stanzaReceivedCount <- newIORef 0 :: IO (IORef Word32)
+	return $ (\out -> return $ Plugin'
+		{ inHandler = \sta as -> do
+			modifyIORef' stanzaReceivedCount succ
+			case sta of
+				XmppNonza e -> do
+					case TX.nameLocalName $ DXT.elementName e of
+						"enabled" -> writeIORef stanzaReceivedCount 0
+						"r" -> do
+							h <- readIORef stanzaReceivedCount
+							out $ XmppNonza $ DXT.Element "a" [
+								("xmlns",	[DXT.ContentText "urn:xmpp:sm:3"]),
+								("h",		[DXT.ContentText $ T.pack $ show h])
+								] []
+							return ()
+						_ -> return ()
+				_ -> return ()
+			return [(sta, as)]
+		, outHandler = out
+		, onSessionUp = const $ return ()
+		})
+
+rosterHandler :: Roster -> RosterUpdate -> IO ()
+rosterHandler roster update = do
+	print "got roster"
+	print roster
+	print update
+
+rootmkdir "roster" = do
+		s <- ask
+		serv <- readSVar $ server s
+		user <- readSVar $ username s
+		pass <- readSVar $ password s
+		res <- readSVar $ resource s
+		unsafeCerts <- readVar $ permitUnsafeCerts s
+		sMP <- liftIO $ streamManagementPlugin
+		tsess <- liftIO (catchXmpp =<< session serv
+				(Just (\_ -> ([scramSha1 user Nothing pass]), if res == "" then Nothing else Just res))
+				(def	{
+						sessionStreamConfiguration = def {
+							tlsBehaviour = RequireTls,
+							tlsParams = if unsafeCerts
+								then xmppDefaultParams { clientHooks = def { onServerCertificate = \_ _ _ _ -> pure [] } }
+								else xmppDefaultParams
+						},
+						plugins = [sMP],
+						onRosterPush = Just rosterHandler,
+						onConnectionClosed = \sess why -> do
+							noticeM "HateXMPP" $ "Disconnected (" ++ show why ++ "). Reconnecting..."
+							_ <- reconnect' sess
+							flip runHate s $ do
+								connectS sess
+								rejoinMUCs
+							return ()
+					}))
+#ifdef UI_GTK
+		GR.spawnRosterWindow $ sendMsg_ tsess
+#endif
+		connectS tsess
+#ifdef UI_GTK
+		-- submit the initial roster data to GUI
+		add <- liftIO $ readTVarIO $ addUserToRosterWindow s
+		roster <- liftIO $ getRoster tsess
+		liftIO $ mapM_ add $ M.keys $ items roster
+#endif
+		return rosterDir
+
+rootmkdir "test" = do
+		s <- ask
+		se <- readVar $ sess s
+		liftIO $ Prelude.print =<< getRoster se
+		liftIO $ Prelude.print "loh"
+		throw $ ENotImplemented "test"
+rootmkdir _ = throw $ EInval
+
+initMain = do
+	(opts, _) <- getOpts
+	updateGlobalLogger "Pontarius.Xmpp" $ setLevel $ oXMPPLogPrio opts
+	updateGlobalLogger "Network.NineP" $ setLevel $ o9PLogPrio opts
+	updateGlobalLogger "HateXMPP" $ setLevel $ oXMPPLogPrio opts
+
+	a <- getEnv "HATEXMPP_ADDRESS"
+	state <- initState
+#ifdef UI_GTK
+	initGTK
+#endif
+
+	(rootdir, rootref) <- simpleDirectory "/" (throw $ EInval) rootmkdir
+	writeIORef rootref [("config", configDir), ("mucs", mucsDir)]
+	let ncfg = Config {
+		root = rootdir,
+		addr = a,
+		monadState = state
+	}
+	return (state, run9PServer ncfg)
+
+ghciMain = do
+	(state, runServer) <- initMain
+	forkIO $ runServer
+	return state
+
+main = do
+	(_, runServer) <- initMain
+	runServer
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,14 @@
+            DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE
+                    Version 2, December 2004
+
+ Copyright (C) 2004 Sam Hocevar
+  22 rue de Plaisance, 75014 Paris, France
+ Everyone is permitted to copy and distribute verbatim or modified
+ copies of this license document, and changing it is allowed as long
+ as the name is changed.
+
+            DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE
+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+  0. You just DO WHAT THE FUCK YOU WANT TO.
+
diff --git a/Log.hs b/Log.hs
new file mode 100644
--- /dev/null
+++ b/Log.hs
@@ -0,0 +1,127 @@
+{-# LANGUAGE OverloadedStrings, DoAndIfThenElse #-}
+
+module Log
+	( getLogLazyS
+	, initLog
+	, putLog
+	) where
+
+import Control.Concurrent.STM
+import Control.Monad.Reader
+import Data.ByteString as B
+import Data.ByteString.Lazy as BL
+import Data.Map.Strict as MS
+import Data.Maybe
+import Data.List as L
+import Data.Sequence as Seq
+import Data.String.Class as S
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Time
+import Network.Xmpp.Internal hiding (priority, status)
+
+import TByteVector as TBV
+import Types
+
+lookupLog :: Jid -> Hate (Maybe Log)
+lookupLog jid = do
+	s <- ask
+	l <- liftIO $ readTVarIO $ logs s
+	return $ MS.lookup jid l
+
+-- tabs are banned in JIDs as control characters, so they can be used as JID separators:
+-- https://tools.ietf.org/html/rfc6122#appendix-A.5
+-- https://tools.ietf.org/html/rfc3454#appendix-C.2.1
+-- NUL is banned in XML, so it can be used as a message separator
+showLog :: [LogEntry] -> Text
+showLog = T.unlines . L.map (\(t, mn, m) -> T.concat
+		[S.toText (show t)
+		, "\t"
+		, fromMaybe "" mn
+		, "\t"
+		, m
+		, "\0"])
+
+fillLogS :: Log -> IO ()
+fillLogS (Log tentries tunshown shown) = do
+	(newLogEntry, unshown) <- atomically $ do
+		entries <- readTVar tentries
+		unshown <- readTVar tunshown
+		maybe retry (\ent -> return (ent, unshown)) $ Seq.lookup unshown entries
+	TBV.append shown $ showLog [newLogEntry]
+	atomically $ writeTVar tunshown (unshown + 1)
+
+readLogLazyS :: Log -> Word -> Word -> IO BL.ByteString
+readLogLazyS log offset len = do
+	cached <- atomically $ TBV.read (shownLog log) offset len
+	if B.null cached
+	then do
+		fillLogS log
+		readLogLazyS log offset len
+	else return $ BL.fromStrict cached
+
+-- |Read the specific portion of the log, waiting for yet unavailable data
+getLogLazyS :: Jid -> Word -> Word -> Hate BL.ByteString
+getLogLazyS jid offset len = do
+	log <- lookupLog jid
+	liftIO $ maybe (return BL.empty) (\l -> readLogLazyS l offset len) log
+
+newLog :: IO Log
+newLog = do
+	le <- newTVarIO Seq.empty
+	idx <- newTVarIO 0
+	sl <- newTByteVector
+	return $ Log le idx sl
+
+-- |Create a jid-attached log if it doesn't exist yet
+initLog :: Jid -> Hate ()
+initLog j = do
+	s <- ask
+	newlog <- liftIO newLog
+	liftIO $ atomically $ do
+		ls <- readTVar $ logs s
+		when (isNothing $ MS.lookup j ls) $ do
+			writeTVar (logEntries newlog) $ Seq.empty
+			writeTVar (logs s) $ MS.insert j newlog ls
+
+
+putLog :: Jid -> Msg -> Maybe Nickname -> UTCTime -> Hate ()
+putLog j m mn t = do
+	s <- ask
+	--liftIO $ print (j, m, t)
+	--liftIO $ TIO.putStr $ putTkabberLog $ TkabberLog t j "" m 0
+	initLog j
+	liftIO $ atomically $ do
+		ls <- readTVar $ logs s
+		case MS.lookup j ls of
+			-- logs are never destroyed so fromJust always succeeds
+			Just (Log entries _ _) -> do
+				modifyTVar entries $ \seq -> seq |> (t, mn, m)
+
+data TkabberLog = TkabberLog {
+		timestamp :: UTCTime,
+		jid :: Jid,
+		nick :: Text,
+		body :: Msg,
+		me :: Int
+	}
+
+--getTkabberLog :: Text -> TkabberLog
+
+--putTkabberLog :: TkabberLog -> Text
+--putTkabberLog (TkabberLog ts jid nick body me) = T.concat [
+--		"timestamp ",
+--		T.pack $ formatTime defaultTimeLocale "%Y%m%dT%H%M%S" ts,
+--		" jid ",
+--		escape $ jidToText jid,
+--		" nick ",
+--		escape nick,
+--		" body ",
+--		escape body,
+--		" me ",
+--		T.pack $ show me,
+--		"\n"]
+--	where
+--		--escape t = if T.length t == 0 then "{}" else esc ' ' "\\\\ " $ esc '}' "\\}" $ esc '\n' "\\n" $ esc '\\' "\\\\" t
+--		escape t = if T.length t == 0 then "{}" else L.foldl (\it c -> esc c (T.pack $ '\\':'\\':c:[]) it) (esc '\n' "\\\\n" $ esc '\\' "\\\\\\\\" t) ("{}\" $[]" :: String)
+--		esc c e t = T.concat $ L.intersperse e $ T.split (== c) t
diff --git a/MUC.hs b/MUC.hs
new file mode 100644
--- /dev/null
+++ b/MUC.hs
@@ -0,0 +1,37 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module MUC where
+
+import Control.Concurrent.STM
+import Control.Exception
+import Control.Monad.Reader
+import Data.Default
+import qualified Data.Map.Strict as MS
+import Data.Maybe
+import qualified Data.Text as T
+import Network.Xmpp.Extras.MUC
+import Network.Xmpp.Internal hiding (priority, status)
+
+import Config
+import Log
+import Types
+
+addMUC :: Jid -> String -> Hate ()
+addMUC jid nick = do
+	initLog jid
+	s <- ask
+	liftIO $ atomically $ do
+		ms <- readTVar $ mucs s
+		writeTVar (mucs s) $ MS.insert jid (MUC nick) ms
+
+rejoinMUCs :: Hate ()
+rejoinMUCs = do
+	ms <- readVarH (readTVarIO . mucs)
+	se <- readVarH (readTVarIO . sess)
+	liftIO $ sequence_ $ map (\(barejid, (MUC nick)) -> do
+			let (localp, domainp, _) = jidToTexts barejid
+			let jid = (\x -> assert (isJust x) (fromJust x)) $ jidFromTexts localp domainp (Just $ T.pack nick)
+			joinMUC jid (Just $ def { mhrSeconds = Just 200 }) se
+			return ()
+		) $ MS.toList ms
+	-- TODO clear idea about how much of the history to request
diff --git a/Network/Xmpp/Extras/IQAvatar.hs b/Network/Xmpp/Extras/IQAvatar.hs
new file mode 100644
--- /dev/null
+++ b/Network/Xmpp/Extras/IQAvatar.hs
@@ -0,0 +1,15 @@
+-- |
+-- Stability   :  Ultra-Violence
+-- Portability :  I'm too young to die
+-- XEP-0008: IQ-Based Avatars
+
+{-# LANGUAGE OverloadedStrings #-}
+
+module Network.Xmpp.Extras.IQAvatar
+	( askIQAvatar
+	) where
+
+import Data.XML.Types as DXT
+import Network.Xmpp.Internal hiding (priority, status)
+
+askIQAvatar jid = sendIQ' Nothing (Just jid) Get Nothing (DXT.Element "query" [("xmlns", [DXT.ContentText "jabber:iq:avatar"])] []) []
diff --git a/Network/Xmpp/Extras/VCardAvatar.hs b/Network/Xmpp/Extras/VCardAvatar.hs
new file mode 100644
--- /dev/null
+++ b/Network/Xmpp/Extras/VCardAvatar.hs
@@ -0,0 +1,16 @@
+-- |
+-- Stability   :  Ultra-Violence
+-- Portability :  I'm too young to die
+-- XEP-0153: vCard-Based Avatars
+
+{-# LANGUAGE OverloadedStrings #-}
+
+module Network.Xmpp.Extras.VCardAvatar
+	( askvCard
+	) where
+
+import Data.XML.Types as DXT
+import Network.Xmpp.Internal hiding (priority, status)
+
+--askvCard :: Jid -> Session -> IO (Either XmppFailure IQResponse)
+askvCard jid = sendIQ' Nothing (Just jid) Get Nothing (DXT.Element "vCard" [("xmlns", [DXT.ContentText "vcard-temp"])] []) []
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,3 @@
+#!/usr/bin/env runhaskell
+> import Distribution.Simple
+> main = defaultMain
diff --git a/TByteVector.hs b/TByteVector.hs
new file mode 100644
--- /dev/null
+++ b/TByteVector.hs
@@ -0,0 +1,68 @@
+module TByteVector
+	( TByteVector
+	, newTByteVector
+	, append
+	, read
+	) where
+
+import Control.Concurrent.STM
+import Control.Monad
+import Data.ByteString as B hiding (append)
+import Data.Text as T hiding (append)
+import Data.Text.Encoding
+import Data.Vector.Unboxed.Mutable (IOVector)
+import qualified Data.Vector.Unboxed.Mutable as V
+import Data.Word
+import GHC.Conc
+import Prelude hiding (read)
+
+data TByteVector = TByteVector
+	{ usedLength :: TVar Word
+	, uVector :: TVar (IOVector Word8)
+	}
+
+newTByteVector :: IO TByteVector
+newTByteVector = do
+	ic <- newTVarIO 0
+	vec <- V.unsafeNew 0
+	v <- newTVarIO vec
+	return $ TByteVector
+		{ usedLength = ic
+		, uVector = v
+		}
+
+writeList :: IOVector Word8 -> Int -> [Word8] -> IO ()
+writeList _ _ [] = return ()
+writeList vec offset (x:xs) = do
+		V.unsafeWrite vec offset x
+		writeList vec (offset + 1) xs
+	
+toList :: IOVector Word8 -> IO [Word8]
+toList vec = if V.null vec then return [] else do
+	h <- V.unsafeRead vec 0
+	l <- toList $ V.tail vec
+	return $ h : l
+
+append :: TByteVector -> Text -> IO ()
+append (TByteVector _ v) str = do
+	vec <- atomically $ readTVar v
+	nv <- do
+		let veclen = V.length vec
+		let bs = encodeUtf8 str
+		let len = B.length bs
+		nv <- V.unsafeGrow vec len
+		let wordlist = B.unpack bs
+		writeList nv veclen wordlist
+		return nv
+	atomically $ writeTVar v nv
+
+read :: TByteVector -> Word -> Word -> STM ByteString
+read (TByteVector _ v) offset len = do
+	vec <- readTVar v
+	let veclen = V.length vec
+	let vecoffset = if offset > fromIntegral veclen then fromIntegral veclen else fromIntegral offset
+	let slicelen = if vecoffset + fromIntegral len > veclen then veclen - vecoffset else fromIntegral len
+	rv <- unsafeIOToSTM $ do
+		wordlist <- toList $ V.slice vecoffset slicelen vec
+		return $ B.pack wordlist
+	return rv
diff --git a/Types.hs b/Types.hs
new file mode 100644
--- /dev/null
+++ b/Types.hs
@@ -0,0 +1,69 @@
+{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances, TypeFamilies, FlexibleContexts, CPP #-}
+
+module Types where
+
+import Control.Concurrent.STM
+import Control.Monad.EmbedIO
+import Control.Monad.Reader
+import Data.Map.Strict as MS
+import Data.Sequence
+import Data.Text as Text
+import Data.Time.Clock
+import Network.Xmpp
+
+import TByteVector
+
+type Hate = ReaderT GlobalState IO
+type Nickname = Text
+type Msg = Text
+type LogEntry = (UTCTime, Maybe Nickname, Msg)
+type Logs = MS.Map Jid Log
+type MUCs = MS.Map Jid MUC
+type ChatHandler = LogEntry -> IO ()
+
+data Log = Log
+	{ logEntries :: TVar (Seq LogEntry)
+	, firstUnshownLogIdx :: TVar Int
+	, shownLog :: TByteVector
+	}
+
+runHate = runReaderT
+
+instance EmbedIO Hate where
+	type Content Hate = GlobalState
+	embed f = ask >>= liftIO . f
+	callback = runHate
+
+data ShowSt = SNone | SAway | SChat | SDND | SXA deriving Show
+
+data MUC = MUC
+	{ nick :: String
+	} deriving Show
+
+data GlobalState = GlobalState
+	{ server :: TVar String
+	, port :: TVar String
+	, username :: TVar Text
+	, password :: TVar Text
+	, resource :: TVar Text
+	, priority :: TVar String
+	, jiv_name :: TVar String
+	, jiv_os :: TVar String
+	, jiv_version :: TVar String
+	, muc_default_nick :: TVar String
+	, showst :: TVar ShowSt
+	, status :: TVar String
+	, streamManagement :: TVar Bool
+	, permitUnsafeCerts :: TVar Bool
+	, muc_history_request :: TVar Integer
+
+	, sess :: TVar Session
+	, featureStreamManagement3 :: TVar Bool
+	, logs :: TVar Logs
+	, mucs :: TVar MUCs
+	, chats :: TVar (MS.Map Jid ChatHandler)
+#ifdef UI_GTK
+	, addMUCToRosterWindow :: TVar (Jid -> IO ())
+	, addUserToRosterWindow :: TVar (Jid -> IO ())
+#endif
+	}
diff --git a/hatexmpp3.cabal b/hatexmpp3.cabal
new file mode 100644
--- /dev/null
+++ b/hatexmpp3.cabal
@@ -0,0 +1,66 @@
+Cabal-Version:  2.0
+Name:           hatexmpp3
+Version:        0
+Category:       Network
+Synopsis:       XMPP client with 9P and (optionally) GTK interfaces
+author:         Sergey Alirzaev
+Maintainer:     zl29ah@gmail.com
+License:        OtherLicense
+License-file:   LICENSE
+Build-Type:     Simple
+Tested-With:    GHC == 8.6.5
+
+Source-repository head
+  type:              git
+  location:          https://github.com/l29ah/hatexmpp3
+
+Source-repository this
+  type:              git
+  location:          https://github.com/l29ah/hatexmpp3
+  tag:               0
+
+flag gtk
+        default: True
+        manual: True
+
+Executable      hatexmpp
+        Main-is:        HateXMPP.hs
+        other-modules:
+                        Types
+                        Config
+                        Log
+                        MUC
+                        TByteVector
+                        Network.Xmpp.Extras.IQAvatar
+                        Network.Xmpp.Extras.VCardAvatar
+        ghc-options:    -W -fno-warn-tabs -threaded
+        default-language: Haskell2010
+        Build-depends:
+                        base >= 4 && < 5,
+                        pontarius-xmpp >= 0.4.5 && < 0.6,
+                        pontarius-xmpp-extras ^>= 0.1.0.4,
+                        Network-NineP >= 0.4 && < 0.5,
+                        bytestring >= 0.10 && < 0.11,
+                        hslogger >= 1.2.8 && < 1.4,
+                        stm >= 2.4.4 && < 2.6,
+                        mtl >= 2.2.1 && < 2.3,
+                        text >= 1.2.0.4 && < 1.3,
+                        string-class >= 0.1.6.4 && < 0.2,
+                        xml-types >= 0.3.4 && < 0.4,
+                        tls >= 1.2.18 && < 1.6,
+                        containers >= 0.5.6.2 && < 0.7,
+                        time >= 1.5.0.1 && < 1.11,
+                        transformers >= 0.4.2.0 && < 0.6,
+                        data-default >= 0.5.3 && < 0.8,
+                        xml-conduit >= 1.3.1 && < 1.10,
+                        vector >= 0.12.0.3 && < 0.13
+        if flag(gtk)
+                cpp-options: -DUI_GTK
+                build-depends:
+                        gtk3 ^>= 0.14,
+                        datetime ^>= 0.3.1,
+                        monad-loops ^>= 0.4.3
+                other-modules:
+                        GTK.Chat
+                        GTK.GTK
+                        GTK.Roster
