Socketson.hs

{-# LANGUAGE OverloadedStrings #-}
module Network.Socketson where

-- data:
import Data.Aeson (ToJSON, FromJSON)
import Data.Serialize (Serialize)
import qualified Data.Text as T
-- wai, websockets, etc:
import Network.Wai.Handler.WebSockets (websocketsOr)
import Network.Wai.Handler.Warp (run)
import Network.Wai (responseLBS, Application)
import Network.WebSockets (defaultConnectionOptions)
import Network.HTTP.Types (status400)
-- intern:
import Network.Socketson.Protocol
import Network.Socketson.Report
import Network.Socketson.ServerState
-- concurent:
import Control.Concurrent.MVar
-- monads/transformers:
import Control.Monad.Trans.Either


{-| The warp-wai 'Application', based upon the socketson protocol. It is a 'ServerApp' which got lifted into a wai 'Application' with the `wai-websockets` handler. 'app' is basically 'socketsonapp' with a fall back, if a http request comes which isn't a websocket one.
-}
app :: (ToJSON sobj, FromJSON rcv, Serialize sessd)
                      => MVar ServerState
                      -> (Maybe sessd -> rcv -> EitherT String IO (Maybe sessd, Reaction sobj))
                      -> Application
app mstate pf = websocketsOr defaultConnectionOptions (socketsonapp mstate pf) backupApp
  where
    backupApp :: Application
    backupApp _ respond = respond $ responseLBS status400 [] "Not a WebSocket request"


{-| 'socketson' starts a warp-wai websockets server, based on the socketson protocol and given protocol function.

    socketson pathToSessionStore maxAllowedClients port protocolFunction
-}
socketson :: (ToJSON sobj, FromJSON rcv, Serialize sessd)
                      => FilePath
                      -- ^ path to session store
                      -> Int
                      -- ^ number of maximal connected clients
                      -> Int
                      -- ^ port where socketson listens
                      -> (Maybe sessd -> rcv -> EitherT String IO (Maybe sessd, Reaction sobj))
                      -- ^ protocol function
                      -> IO ()
socketson fp maxcl port pf =
  do st     <- newState fp maxcl
     mstate <- newMVar st
     eitherT (\e -> putStrLn $ "report failed: " ++ show e)
             (\_ -> return ())
             (report "<global>" (Info High $ "Socketson listens at ws://localhost:" `T.append` T.pack (show port)))
     run port (app mstate pf)