{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ImplicitParams      #-}
{-# LANGUAGE NoPolyKinds         #-}
module Yam.Internal(
  -- * Application Functions
    startYam
  , start
  , App
  , module Yam.Logger
  , module Yam.Types
  , SwaggerConfig(..)
  -- * Utilities
  , throwS
  , readConf
  , getLogger
  ) where

import           Control.Exception          hiding (Handler)
import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.Salak                 as S
import qualified Data.Vault.Lazy            as L
import           GHC.Stack
import           Network.Wai.Handler.Warp   (run)
import           Servant.Swagger
import           System.IO.Unsafe           (unsafePerformIO)
import           Yam.Logger
import           Yam.Swagger
import           Yam.Trace
import           Yam.Types

type App = AppM IO

runApp :: LogFunc -> Env -> App a -> Handler a
runApp a b c = do
  res :: Either SomeException a <- liftIO $ try (runAppM a b c)
  case res of
    Left  e -> throwError $ fromMaybe err400 { errBody = B.pack $ show e } (fromException e :: Maybe ServantErr)
    Right r -> return r

throwS :: (HasCallStack, MonadIO m) => ServantErr -> Text -> AppM m a
throwS e msg = do
  logErrorCS ?callStack msg
  lift $ throw e

{-# NOINLINE loggerKey #-}
loggerKey :: Key LogFunc
loggerKey = unsafePerformIO newKey

getLogger :: Env -> Maybe LogFunc
getLogger env =
  let trace :: Maybe TraceLog = getAttr traceKey  env
      logger :: Maybe LogFunc = getAttr loggerKey env
      {-# INLINE nlf #-}
      nlf x (Just t) = addTrace x t
      nlf x _        = x
  in (`nlf` trace) <$> logger

startYam
  :: forall api. (HasSwagger api, HasServer api '[Env])
  => AppConfig
  -> SwaggerConfig
  -> LogConfig
  -> Bool
  -> [AppMiddleware]
  -> Proxy api
  -> ServerT api App
  -> IO ()
startYam ac@AppConfig{..} sw@SwaggerConfig{..} logConfig enableTrace middlewares proxy server
  = withLogger name logConfig $ do
      logInfo $ "Start Service [" <> name <> "] ..."
      logger <- askLoggerIO
      (runAM $ foldr1 (<>) (traceMiddleware enableTrace : middlewares)) (Env (L.insert loggerKey logger L.empty) Nothing ac) $ \(env, middleware) -> do
        let cxt                  = env :. EmptyContext
            pCxt                 = Proxy :: Proxy '[Env]
            portText             = showText port
            proxy'               = Proxy :: Proxy (Vault :> api)
            server'              = runRequest proxy pCxt server
        when enabled $
          logInfo $ "Swagger enabled: http://localhost:" <> portText <> "/" <> pack urlDir
        logInfo $ "Servant started on port(s): " <> portText
        lift $ run port
          $ middleware
          $ serveWithContextAndSwagger sw proxy' cxt
          $ hoistServerWithContext proxy' pCxt (runApp logger env) server'

runRequest :: (HasServer api context) => Proxy api -> Proxy context -> ServerT api App -> Vault -> ServerT api App
runRequest p pc a v = hoistServerWithContext p pc go a
  where
    {-# INLINE go #-}
    go :: App a -> App a
    go = withAppM (\(env,lf) -> let env' = env { reqAttributes = Just v} in (env', fromMaybe lf $ getLogger env'))

readConf :: (Default a, S.FromProperties a) => Text -> S.Properties -> a
readConf k p = fromMaybe def $ S.lookup k p

start
  :: forall api. (HasSwagger api, HasServer api '[Env])
  => S.Properties
  -> [AppMiddleware]
  -> Proxy api
  -> ServerT api App
  -> IO ()
start p middlewares proxy service = startYam
  (readConf "yam.application" p)
  (readConf "yam.swagger"     p)
  (readConf "yam.logging"     p)
  (fromMaybe True $ S.lookup "yam.trace.enabled" p)
  middlewares proxy service