Server.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}

module Nomyx.Api.Server where

import           Nomyx.Api.Api
import           Nomyx.Core.Types
import           Nomyx.Core.Profile
import           Nomyx.Language.Types
import           Servant
import           Servant
import qualified Network.Wai.Handler.Warp as Warp
import           Network.Wai.Middleware.Cors
import           Network.Wai
import           Control.Concurrent.STM
import           Control.Monad
import           Data.Monoid
import           Data.Typeable
import           Data.ByteString.Char8 hiding (putStrLn)
import           GHC.Generics

serveApi :: TVar Session -> IO ()
serveApi tv = do
   putStrLn "Starting Api on http://localhost:8001/"
   Warp.run 8001 $ myCors $ serveWithContext nomyxApi (basicAuthServerContext tv) (server tv)

-- | 'BasicAuthCheck' holds the handler we'll use to verify a username and password.
authCheck :: (TVar Session) -> BasicAuthCheck PlayerNumber
authCheck tv = BasicAuthCheck (authCheck' tv)

authCheck' :: (TVar Session) -> BasicAuthData -> IO (BasicAuthResult PlayerNumber)
authCheck' tv (BasicAuthData username password) = do
  s <- atomically $ readTVar tv
  mpn <- getPlayerNumber' (unpack username) s
  case mpn of
    Just pn -> return (Authorized pn)
    Nothing -> return Unauthorized

basicAuthServerContext :: TVar Session -> Context (BasicAuthCheck PlayerNumber ': '[])
basicAuthServerContext tv = (authCheck tv) :. EmptyContext
                                                                                     
customPolicy :: CorsResourcePolicy
customPolicy = simpleCorsResourcePolicy { corsMethods = simpleMethods <> ["DELETE", "PUT"] }

myCors :: Middleware
myCors = cors (const $ Just customPolicy)

putSwaggerYaml :: IO ()
putSwaggerYaml = undefined --BL.putStrLn $ encode $ toSwagger nomyxApi