module Types
    ( Env(..)
    , Config(..)
    , ReqInfo(..)
    , Ctx(..)
    , EnvCtx(..)
    , EnvCtxAuth(..)
    , App(..)
    , Handler(..)
    , HandlerAuth(..)
    , HasEnv(..)
    , HasCtx(..)
    , HasUser(..)
    , HasAuth(..)
    , CanLog(..)
    , Server
    , Action
    , ActionAuth
    ) where

import qualified Database.SQLite.Simple.Internal as SQL (Connection)
import Web.Scotty.Trans (ActionT, ScottyT)
import Control.Monad.Reader (MonadReader, ReaderT, asks)
import Control.Monad.IO.Unlift (MonadUnliftIO(..))
import Colog (LogAction(..))
import Models
import qualified Data.Text as T
import qualified Data.ByteString as BS
import Control.Monad.IO.Class (liftIO, MonadIO)
import GHC.Stack
import Data.Aeson as JSON
import qualified Data.Aeson.Types as JSON
import Utils (logJson)
import qualified Data.Vault.Lazy as V

data Env = Env
    { db :: SQL.Connection
    , port :: Int
    , logAction :: LogAction IO BS.ByteString
    }

data Config = Config
    { env :: Env
    , reqInfoKey :: V.Key ReqInfo
    }

data ReqInfo = ReqInfo
    { reqId :: T.Text
    , user :: Maybe User
    }

data Ctx = Ctx
    { reqId :: T.Text
    , csrf :: T.Text
    , path :: T.Text
    }

data EnvCtx = EnvCtx
    { env :: Env
    , ctx :: Ctx
    , user :: Maybe User
    }

data EnvCtxAuth = EnvCtxAuth
    { env :: Env
    , ctx :: Ctx
    , user :: User
    }

newtype App a = App
    { runApp :: ReaderT Config IO a
    } deriving (Applicative, Functor, Monad,
                MonadIO, MonadReader Config, MonadUnliftIO)

newtype Handler a = Handler
    { runHandler :: ReaderT EnvCtx IO a
    } deriving (Applicative, Functor, Monad,
                MonadIO, MonadReader EnvCtx, MonadUnliftIO)

newtype HandlerAuth a = HandlerAuth
    { runHandler :: ReaderT EnvCtxAuth IO a
    } deriving (Applicative, Functor, Monad,
                MonadIO, MonadReader EnvCtxAuth, MonadUnliftIO)

sourceLoc :: CallStack -> T.Text
sourceLoc cs = showCallStack
  where
    showCallStack :: T.Text
    showCallStack = case getCallStack cs of
        []                             -> "<unknown loc>"
        [(name, loc)]                  -> showLoc name loc
        (_, _) : (callerName, loc) : _ -> showLoc callerName loc

    showLoc :: String -> SrcLoc -> T.Text
    showLoc name loc =
        T.pack loc.srcLocModule <> "." <> T.pack name <> ":" <> T.pack (show loc.srcLocStartLine)

class HasEnv m where
    getEnv :: m Env

instance HasEnv App where
    getEnv = asks (.env)

instance HasEnv Handler where
    getEnv = asks (.env)

instance HasEnv HandlerAuth where
    getEnv = asks (.env)

class Monad m => HasCtx m where
    getCtx :: m Ctx

instance HasCtx Handler where
    getCtx = asks (.ctx)

instance HasCtx HandlerAuth where
    getCtx = asks (.ctx)

class Monad m => HasUser m where
    getUser :: m (Maybe User)

    getUserId :: m (Maybe T.Text)
    getUserId = fmap (.id) <$> getUser

instance HasUser Handler where
    getUser = asks (.user)

instance HasUser HandlerAuth where
    getUser = do
        user <- asks (.user)
        return $ Just user

class (Monad m) => HasAuth m where
    getAuthUser :: m User
    getAuthUserId :: m T.Text
    getAuthUserId = fmap (.id) getAuthUser

instance HasAuth HandlerAuth where
    getAuthUser = asks (.user)
   
class (HasEnv m, MonadIO m) => CanLog m where
    logXd :: HasCallStack => T.Text -> m ()
    logXd msg = withFrozenCallStack $ do
        logger <- fmap (.logAction) getEnv
        ctx <- logCtx
        liftIO $ logJson logger $ ctx ++
            [ ("loc", JSON.toJSON $ sourceLoc callStack)
            , ("msg", JSON.toJSON msg)
            ]

    logCtx :: m [JSON.Pair]
    logCtx = return []

instance CanLog App
instance CanLog Handler where
    logCtx = logHandlerCtx
instance CanLog HandlerAuth where
    logCtx = logHandlerCtx

logHandlerCtx :: (HasCtx m, HasUser m) => m [JSON.Pair]
logHandlerCtx = do
    ctx <- getCtx
    userId <- getUserId
    return [ ("path", JSON.toJSON ctx.path)
           , ("reqId", JSON.toJSON ctx.reqId)
           , ("userId", JSON.toJSON userId)
           ]

type Server = ScottyT App ()

type Action a = ActionT Handler a
type ActionAuth a = ActionT HandlerAuth a