module Main (main) where import Data.String (fromString) import Database.PostgreSQL.Simple (Only (..)) import Network.Wai.Handler.Warp ( HostPreference , defaultSettings , setHost , setPort ) import Network.Wai.Handler.WarpTLS (runTLS, tlsSettings) import Nuthatch import Nuthatch.Db (migrate, query_, withDb) import Nuthatch.Redis (withRedis) import Nuthatch.Recovery (withLinkedWorker) import Nuthatch.Runtime (retryStartup) import Nuthatch.S3 (newS3) import System.Directory (doesDirectoryExist) import System.FilePath (()) import System.IO (BufferMode (LineBuffering), hSetBuffering, stdout) main :: IO () main = do hSetBuffering stdout LineBuffering cfg <- loadConfig retryStartup (cfgStartupAttempts cfg) (cfgStartupDelayMs cfg) "postgresql" (withDb cfg $ \db -> do _ <- query_ db "SELECT 1" :: IO [Only Int] pure ()) withDb cfg $ \db -> do schemaPath <- findSchema retryStartup (cfgStartupAttempts cfg) (cfgStartupDelayMs cfg) "migration" (migrate db schemaPath cfg) withRedis cfg $ \redis -> do s3 <- newS3 cfg let env = newEnv cfg db redis s3 withLinkedWorker (runRecovery env) $ do let settings = setPort (cfgListenPort cfg) $ setHost (readHost (cfgListenHost cfg)) defaultSettings putStrLn $ "nuthatch listening on " <> cfgListenHost cfg <> ":" <> show (cfgListenPort cfg) runTLS (tlsSettings (cfgTlsCertPath cfg) (cfgTlsKeyPath cfg)) settings (application env) findSchema :: IO FilePath findSchema = do let candidates = [ "sql" , ".." "sql" , "/app/sql" ] existing <- mapM (\p -> doesDirectoryExist p >>= \e -> pure (e, p)) candidates pure $ case [p | (True, p) <- existing] of (p : _) -> p [] -> "sql" readHost :: String -> HostPreference readHost = fromString