2019-01-21 21:47:58 +02:00
|
|
|
{-# LANGUAGE DataKinds #-}
|
|
|
|
{-# LANGUAGE DuplicateRecordFields #-}
|
|
|
|
{-# LANGUAGE NoImplicitPrelude #-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
|
|
{-# LANGUAGE TypeApplications #-}
|
2018-08-02 21:39:08 +03:00
|
|
|
module Main where
|
|
|
|
|
2019-01-21 21:47:58 +02:00
|
|
|
import ClassyPrelude
|
|
|
|
import Configuration
|
|
|
|
import Control.Lens (view)
|
|
|
|
import Data.Generics.Product
|
|
|
|
import Data.Pool (createPool)
|
|
|
|
import Database.Selda.PostgreSQL (PGConnectInfo (..), pgOpen,
|
|
|
|
seldaClose)
|
|
|
|
import Dhall (auto, input)
|
|
|
|
import Network.Wai.Handler.Warp (run)
|
|
|
|
import Servant.Auth.Server (generateKey)
|
|
|
|
import Server (server)
|
|
|
|
import Types
|
|
|
|
import System.Environment (getEnvironment)
|
2018-08-02 22:11:11 +03:00
|
|
|
|
2018-08-03 23:36:38 +03:00
|
|
|
defaultMain :: App -> IO ()
|
|
|
|
defaultMain = run 8080 . server
|
|
|
|
|
|
|
|
withApp :: Config -> (App -> IO ()) -> IO ()
|
|
|
|
withApp config f = do
|
2018-08-02 23:59:08 +03:00
|
|
|
let pgHost = view (field @"database" . field @"host") config
|
|
|
|
pgPort = 5432
|
2018-10-17 23:51:30 +03:00
|
|
|
pgSchema = Nothing
|
2018-08-02 23:59:08 +03:00
|
|
|
pgDatabase = view (field @"database" . field @"database") config
|
|
|
|
pgUsername = Just (view (field @"database" . field @"username") config)
|
|
|
|
pgPassword = Just (view (field @"database" . field @"password") config)
|
|
|
|
database <- createPool (pgOpen (PGConnectInfo{..})) seldaClose 10 2 5
|
2018-08-04 23:43:26 +03:00
|
|
|
jwk <- generateKey
|
2018-08-03 23:36:38 +03:00
|
|
|
f App{..}
|
2018-08-02 23:33:47 +03:00
|
|
|
|
2018-08-02 21:39:08 +03:00
|
|
|
main :: IO ()
|
2018-08-02 23:07:05 +03:00
|
|
|
main = do
|
2019-01-21 21:47:58 +02:00
|
|
|
path <- fmap pack . lookup "CONF" <$> getEnvironment
|
|
|
|
c <- input auto (fromMaybe "./config/config.dhall" path)
|
2018-08-03 23:36:38 +03:00
|
|
|
withApp c defaultMain
|