1 {-# LANGUAGE CPP, OverloadedStrings #-}
    2 module Databrary.Warp
    3   ( runWarp
    4   ) where
    5 
    6 import Control.Applicative ((<|>))
    7 import qualified Data.ByteString.Char8 as BSC
    8 import Data.Monoid ((<>))
    9 import Data.Time (getCurrentTime)
   10 import Data.Version (showVersion)
   11 import qualified Network.Wai as Wai
   12 import qualified Network.Wai.Handler.Warp as Warp
   13 import qualified Network.Wai.Handler.WarpTLS as WarpTLS
   14 
   15 import Paths_databrary (version)
   16 import qualified Databrary.Store.Config as C
   17 import Databrary.Service.Types
   18 import Databrary.Service.Log
   19 
   20 -- | Runs any Wai.Application through warp with our preferred options plus our
   21 -- configuration. Also uses our pre-initialized logging capabilities.
   22 runWarp
   23     :: C.Config
   24     -- ^ Used to get tls and port info
   25     --
   26     -- TODO: Pass those things in explicitly
   27     -> Service
   28     -- ^ Uset to get logging capabilities.
   29     --
   30     -- TODO: Ditto
   31     -> Wai.Application
   32     -- ^ Any old Wai Application
   33     -> IO ()
   34 runWarp conf rc app =
   35   run (conf C.! "ssl.key") (oneOrMany $ conf C.! "ssl.cert")
   36     ( Warp.setPort (conf C.! "port")
   37     $ Warp.setTimeout 300
   38 #ifndef DEVEL
   39     $ Warp.setFdCacheDuration 300
   40     $ Warp.setFileInfoCacheDuration 300
   41 #endif
   42     $ Warp.setServerName (BSC.pack $ "databrary/" ++ showVersion version)
   43     $ Warp.setOnException (\req e -> do
   44       t <- getCurrentTime
   45       msg <- mapM (\q -> requestLog t q Nothing $ Warp.exceptionResponseForDebug e) req
   46       logMsg t (maybe id (\m -> (<>) (m <> "\n")) msg $ toLogStr $ show e) (serviceLogs rc))
   47     $ Warp.setHTTP2Disabled
   48     $ Warp.defaultSettings)
   49     app
   50   where
   51   oneOrMany c = C.config c <|> return <$> C.config c
   52   run (Just k) (Just (cert:chain)) = WarpTLS.runTLS (WarpTLS.tlsSettingsChain cert chain k)
   53   run _ _ = Warp.runSettings