{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}

module Minilang.App where

import Control.Concurrent.STM (TVar, atomically, readTVar, writeTVar)
import Control.Exception (try)
import Control.Monad.Except (ExceptT (..))
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Reader (MonadReader, ReaderT, ask, asks, runReaderT)
import qualified Data.ByteString.Base64 as Base64
import qualified Data.ByteString.Lazy as LBS
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Data.Time (getCurrentTime)
import Minilang.API (LambdaAPI, Score (..), Token (..), User (..), newToken)
import Network.Wai.Application.Static (defaultFileServerSettings, staticApp)
import Servant (ServerT, (:<|>) (..))
import Servant.Server (Application, Handler (..), Server, Tagged (..))
import System.Random (StdGen)

data Env = Env
  { gen :: TVar StdGen
  }

newtype AppM a = AppM {runAppM :: ReaderT Env IO a}
  deriving newtype (Functor, Applicative, Monad, MonadIO, MonadReader Env)

runApp :: Env -> AppM a -> Handler a
runApp env = Handler . ExceptT . try . flip runReaderT env . runAppM

lambdaApp :: (MonadIO m, MonadReader Env m) => ServerT LambdaAPI m
lambdaApp =
  registerUser
    :<|> getLeaderboard
    :<|> Tagged staticResources

registerUser :: (MonadReader Env m, MonadIO m) => User -> m Token
registerUser (User _name) = do
  bytes <-
    asks gen
      >>= liftIO . atomically . \tvar -> do
        genVal <- readTVar tvar
        let (tokenBytes, newGen) = newToken genVal
        writeTVar tvar newGen
        pure $ LBS.toStrict tokenBytes
  let tokenText = decodeUtf8 $ Base64.encode bytes
  pure $ Token tokenText

getLeaderboard :: (MonadIO m) => m [Score]
getLeaderboard = do
  now <- liftIO getCurrentTime
  pure [Score "Alice" 95 now, Score "Bob" 88 now]

-- | Serve static resources under `public/` directory
staticResources :: Application
staticResources = staticApp (defaultFileServerSettings "public")