hails-bin (empty) → 0.1

raw patch · 4 files changed

+211/−0 lines, 4 filesdep +basedep +bsondep +bytestringsetup-changed

Dependencies added: base, bson, bytestring, containers, ghc-paths, hails, iterIO, iterio-server, mongoDB, mtl

Files

LICENSE +17/−0
Setup.hs +3/−0
hails-bin.cabal +34/−0
hails.hs +157/−0

+ LICENSE view

@@ -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

+ Setup.hs view

@@ -0,0 +1,3 @@+import Distribution.Simple+main :: IO ()+main = defaultMain

+ hails-bin.cabal view

@@ -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 <levya at cs.stanford dot edu>, Deian Stefan  <deian at cs dot stanford dot edu>+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

+ hails.hs view

@@ -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)