blob: aa602747f85c1a871789842d047c8198166853be (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
|
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
module Shop.Server where
import Shop.API
import Shop.Config
import Shop.Types
import Shop.Handler
import qualified Control.Category as Category
import Control.Monad.Logger (runStdoutLoggingT)
import Protolude
import Servant.API
import Servant.Server hiding (Handler)
import Network.Socket
import Network.Wai.Handler.Warp (defaultSettings,
runSettings,
runSettingsSocket,
setHost,
setPort)
server :: ServerT ShopAPI App
server = charge
app :: Config -> Application
app cfg = serve shopAPI (readerServer cfg)
readerServer :: Config -> Server ShopAPI
readerServer cfg = appToInternalHandler cfg `enter` server
serveApp :: (Config -> Application) -> IO ()
serveApp f = do
cfg <- getConfig
let logger = setLogger (getConfigEnv cfg)
let settings = setHost (getConfigHost cfg) $
setPort (getConfigPort cfg) defaultSettings
case getConfigSocket cfg of
Nothing -> runSettings settings (logger $ f cfg)
Just s -> do
sock <- socket AF_UNIX Stream 0
bind sock $ SockAddrUnix s
listen sock maxListenQueue
runSettingsSocket settings sock (logger $ f cfg)
close sock
main :: IO ()
main = serveApp app
|