<commit_before>{-# LANGUAGE Rank2Types #-}

module Server where

import           Control.Concurrent.STM (TChan)
import           Control.Monad.Trans (liftIO)
import           Data.Aeson (encode)
import           Data.ByteString.UTF8 (toString)
import qualified Data.Maybe as Maybe
import           Data.UUID (UUID)
import qualified Data.UUID as UUID
import           Network.HTTP.Types (status200)
import           Network.Wai
import qualified Network.Wai.Handler.Warp as Warp
import           Types

getPlayer :: Request -> IO (Maybe UUID)
getPlayer request = do
  let player = lookup "X-Player" $ requestHeaders request
  return $ UUID.fromString $ toString $ Maybe.fromJust player

-- FIXME: Error unless the player is given.
actionHandler :: TChan GameRequest -> Application
actionHandler chan request = do
  uuid <- liftIO $ getPlayer request
  let message = ActionMessage Move $ Maybe.fromJust uuid
  WorldViewMessage worldView <- liftIO $ chan `ask` message
  return $ responseLBS status200 [("Content-Type", "application/json")] $ encode $ worldView

application :: TChan GameRequest -> Application
application chan request =
  case pathInfo request of
    []         -> return $ ResponseFile status200 [("Content-Type", "text/html")] "static/index.html" Nothing
    ["action"] -> actionHandler chan request
    _          -> error "unexpected pathInfo"

run :: TChan GameRequest -> IO ()
run chan = Warp.run 8000 $ application chan<commit_msg>Handle missing header.<commit_after>{-# LANGUAGE Rank2Types #-}

module Server where

import           Control.Concurrent.STM (TChan)
import           Control.Monad.Trans (liftIO)
import           Control.Monad.Trans (liftIO)
import           Data.Aeson (encode, ToJSON)
import           Data.ByteString.Char8 (unpack)
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Maybe as Maybe
import           Data.UUID (UUID)
import qualified Data.UUID as UUID
import           Network.HTTP.Types (status200, status400)
import           Network.Wai
import qualified Network.Wai.Handler.Warp as Warp
import           Types

returnSuccess :: (Monad m, ToJSON a) => a -> m Response
returnSuccess value = return $ responseLBS status200 [("Content-Type", "application/json")] $ encode $ value

returnFailure :: Monad m => LBS.ByteString -> m Response
returnFailure value = return $ responseLBS status400 [("Content-Type", "text/plain")] value

getPlayer :: Request -> IO (Maybe UUID)
getPlayer request = do
  let player = lookup "X-Player" $ requestHeaders request
  return $ player >>= UUID.fromString . unpack

actionHandler :: TChan GameRequest -> Application
actionHandler chan request = do
  liftIO $ getPlayer request >>= Maybe.maybe fail ok
  where
    ok uuid = do
      let message = ActionMessage Move uuid
      WorldViewMessage worldView <- liftIO $ chan `ask` message
      returnSuccess worldView
    fail = returnFailure "Missing header X-Player"

application :: TChan GameRequest -> Application
application chan request =
  case pathInfo request of
    []         -> return $ ResponseFile status200 [("Content-Type", "text/html")] "static/index.html" Nothing
    ["action"] -> actionHandler chan request
    _          -> error "unexpected pathInfo"

run :: TChan GameRequest -> IO ()
run chan = Warp.run 8000 $ application chan
{'fraction_non_alphanumeric': 0.0923962435625568, 'fraction_numerical': 0.01090578612541654, 'mean_word_length': 3.2827496757457846, 'pattern_counts': {'":': 0, '<': 6, '<?xml version=': 0, '>': 25, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2302173', 'n_tokens_mistral': 927, 'n_tokens_neox': 884, 'n_words': 309}