From ad1134ad752bbcd678cfb5a80217fabe57fdcd35 Mon Sep 17 00:00:00 2001 From: Igor Pashev Date: Sun, 6 Aug 2017 19:50:58 +0300 Subject: Format with hindent --- src/Sproxy/Server.hs | 181 ++++++++++++++++++++++++--------------------------- 1 file changed, 84 insertions(+), 97 deletions(-) (limited to 'src/Sproxy/Server.hs') diff --git a/src/Sproxy/Server.hs b/src/Sproxy/Server.hs index 7b65f32..75a50a4 100644 --- a/src/Sproxy/Server.hs +++ b/src/Sproxy/Server.hs @@ -1,6 +1,6 @@ -module Sproxy.Server ( - server -) where +module Sproxy.Server + ( server + ) where import Control.Concurrent (forkIO) import Control.Exception (bracketOnError) @@ -11,136 +11,128 @@ import Data.Maybe (fromMaybe) import Data.Text (Text) import Data.Word (Word16) import Data.Yaml.Include (decodeFileEither) -import Network.HTTP.Client (Manager, ManagerSettings(..), defaultManagerSettings, newManager, socketConnection) +import Network.HTTP.Client + (Manager, ManagerSettings(..), defaultManagerSettings, newManager, + socketConnection) import Network.HTTP.Client.Internal (Connection) -import Network.Socket ( Socket, Family(AF_INET, AF_UNIX), SockAddr(SockAddrInet, SockAddrUnix), - SocketOption(ReuseAddr), SocketType(Stream), bind, close, connect, inet_addr, - listen, maxListenQueue, setSocketOption, socket ) +import Network.Socket + (Family(AF_INET, AF_UNIX), SockAddr(SockAddrInet, SockAddrUnix), + Socket, SocketOption(ReuseAddr), SocketType(Stream), bind, close, + connect, inet_addr, listen, maxListenQueue, setSocketOption, + socket) import Network.Wai (Application) -import Network.Wai.Handler.WarpTLS (tlsSettingsChain, runTLSSocket) -import Network.Wai.Handler.Warp ( Settings, defaultSettings, runSettingsSocket, - setHTTP2Disabled, setOnException ) +import Network.Wai.Handler.Warp + (Settings, defaultSettings, runSettingsSocket, setHTTP2Disabled, + setOnException) +import Network.Wai.Handler.WarpTLS (runTLSSocket, tlsSettingsChain) import System.Entropy (getEntropy) import System.Environment (setEnv) import System.Exit (exitFailure) import System.FilePath.Glob (compile) import System.IO (hPutStrLn, stderr) -import System.Posix.User ( GroupEntry(..), UserEntry(..), - getAllGroupEntries, getRealUserID, - getUserEntryForName, setGroupID, setGroups, setUserID ) +import System.Posix.User + (GroupEntry(..), UserEntry(..), getAllGroupEntries, getRealUserID, + getUserEntryForName, setGroupID, setGroups, setUserID) -import Sproxy.Application (sproxy, redirect) -import Sproxy.Application.OAuth2.Common (OAuth2Client) -import Sproxy.Config (BackendConf(..), ConfigFile(..), OAuth2Conf(..)) +import Sproxy.Application (redirect, sproxy) import qualified Sproxy.Application.OAuth2 as OAuth2 +import Sproxy.Application.OAuth2.Common (OAuth2Client) +import Sproxy.Config + (BackendConf(..), ConfigFile(..), OAuth2Conf(..)) import qualified Sproxy.Logging as Log import qualified Sproxy.Server.DB as DB - {- TODO: - Log.error && exitFailure should be replaced - by Log.fatal && wait for logger thread to print && exitFailure -} - server :: FilePath -> IO () server configFile = do cf <- readConfigFile configFile Log.start $ cfLogLevel cf - sock <- socket AF_INET Stream 0 setSocketOption sock ReuseAddr 1 bind sock $ SockAddrInet (fromIntegral $ cfListen cf) 0 - - maybe80 <- if fromMaybe (443 == cfListen cf) (cfListen80 cf) - then do - sock80 <- socket AF_INET Stream 0 - setSocketOption sock80 ReuseAddr 1 - bind sock80 $ SockAddrInet 80 0 - return (Just sock80) - else - return Nothing - + maybe80 <- + if fromMaybe (443 == cfListen cf) (cfListen80 cf) + then do + sock80 <- socket AF_INET Stream 0 + setSocketOption sock80 ReuseAddr 1 + bind sock80 $ SockAddrInet 80 0 + return (Just sock80) + else return Nothing uid <- getRealUserID when (0 == uid) $ do let user = cfUser cf Log.info $ "switching to user " ++ show user u <- getUserEntryForName user - groupIDs <- map groupID . filter (elem user . groupMembers) - <$> getAllGroupEntries + groupIDs <- + map groupID . filter (elem user . groupMembers) <$> getAllGroupEntries setGroups groupIDs setGroupID $ userGroupID u setUserID $ userID u - ds <- newDataSource cf db <- DB.start (cfHome cf) ds - - key <- maybe - (Log.info "using new random key" >> getEntropy 32) - (return . pack) - (cfKey cf) - - let - settings = - (if cfHTTP2 cf then id else setHTTP2Disabled) $ - setOnException (\_ _ -> return ()) - defaultSettings - - oauth2clients <- HM.fromList <$> mapM newOAuth2Client (HM.toList (cfOAuth2 cf)) - + key <- + maybe + (Log.info "using new random key" >> getEntropy 32) + (return . pack) + (cfKey cf) + let settings = + (if cfHTTP2 cf + then id + else setHTTP2Disabled) $ + setOnException (\_ _ -> return ()) defaultSettings + oauth2clients <- + HM.fromList <$> mapM newOAuth2Client (HM.toList (cfOAuth2 cf)) backends <- - mapM (\be -> do - m <- newBackendManager be - return (compile $ beName be, be, m) - ) $ cfBackends cf - - + mapM + (\be -> do + m <- newBackendManager be + return (compile $ beName be, be, m)) $ + cfBackends cf warpServer <- newServer cf - case maybe80 of - Nothing -> return () + Nothing -> return () Just sock80 -> do let httpsPort = fromMaybe (cfListen cf) (cfHttpsPort cf) Log.info "listening on port 80 (HTTP redirect)" listen sock80 maxListenQueue void . forkIO $ runSettingsSocket settings sock80 (redirect httpsPort) - -- XXX 2048 is from bindPortTCP from streaming-commons used internally by runTLS. -- XXX Since we don't call runTLS, we listen socket here with the same options. Log.info $ "proxy listening on port " ++ show (cfListen cf) listen sock (max 2048 maxListenQueue) warpServer settings sock (sproxy key db oauth2clients backends) - newDataSource :: ConfigFile -> IO (Maybe DB.DataSource) newDataSource cf = case (cfDataFile cf, cfDatabase cf) of (Nothing, Just str) -> do case cfPgPassFile cf of Nothing -> return () - Just f -> do + Just f -> do Log.info $ "pgpassfile: " ++ show f setEnv "PGPASSFILE" f return . Just $ DB.PostgreSQL str - - (Just f, Nothing) -> return . Just $ DB.File f - - (Nothing, Nothing) -> return Nothing + (Just f, Nothing) -> return . Just $ DB.File f + (Nothing, Nothing) -> return Nothing _ -> do Log.error "only one data source can be used" exitFailure - newOAuth2Client :: (Text, OAuth2Conf) -> IO (Text, OAuth2Client) newOAuth2Client (name, cfg) = case HM.lookup name OAuth2.providers of - Nothing -> do Log.error $ "OAuth2 provider " ++ show name ++ " is not supported" - exitFailure + Nothing -> do + Log.error $ "OAuth2 provider " ++ show name ++ " is not supported" + exitFailure Just provider -> do Log.info $ "oauth2: adding " ++ show name return (name, provider (client_id, client_secret)) - where client_id = pack $ oa2ClientId cfg - client_secret = pack $ oa2ClientSecret cfg - + where + client_id = pack $ oa2ClientId cfg + client_secret = pack $ oa2ClientSecret cfg newBackendManager :: BackendConf -> IO Manager newBackendManager be = do @@ -149,20 +141,18 @@ newBackendManager be = do (Just f, Nothing) -> do Log.info $ "backend `" ++ beName be ++ "' on UNIX socket " ++ f return $ openUnixSocketConnection f - (Nothing, Just n) -> do - Log.info $ "backend `" ++ beName be ++ "' on " ++ beAddress be ++ ":" ++ show n + Log.info $ + "backend `" ++ beName be ++ "' on " ++ beAddress be ++ ":" ++ show n return $ openTCPConnection (beAddress be) n - _ -> do - Log.error "either backend port number or UNIX socket path is required." - exitFailure - - newManager defaultManagerSettings { - managerRawConnection = return $ \_ _ _ -> openConn - , managerConnCount = beConnCount be - } - + Log.error "either backend port number or UNIX socket path is required." + exitFailure + newManager + defaultManagerSettings + { managerRawConnection = return $ \_ _ _ -> openConn + , managerConnCount = beConnCount be + } newServer :: ConfigFile -> IO (Settings -> Socket -> Application -> IO ()) newServer cf @@ -170,33 +160,31 @@ newServer cf case (cfSslKey cf, cfSslCert cf) of (Just k, Just c) -> return $ runTLSSocket (tlsSettingsChain c (cfSslCertChain cf) k) - _ -> do Log.error "missings SSL certificate" - exitFailure + _ -> do + Log.error "missings SSL certificate" + exitFailure | otherwise = do - Log.warn "not using SSL!" - return runSettingsSocket - + Log.warn "not using SSL!" + return runSettingsSocket openUnixSocketConnection :: FilePath -> IO Connection openUnixSocketConnection f = bracketOnError - (socket AF_UNIX Stream 0) - close - (\s -> do - connect s (SockAddrUnix f) - socketConnection s 8192) - + (socket AF_UNIX Stream 0) + close + (\s -> do + connect s (SockAddrUnix f) + socketConnection s 8192) openTCPConnection :: String -> Word16 -> IO Connection openTCPConnection addr port = bracketOnError - (socket AF_INET Stream 0) - close - (\s -> do - a <- inet_addr addr - connect s (SockAddrInet (fromIntegral port) a) - socketConnection s 8192) - + (socket AF_INET Stream 0) + close + (\s -> do + a <- inet_addr addr + connect s (SockAddrInet (fromIntegral port) a) + socketConnection s 8192) readConfigFile :: FilePath -> IO ConfigFile readConfigFile f = do @@ -206,4 +194,3 @@ readConfigFile f = do hPutStrLn stderr $ "FATAL: " ++ f ++ ": " ++ show e exitFailure Right cf -> return cf - -- cgit v1.2.3