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

module Minilang.App where

import Control.Concurrent.STM (TVar, atomically, newTVarIO, readTVar, writeTVar)
import Control.Exception (try)
import Control.Monad.Catch (MonadThrow (throwM))
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.Map (Map)
import qualified Data.Map as Map
import Data.Text (Text)
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, err400, errBody, (:<|>) (..))
import Servant.Server (Application, Handler (..), Server, Tagged (..))
import System.Random (StdGen)

data Env = Env
  { gen :: TVar StdGen,
    users :: TVar (Map Text Score)
  }

makeEnv :: StdGen -> IO Env
makeEnv gen =
  Env
    <$> newTVarIO gen
    <*> newTVarIO mempty

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@(User name) = do
  asks users
    >>= liftIO . atomically . \tvar -> do
      usersMap <- readTVar tvar
      case Map.lookup name usersMap of
        Just _ -> throwM $ err400 {errBody = "User already registered"}
        Nothing -> do
          let score = Score user 0 Nothing
          let updatedMap = Map.insert name score usersMap
          writeTVar tvar updatedMap
  bytes <- generateToken
  let tokenText = bytes
  pure $ Token tokenText

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

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

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