{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NamedFieldPuns #-}
module Main where

import Network.Wai.Handler.Warp (run)
import Network.HTTP.Types.Status (badRequest400)
import Network.WebSockets (ServerApp, acceptRequest, defaultConnectionOptions)
import Network.Wai.Handler.WebSockets (websocketsOr)
import Network.Wai (responseLBS)
import Control.Monad.Reader (ReaderT(..), asks)
import Control.Concurrent (newMVar, modifyMVar)
import Control.Exception (finally)
import qualified Config (listenPort)
import qualified Player (openSession)
import qualified Server (disconnect, join, new)
import qualified Session (App, T(..), update)
import qualified Message (FromClient(..), broadcast, relay)
import qualified Automaton (start)

exit :: Session.App ()
exit = do
  asks Session.key >>= Session.update . Server.disconnect
  Message.relay Message.LogOut Message.broadcast

serverApp :: Session.App () -> Session.App () -> IO ServerApp
serverApp onEnter onExit = do
  mServer <- newMVar Server.new
  return $ \pending -> do
    key <- acceptRequest pending
                 >>= return . Player.openSession
                 >>= modifyMVar mServer . Server.join
    let session = Session.T {Session.mServer, Session.key}
    finally
      (runReaderT onEnter session)
      (runReaderT onExit session)

main :: IO ()
main = do
  app <- serverApp Automaton.start exit
  run Config.listenPort $ websocketsOr defaultConnectionOptions app blockNonWS
  where
    blockNonWS _ = ( $ responseLBS badRequest400 [] "Use a websocket")