app.hs

app.hs

application :: MVar ServerState -> WS.Request -> WS.WebSockets WS.Hybi10 ()
application state rq = do
    WS.acceptRequest rq
    WS.getVersion >>= liftIO . putStrLn . ("Client version: " ++)
    sink <- WS.getSink
    msg <- WS.receiveData
    clients <- liftIO $ readMVar state
    url <- liftIO fbUrl

    let prefix = "Facebook code "
    let code = T.unpack $ T.drop (T.length prefix) msg
    e <- liftIO $ fbEmail $ (\(x,y) -> (C.pack x, C.pack y)) ("code", code)
    
    case e of
        Nothing -> WS.sendTextData ("Facebook login " `mappend` url :: Text)
        Just e -> do
            let client = (e, sink)
            if clientExists client clients
                then WS.sendTextData ("User already exists" :: Text)
                else do
                    liftIO $ modifyMVar_ state $ \s -> do
                        let s' = addClient client s
                        WS.sendSink sink $ WS.textData $
                            "Welcome! Users: " `mappend`
                            T.intercalate ", " (map fst s)
                        broadcast (fst client `mappend` " joined") s'
                        return s'
                    talk state client