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