Load bind address from environment
This commit is contained in:
parent
f5157016db
commit
d7c0b8d4a5
@ -21,6 +21,7 @@ import qualified Data.ByteString.Char8 as BS
|
||||
app :: (Application -> IO ()) -> IO ()
|
||||
app runner = do
|
||||
settings <- newAppSettings
|
||||
(baseUrl,_) <- serverSettings
|
||||
table <- records
|
||||
|
||||
runner $ controllerApp settings $ do
|
||||
@ -41,8 +42,7 @@ app runner = do
|
||||
case lookup "url" form of
|
||||
Just url' -> do
|
||||
let url = BS.unpack url'
|
||||
address <- return "http://localhost:3000/"
|
||||
word <- liftIO (insert table url)
|
||||
liftIO $ putStrLn (printf "Registered %s -> %s " url word)
|
||||
render "done.html" $ object ["link" .= (address ++ word)]
|
||||
render "done.html" $ object ["link" .= (baseUrl ++ word)]
|
||||
Nothing -> respond badRequest
|
||||
|
7
Main.hs
7
Main.hs
@ -2,14 +2,13 @@
|
||||
module Main where
|
||||
|
||||
import Application
|
||||
import Shortener.Common
|
||||
|
||||
import Control.Applicative
|
||||
import System.Environment
|
||||
import Network.Wai.Handler.Warp
|
||||
import Network.Wai.Middleware.RequestLogger
|
||||
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
port <- maybe 3000 read <$> lookupEnv "PORT"
|
||||
app (run port . logStdout)
|
||||
(_, settings) <- serverSettings
|
||||
app (runSettings settings . logStdout)
|
@ -2,11 +2,26 @@
|
||||
module Shortener.Common where
|
||||
|
||||
import Control.Applicative
|
||||
import Text.Printf
|
||||
import Data.String
|
||||
import System.Environment
|
||||
import Network.Wai.Handler.Warp
|
||||
|
||||
import Web.Simple
|
||||
import Web.Simple.Templates
|
||||
|
||||
data AppSettings = AppSettings { }
|
||||
|
||||
serverSettings :: IO (String, Settings)
|
||||
serverSettings = do
|
||||
port <- maybe 3000 read <$> lookupEnv "PORT"
|
||||
host <- maybe "127.0.0.1" id <$> lookupEnv "ADDRESS"
|
||||
let opts = setPort port $ setHost (fromString host) defaultSettings
|
||||
url = if port == 80
|
||||
then printf "http://%s/" host
|
||||
else printf "http://%s:%d/" host port
|
||||
return (url, opts)
|
||||
|
||||
newAppSettings :: IO AppSettings
|
||||
newAppSettings = return AppSettings
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user