diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,17 @@ +This program is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License as +published by the Free Software Foundation; either version 2, or (at +your option) any later version. + +This program is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. + +You can obtain copies of permitted licenses from these URLs: + + http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt + http://www.gnu.org/licenses/gpl-3.0.txt + +or by writing to the Free Software Foundation, Inc., 59 Temple Place, +Suite 330, Boston, MA 02111-1307 USA diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple +main :: IO () +main = defaultMain diff --git a/hails-bin.cabal b/hails-bin.cabal new file mode 100644 --- /dev/null +++ b/hails-bin.cabal @@ -0,0 +1,34 @@ +Name: hails-bin +Version: 0.1 +build-type: Simple +License: GPL-2 +License-File: LICENSE +Author: HAILS team +Maintainer: Amit Levy , Deian Stefan +Stability: experimental +Synopsis: Dynamic launcher of Hails applications +Category: Web +Cabal-Version: >= 1.8 + +Description: + Executable for deploying Hails (see the hails Hackage package) + applications. + +Source-repository head + Type: git + Location: http://www.github.com/scslab/hails-bin.git + +Executable hails + Main-is: hails.hs + ghc-options: -package ghc -Wall -fno-warn-orphans + Build-Depends: base >= 4.5 && < 5, + hails >= 0.1 && < 1, + containers >= 0.4.2 && < 0.5, + bytestring >= 0.9 && < 1, + containers >= 0.4.2 && < 0.5, + ghc-paths >= 0.1 && < 0.2, + iterIO >= 0.2.2 && < 0.3, + iterio-server >= 0.3 && < 0.4, + mongoDB >= 1.1.2 && < 1.3, + bson >= 0.1 && < 0.2, + mtl >= 2.0 && < 2.1 diff --git a/hails.hs b/hails.hs new file mode 100644 --- /dev/null +++ b/hails.hs @@ -0,0 +1,157 @@ +{-# LANGUAGE ScopedTypeVariables #-} +import Hails.HttpServer +import Hails.HttpServer.Auth + +import Data.IterIO.Server.TCPServer +import Data.Functor ((<$>)) +import Data.Maybe (listToMaybe) +import qualified Data.ByteString.Lazy.Char8 as L8 + +import System.Environment +import System.Console.GetOpt hiding (Option) +import qualified System.Console.GetOpt as GetOpt +import System.IO (stderr, hPutStrLn) +import System.Exit + +import GHC +import GHC.Paths +import DynFlags +import Unsafe.Coerce + +import Hails.TCB.Types ( AppName, AppReqHandler ) + +import Control.Monad (when, void ) + + +version :: String +version = "0.1" + +about :: String -> String -> String +about prog ver = "About: " ++ prog ++ " " ++ ver ++ + " \n Simple tool for launching HAILS apps.\ + \ By default, " ++ prog ++ " uses the environment variables\ + \ APP_NAME, PORT, HMAC_KEY, AUTH_URL. Use the command-line \ + \ arguments to override." + +-- +-- +-- + +-- | Given an application name, return the corresponding computation. +loadApp :: Bool -> AppName -> IO AppReqHandler +loadApp safe appName = runGhc (Just libdir) $ do + dflags <- getSessionDynFlags + let dflagsXSafe = if safe + then dflags { safeHaskell = Sf_Safe } + else dflags + void $ setSessionDynFlags dflagsXSafe + target <- guessTarget appName Nothing + addTarget target + r <- load LoadAllTargets + case r of + Failed -> error "Compilation failed" + Succeeded -> do + setContext [IIDecl $ simpleImportDecl (mkModuleName appName)] + value <- compileExpr (appName ++ ".server") + return . unsafeCoerce $ value + + +main :: IO () +main = do + args <- getArgs + env <- getEnvironment + opts <- hailsOpts args env + when (optAbout opts) $ printAbout + let appName = optName opts + port = optPort opts + authF = if optDev opts + then basicNoAuth + else externalAuth (optKey opts) (optUrl opts) + func <- loadApp (optSafe opts) appName + runTCPServer $ secureHttpServer authF (fromInteger port) func + +-- +-- Helper +-- + +printAbout :: IO () +printAbout = do + prog <- getProgName + putStrLn $ about prog version + exitSuccess + + +-- +-- Parsing options +-- + +data Options = Options + { optName :: String -- ^ App name + , optPort :: Integer -- ^ App port number + , optAbout :: Bool -- ^ About this program + , optSafe :: Bool -- ^ Use -XSafe + , optDev :: Bool -- ^ Development + , optKey :: L8.ByteString -- ^ HMAC key + , optUrl :: String -- ^ URL to auth service + } + +defaultOpts :: Options +defaultOpts = Options { optName = "App" + , optPort = 8080 + , optAbout = False + , optSafe = True + , optDev = True + , optKey = L8.empty + , optUrl = "http://127.0.0.1" } + +options :: [ OptDescr (Options -> Options) ] +options = + [ GetOpt.Option ['s'] ["start"] + (ReqArg (\n o -> o { optName = n }) "APP_NAME") + "Start application APP_NAME" + , GetOpt.Option ['p'] ["port"] + (ReqArg (\p o -> o { optPort = read p }) "PORT") + "Run application on port PORT" + , GetOpt.Option ['k'] ["key", "hmac-key"] + (ReqArg (\k o -> o { optKey = read k }) "HMAC_KEY") + "Application authentication HMAC key is HMAC_KEY" + , GetOpt.Option ['d'] ["dev", "development"] + (NoArg (\opts -> opts { optDev = True })) + "Development mode, default (no authentication)" + , GetOpt.Option ['p'] ["prod", "production"] + (NoArg (\opts -> opts { optDev = False })) + "Production mode (external authentication). Must set HMAC-KEY and AUTH_URL." + , GetOpt.Option ['a'] ["auth-url"] + (ReqArg (\u o -> o { optUrl = u }) "AUTH_URL") + "Authentication service URL AUTH_URL" + , GetOpt.Option [] ["unsafe"] + (NoArg (\opts -> opts { optSafe = False })) + "Turn off the -XSafe flag" + , GetOpt.Option ['h','?'] ["help", "about"] + (NoArg (\opts -> opts { optAbout = True })) + "About this program" + ] + +hailsOpts :: [String] -> [(String, String)] -> IO Options +hailsOpts args env = do + let opts = envOpts defaultOpts env + case getOpt Permute options args of + (o,[], []) -> return $ foldl (flip id) opts o + (_,_,errs) -> do prog <- getProgName + hPutStrLn stderr $ concat errs ++ + usageInfo (header prog) options + exitFailure + where header prog = "Usage: " ++ prog ++ " [OPTION...]" + + +envOpts :: Options -> [(String, String)] -> Options +envOpts opts env = + opts { optName = maybe (optName opts) id (fromEnv "APP_NAME") + , optPort = maybe (optPort opts) id (readFromEnv "PORT") + , optKey = maybe (optKey opts) id (readFromEnv "HMAC_KEY") + , optUrl = maybe (optUrl opts) id (fromEnv "AUTH_URL") + } + where fromEnv n = lookup n env + readFromEnv n = lookup n env >>= mRead + mRead :: Read a => String -> Maybe a + mRead s = fst <$> (listToMaybe $ reads s)