diff options
Diffstat (limited to 'src/IRE/Server.hs')
-rw-r--r-- | src/IRE/Server.hs | 88 |
1 files changed, 88 insertions, 0 deletions
diff --git a/src/IRE/Server.hs b/src/IRE/Server.hs new file mode 100644 index 0000000..8dabc73 --- /dev/null +++ b/src/IRE/Server.hs @@ -0,0 +1,88 @@ +module IRE.Server ( + server +) where + +import Control.Exception.Base (throwIO, catch, bracket) +import Data.Yaml.Include (decodeFileEither) +import Data.Bits ((.|.)) +import Network.Socket (socket, setSocketOption, bind, listen, close, + maxListenQueue, getSocketName, inet_addr, Family(AF_UNIX, AF_INET), + SocketType(Stream), SocketOption(ReuseAddr), Socket, SockAddr(..)) +import Network.Wai.Handler.Warp (Port, defaultSettings, runSettingsSocket) +import System.Exit (exitFailure) +import System.IO (hPutStrLn, stderr) +import System.IO.Error (isDoesNotExistError) +import System.Posix.Files ( fileExist, groupReadMode, groupWriteMode, + ownerReadMode, ownerWriteMode, removeLink, setFileMode, socketMode ) + +import IRE.Application (app) +import IRE.Config (ConfigFile(..), defaultConfig) +import IRE.YOLO (newDetector) +import qualified IRE.Logging as Log + +type Listen = Either Port FilePath + +server :: FilePath -> FilePath -> IO () +server rootDir configFile = do + cf <- readConfigFile configFile + net <- newDetector (cfYOLO cf) + Log.start Log.Debug + let socketSpec = + case cfSocket cf of + Just p -> Right p + Nothing -> Left $ cfPort cf + bracket + (createSocket socketSpec) + closeSocket + ( \sock -> do + listen sock maxListenQueue + runSettingsSocket defaultSettings sock =<< app rootDir net) + + +readConfigFile :: FilePath -> IO ConfigFile +readConfigFile f = do + e <- fileExist f + if e then do + r <- decodeFileEither f + case r of + Left ex -> do + hPutStrLn stderr $ "FATAL: " ++ f ++ ": " ++ show ex + exitFailure + Right cf -> return cf + else return defaultConfig + + +createSocket :: Listen -> IO Socket +createSocket (Right path) = do + removeIfExists path + sock <- socket AF_UNIX Stream 0 + bind sock $ SockAddrUnix path + setFileMode path $ socketMode + .|. ownerWriteMode .|. ownerReadMode + .|. groupWriteMode .|. groupReadMode + Log.info $ "Listening on UNIX socket `" ++ path ++ "'" + return sock +createSocket (Left port) = do + sock <- socket AF_INET Stream 0 + setSocketOption sock ReuseAddr 1 + addr <- inet_addr "127.0.0.1" + bind sock $ SockAddrInet (fromIntegral port) addr + Log.info $ "Listening on localhost:" ++ show port + return sock + + +closeSocket :: Socket -> IO () +closeSocket sock = do + name <- getSocketName sock + close sock + case name of + SockAddrUnix path -> removeIfExists path + _ -> return () + + +removeIfExists :: FilePath -> IO () +removeIfExists fileName = removeLink fileName `catch` handleExists + where handleExists e + | isDoesNotExistError e = return () + | otherwise = throwIO e + |