aboutsummaryrefslogtreecommitdiff
path: root/src/Server.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Server.hs')
-rw-r--r--src/Server.hs98
1 files changed, 57 insertions, 41 deletions
diff --git a/src/Server.hs b/src/Server.hs
index 10d4328..14d7579 100644
--- a/src/Server.hs
+++ b/src/Server.hs
@@ -1,60 +1,78 @@
module Server
-(
- server
-) where
+ ( Listen(..)
+ , server
+ ) where
-import Control.Exception.Base (throwIO, catch, bracket)
+import Control.Exception.Base (bracket, catch, throwIO)
import Data.Bits ((.|.))
import Data.Pool (createPool, destroyAllResources)
import Database.MySQL.Base (ConnectInfo)
-import Network.Socket (socket, setSocketOption, bind, listen, close,
- maxListenQueue, getSocketName, inet_addr, Family(AF_UNIX, AF_INET),
- SocketType(Stream), SocketOption(ReuseAddr), Socket, SockAddr(SockAddrUnix,
- SockAddrInet))
+import qualified Database.MySQL.Simple as MySQL
+import Network.Socket
+ ( Family(AF_INET, AF_UNIX)
+ , SockAddr(SockAddrInet, SockAddrUnix)
+ , Socket
+ , SocketOption(ReuseAddr)
+ , SocketType(Stream)
+ , bind
+ , close
+ , getSocketName
+ , inet_addr
+ , listen
+ , maxListenQueue
+ , setSocketOption
+ , socket
+ )
import Network.Wai.Handler.Warp (Port, defaultSettings, runSettingsSocket)
import System.IO (hPutStrLn, stderr)
import System.IO.Error (isDoesNotExistError)
-import System.Posix.Files (removeLink, setFileMode, socketMode, ownerReadMode,
- ownerWriteMode, groupReadMode, groupWriteMode)
-import qualified Database.MySQL.Simple as MySQL
+import System.Posix.Files
+ ( groupReadMode
+ , groupWriteMode
+ , ownerReadMode
+ , ownerWriteMode
+ , removeLink
+ , setFileMode
+ , socketMode
+ )
import Application (app)
-type Listen = Either Port FilePath
-
+data Listen
+ = Socket FilePath
+ | Port Int
server :: Listen -> ConnectInfo -> FilePath -> IO ()
server socketSpec mysqlConnInfo dataDir =
bracket
- ( do
- sock <- createSocket socketSpec
- mysql <- createPool
- (MySQL.connect mysqlConnInfo)
- MySQL.close
- 1 -- stripes
- 60 -- keep alive (seconds)
- 10 -- max connections
- return (sock, mysql) )
- ( \(sock, mysql) -> do
- closeSocket sock
- destroyAllResources mysql )
- ( \(sock, mysql) -> do
- listen sock maxListenQueue
- hPutStrLn stderr $ "Static files from `" ++ dataDir ++ "'"
- runSettingsSocket defaultSettings sock =<< app mysql dataDir)
-
+ (do sock <- createSocket socketSpec
+ mysql <-
+ createPool
+ (MySQL.connect mysqlConnInfo)
+ MySQL.close
+ 1 -- stripes
+ 60 -- keep alive (seconds)
+ 10 -- max connections
+ return (sock, mysql))
+ (\(sock, mysql) -> do
+ closeSocket sock
+ destroyAllResources mysql)
+ (\(sock, mysql) -> do
+ listen sock maxListenQueue
+ hPutStrLn stderr $ "Static files from `" ++ dataDir ++ "'"
+ runSettingsSocket defaultSettings sock =<< app mysql dataDir)
createSocket :: Listen -> IO Socket
-createSocket (Right path) = do
+createSocket (Socket path) = do
removeIfExists path
sock <- socket AF_UNIX Stream 0
bind sock $ SockAddrUnix path
- setFileMode path $ socketMode
- .|. ownerWriteMode .|. ownerReadMode
- .|. groupWriteMode .|. groupReadMode
+ setFileMode path $
+ socketMode .|. ownerWriteMode .|. ownerReadMode .|. groupWriteMode .|.
+ groupReadMode
hPutStrLn stderr $ "Listening on UNIX socket `" ++ path ++ "'"
return sock
-createSocket (Left port) = do
+createSocket (Port port) = do
sock <- socket AF_INET Stream 0
setSocketOption sock ReuseAddr 1
addr <- inet_addr "127.0.0.1"
@@ -62,7 +80,6 @@ createSocket (Left port) = do
hPutStrLn stderr $ "Listening on localhost:" ++ show port
return sock
-
closeSocket :: Socket -> IO ()
closeSocket sock = do
name <- getSocketName sock
@@ -71,10 +88,9 @@ closeSocket sock = do
SockAddrUnix path -> removeIfExists path
_ -> return ()
-
removeIfExists :: FilePath -> IO ()
removeIfExists fileName = removeLink fileName `catch` handleExists
- where handleExists e
- | isDoesNotExistError e = return ()
- | otherwise = throwIO e
-
+ where
+ handleExists e
+ | isDoesNotExistError e = return ()
+ | otherwise = throwIO e