add framing protocol for websockets

1 files changed, 12 insertions, 3 deletions

diff --git a/Role/Developer.hs b/Role/Developer.hs
index 89f6ea9..4248591 100644
--- a/Role/Developer.hs
+++ b/Role/Developer.hs
@@ -19,14 +19,23 @@ import qualified Data.Text as T
 import Data.List
 
 run :: DeveloperOpts -> IO ()
-run os = runClientApp $ clientApp (ConnectMode (T.pack (debugUrl os))) developer
+run = run' developer . debugUrl
+
+run' :: (TChan (Message Entered) -> TChan (Message Seen) -> SessionID -> IO ()) -> UrlString -> IO ()
+run' runner url = runClientApp $ clientApp connect Developer userMessages runner
+  where
+	connect = ConnectMode (T.pack url)
+
+userMessages :: LogMessage -> Maybe (Message Seen)
+userMessages (User m) = Just m
+userMessages (Developer _) = Nothing
 
 developer :: TChan (Message Entered) -> TChan (Message Seen) -> SessionID -> IO ()
-developer ichan ochan _ = inRawMode $ withLogger "debug-me-developer.log" $ \logger -> do
+developer ichan ochan _ = withLogger "debug-me-developer.log" $ \logger -> do
 	devstate <- processSessionStart ochan logger
 	ok <- authUser ichan ochan devstate logger
 	if ok
-		then do
+		then inRawMode $ do
 			_ <- sendTtyInput ichan devstate logger
 				`concurrently` sendTtyOutput ochan devstate logger
 			return ()