33 lines
928 B
Haskell
33 lines
928 B
Haskell
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE TypeOperators #-}
|
|
|
|
module Jon.Main
|
|
( main
|
|
) where
|
|
|
|
import Control.Exception (bracket)
|
|
import Database.Beam.Postgres
|
|
import Servant
|
|
import Servant.Swagger.UI
|
|
import System.Environment
|
|
import Network.Wai.Handler.Warp (run)
|
|
|
|
import qualified Data.ByteString.Char8 as BS8
|
|
|
|
import Jon.Server (JonAPI, jonSwaggerDoc, server)
|
|
|
|
main :: IO ()
|
|
main = withGarfieldConn $ \conn ->
|
|
run 8080 $ serve p (server conn :<|> swaggerSchemaUIServer jonSwaggerDoc :<|> serveDirectoryFileServer "./static")
|
|
where
|
|
p :: Proxy (JonAPI :<|> SwaggerSchemaUI "swagger" "swagger.json" :<|> Raw)
|
|
p = Proxy
|
|
|
|
withGarfieldConn :: (Connection -> IO a) -> IO a
|
|
withGarfieldConn = bracket
|
|
(do pass <- getEnv "JON_PASS"
|
|
connectPostgreSQL $ BS8.pack $ "host=localhost dbname=garfield password=" ++ pass)
|
|
close
|