module Conduit
  ( ConduitOps(..)
  , PGConnOps(..)
  , EnvType(..)
  , JWTOps(..)
  , main
  ) where

import Conduit.App.Env (Env(..), EnvType(..))
import Conduit.App.Monad (runAppM)
import Conduit.DB.Init (PGConnOps(..), initDB, mkDBPool)
import Conduit.Features.Account.Handlers qualified as Account
import Conduit.Features.Articles.Handlers qualified as Articles
import Conduit.Identity.JWT (JWTOps(..), mkJWTInfo)
import Database.PostgreSQL.Simple (SqlError)
import Network.HTTP.Types (status500)
import Network.Wai.Middleware.RequestLogger (logStdout, logStdoutDev)
import Network.Wai.Middleware.Static (CachingStrategy(..), addBase, cacheContainer, hasPrefix, initCaching, staticPolicyWithOptions)
import Network.Wai.Middleware.Static qualified as Static
import Web.Scotty.Trans (Handler(..), defaultHandler, middleware, scottyT, status)

data ConduitOps = ConduitOps
  { ConduitOps -> Int
port      :: Int
  , ConduitOps -> PGConnOps
dbConnOps :: PGConnOps
  , ConduitOps -> JWTOps
jwtOps    :: JWTOps
  , ConduitOps -> EnvType
envType   :: EnvType
  }

main :: ConduitOps -> IO ()
main :: ConduitOps -> IO ()
main ConduitOps {Int
JWTOps
PGConnOps
EnvType
$sel:port:ConduitOps :: ConduitOps -> Int
$sel:dbConnOps:ConduitOps :: ConduitOps -> PGConnOps
$sel:jwtOps:ConduitOps :: ConduitOps -> JWTOps
$sel:envType:ConduitOps :: ConduitOps -> EnvType
port :: Int
dbConnOps :: PGConnOps
jwtOps :: JWTOps
envType :: EnvType
..} = do
  Env
env <- IO Env
defaultEnv
  let runAppToIO :: AppM Response -> IO Response
runAppToIO AppM Response
m = ReaderT Env IO Response -> Env -> IO Response
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (AppM Response -> ReaderT Env IO Response
forall a. AppM a -> ReaderT Env IO a
runAppM AppM Response
m) Env
env

  String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [String
"Running in '", EnvType -> String
forall b a. (Show a, IsString b) => a -> b
show Env
env.envType, String
"'"]

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Env
env.envType EnvType -> EnvType -> Bool
forall a. Eq a => a -> a -> Bool
== EnvType
Development) do
    DBPool -> PGConnOps -> IO ()
forall (m :: * -> *).
MonadUnliftIO m =>
DBPool -> PGConnOps -> m ()
initDB Env
env.envDBPool PGConnOps
dbConnOps

  CacheContainer
cache <- CachingStrategy -> IO CacheContainer
initCaching CachingStrategy
PublicStaticCaching

  Int -> (AppM Response -> IO Response) -> ScottyT AppM () -> IO ()
forall (m :: * -> *) (n :: * -> *).
(Monad m, MonadIO n) =>
Int -> (m Response -> IO Response) -> ScottyT m () -> n ()
scottyT Int
port AppM Response -> IO Response
runAppToIO do
    ErrorHandler AppM -> ScottyT AppM ()
forall (m :: * -> *). Monad m => ErrorHandler m -> ScottyT m ()
defaultHandler (ErrorHandler AppM -> ScottyT AppM ())
-> ErrorHandler AppM -> ScottyT AppM ()
forall a b. (a -> b) -> a -> b
$ (SqlError -> ActionT AppM ()) -> ErrorHandler AppM
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler \(SqlError
e :: SqlError) -> do -- temp for debugging reasons
      SqlError -> ActionT AppM ()
forall a (m :: * -> *). (MonadIO m, Show a) => a -> m ()
print SqlError
e ActionT AppM () -> ActionT AppM () -> ActionT AppM ()
forall a b. ActionT AppM a -> ActionT AppM b -> ActionT AppM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Status -> ActionT AppM ()
forall (m :: * -> *). MonadIO m => Status -> ActionT m ()
status Status
status500
    
    Middleware -> ScottyT AppM ()
forall (m :: * -> *). Middleware -> ScottyT m ()
middleware (Middleware -> ScottyT AppM ()) -> Middleware -> ScottyT AppM ()
forall a b. (a -> b) -> a -> b
$ EnvType -> Middleware
loggerFor Env
env.envType

    Middleware -> ScottyT AppM ()
forall (m :: * -> *). Middleware -> ScottyT m ()
middleware (Middleware -> ScottyT AppM ()) -> Middleware -> ScottyT AppM ()
forall a b. (a -> b) -> a -> b
$ Options -> Policy -> Middleware
staticPolicyWithOptions (CacheContainer -> Options
staticOps CacheContainer
cache) Policy
policy
    
    ScottyT AppM ()
applicationHandlers
  where
    defaultEnv :: IO Env
defaultEnv = DBPool -> JWTInfo -> EnvType -> Env
Env
      (DBPool -> JWTInfo -> EnvType -> Env)
-> IO DBPool -> IO (JWTInfo -> EnvType -> Env)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PGConnOps -> IO DBPool
forall (m :: * -> *). MonadIO m => PGConnOps -> m DBPool
mkDBPool PGConnOps
dbConnOps
      IO (JWTInfo -> EnvType -> Env) -> IO JWTInfo -> IO (EnvType -> Env)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JWTInfo -> IO JWTInfo
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JWTOps -> JWTInfo
mkJWTInfo JWTOps
jwtOps)
      IO (EnvType -> Env) -> IO EnvType -> IO Env
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EnvType -> IO EnvType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EnvType
envType

    loggerFor :: EnvType -> Middleware
loggerFor = \case
      EnvType
Development -> Middleware
logStdoutDev
      EnvType
_ -> Middleware
logStdout

    applicationHandlers :: ScottyT AppM ()
applicationHandlers = [ScottyT AppM ()] -> ScottyT AppM ()
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
      [ ScottyT AppM ()
Account.handlers
      , ScottyT AppM ()
Articles.handlers
      ]

    staticOps :: CacheContainer -> Options
staticOps CacheContainer
container = Options
Static.defaultOptions
      { cacheContainer :: CacheContainer
cacheContainer = CacheContainer
container
      }

    policy :: Policy
policy = String -> Policy
hasPrefix String
"images" Policy -> Policy -> Policy
forall a. Semigroup a => a -> a -> a
<> String -> Policy
addBase String
"static"