matebeamter/src/Main.hs

70 lines
1.6 KiB
Haskell
Raw Normal View History

2019-09-18 13:24:23 +00:00
{-# LANGUAGE OverloadedStrings #-}
2019-09-06 23:57:25 +00:00
module Main where
2019-09-08 00:37:50 +00:00
import Servant
import Servant.Server
2019-09-16 07:44:46 +00:00
import Servant.Client
2019-09-08 00:37:50 +00:00
import Network.Wai.Handler.Warp
import Network.Wai.Logger
2019-09-18 13:24:23 +00:00
import Network.Wai.Session
2019-09-08 00:37:50 +00:00
2019-09-08 10:48:57 +00:00
import Network.HTTP.Client hiding (Proxy)
2019-09-18 13:24:23 +00:00
import Web.Cookie (defaultSetCookie)
2019-09-08 10:48:57 +00:00
import Control.Monad.Reader
2019-09-08 15:27:38 +00:00
import Data.Text.I18n
import Data.Text.I18n.Po
2019-09-18 13:24:23 +00:00
import Data.ByteString (ByteString)
import qualified Data.Vault.Lazy as V
2019-09-08 00:37:50 +00:00
-- internal imports
import API
import Types
import View
2019-09-08 10:48:57 +00:00
import Control
2019-09-18 13:24:23 +00:00
import Session
2019-09-08 00:37:50 +00:00
2019-09-06 23:57:25 +00:00
main :: IO ()
2019-09-08 00:37:50 +00:00
main = do
2019-09-08 10:48:57 +00:00
manager <- newManager defaultManagerSettings
2019-09-08 15:27:38 +00:00
(l10n, _) <- getL10n "./locales"
2019-09-08 00:37:50 +00:00
withStdoutLogger $ \ilog -> do
2019-09-18 13:24:23 +00:00
sessKey <- V.newKey :: IO (V.Key (Session IO ByteString ByteString))
2019-09-08 00:37:50 +00:00
let settings = setPort 3000 $ setLogger ilog defaultSettings
2019-09-18 13:24:23 +00:00
sessMap = sessionMap
2019-09-08 10:48:57 +00:00
initState = ReadState
2019-09-16 07:44:46 +00:00
-- { rsManager = manager
2019-09-17 19:29:56 +00:00
{ rsL10n = l10n
, rsBackend = mkClientEnv manager (BaseUrl Http "localhost" 8000 "")
, rsHashParams = recommendedHashParams
2019-09-08 10:48:57 +00:00
}
2019-09-18 13:24:23 +00:00
cookieMiddleware = withSession
(sessionStore genSessionId sessMap)
"mateamt-cookies"
defaultSetCookie
sessKey
2019-09-08 10:48:57 +00:00
runSettings settings (userApp initState)
userApp initState = serveWithContext userApi (EmptyContext) $
hoistServerWithContext
userApi
Proxy
(`runReaderT` initState)
2019-09-11 04:27:54 +00:00
( userSelectControl
:<|> userOverviewControl
2019-09-17 19:29:56 +00:00
:<|> userNewControl
:<|> userNewPostControl
2019-09-11 04:27:54 +00:00
:<|> authControl
2019-09-08 10:48:57 +00:00
)
2019-09-08 00:37:50 +00:00
userApi :: Proxy UserAPI
userApi = Proxy