hails 0.9.2.1 → 0.9.2.2

raw patch · 4 files changed

+53/−33 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Hails/HttpServer.hs +30/−21
• Hails/HttpServer/Types.hs +12/−0
• hails.cabal +1/−1
• hails.hs +10/−11

@@ -9,22 +9,19 @@ At a high level, a Hails 'Application', is a function from 'Request' to 'Response' in the 'DC' monad. Every application response is sanitized and sanity checked with the 'secureApplication'-'Middleware'.+'Middleware'. Moreover, every 'Request' is sanitized with 'sanitizeReq'+before handed over to authenticators. -Hails uses Wai, and as such we provide two functions for converting-Hails 'Application's to Wai 'W.Applicatoin's: '-'devHailsApplication' used to execute Hails apps in development-mode, and 'hailsApplicationToWai' that should be used in production-with an authentication service from "Hails.HttpServer.Auth".+Hails uses Wai, and as such we provide a function for converting+Hails 'Application's to Wai 'W.Applicatoin's: 'execHailsApplication'.  -} module Hails.HttpServer (   module Hails.HttpServer.Types-  -- ** Execute Hails application in development mode-  , devHailsApplication   -- ** Execute Hails application-  , hailsApplicationToWai+  , execHailsApplication   -- ** Middleware used by Hails+  , sanitizeReqMiddleware   , browserLabelGuard   , guardSensitiveResp    , sanitizeResp@@ -47,6 +44,7 @@ import           Network.HTTP.Types import qualified Network.Wai as W import qualified Network.Wai.Application.Static as W+import           Network.Wai.Middleware.MethodOverridePost  import           LIO import           LIO.TCB@@ -54,7 +52,6 @@ import           LIO.DCLabel.Privs.TCB import           LIO.Labeled.TCB -import           Hails.HttpServer.Auth import           Hails.HttpServer.Types  import           System.IO@@ -82,6 +79,11 @@                    , requestBody = body                     , requestTime = curTime } +-- | Remove any unsafe headers, in this case only @X-Hails-User@.+sanitizeReqMiddleware :: W.Middleware+sanitizeReqMiddleware app req =  app $ req { W.requestHeaders = headers }+  where headers = List.filter ((/= "X-Hails-User") . fst) $ W.requestHeaders req+ -- | Convert a Hails 'Response' to a WAI 'W.Response' hailsToWaiResponse :: Response -> W.Response hailsToWaiResponse (Response stat rhd body) = W.responseLBS stat rhd body@@ -135,7 +137,9 @@ sanitizeResp :: Middleware sanitizeResp hailsApp conf req = do   response <- hailsApp conf req-  return $ removeResponseHeader response "Set-Cookie"+  return $ foldr (\h r -> removeResponseHeader r h) response unsafeHeaders+   where unsafeHeaders = ["Set-Cookie", "X-Hails-Label"]+     -- | Returns a secure Hails app such that the result 'Response' is guaranteed@@ -147,26 +151,28 @@ -- >                   . 'sanitizeResp'       -- Remove Cookies secureApplication :: Middleware secureApplication = browserLabelGuard  -- Return 403, if user should not read+                  . sanitizeResp       -- Remove Cookies and X-Hails-Sensitive                   . guardSensitiveResp -- Add X-Hails-Sensitive if not public-                  . sanitizeResp       -- Remove Cookies  -- | Catch all exceptions thrown by middleware and return 500. catchAllExceptions :: W.Middleware-catchAllExceptions app req = do-  app req `catchError` (const $ return resp500)+catchAllExceptions app req = app req `catchError` (const $ return resp500)     where resp500 = W.responseLBS status500 [] "App threw an exception"  -- -- Executing Hails applications -- --- | A default Hails handler for development environments. Safely runs--- a Hails 'Application', using basic HTTP authentication for--- authenticating users.  Note: authentication will accept any--- username/password pair, it is solely used to set the user-name.-devHailsApplication :: Application -> W.Application-devHailsApplication = devBasicAuth . hailsApplicationToWai-+-- | Execute an application, safely filtering unsafe request headers,+-- overriding method posts,  catching all exceptions, and sanitizing+-- responses.+execHailsApplication :: W.Middleware -> Application -> W.Application+execHailsApplication authMiddleware app =+    catchAllExceptions+  . sanitizeReqMiddleware+  . methodOverridePost+  . authMiddleware+  $ \req -> hailsApplicationToWai app req  -- | Safely wraps a Hails 'Application' in a Wai 'W.Application' that can -- be run by an application server. The application is executed with the@@ -176,6 +182,9 @@ -- label does not flow, it responds with a 403. -- -- All applications serve static content from a @\"static\"@ directory.+--+-- Note: this function assumes that the request has already been sanitized.+-- In most cases, you want to use 'execHailsApplication'. hailsApplicationToWai :: Application -> W.Application hailsApplicationToWai app0 req0 | isStatic req0 =   -- Is static request, serve files:

@@ -4,6 +4,7 @@   -- * Requests     Request(..)   , getRequestBodyType, RequestBodyType(..)+  , addRequestHeader, removeRequestHeader   -- * Responses   , Response(..)   , addResponseHeader, removeResponseHeader@@ -90,6 +91,17 @@                         then Just $ S.drop (S.length bound') s'                         else Nothing             else Nothing++-- | Add/replace a 'H.Header' to the 'Request'+addRequestHeader :: Request -> H.Header -> Request+addRequestHeader req hdr@(hname, _) = req { requestHeaders = hdr:headers }++  where headers = List.filter ((/= hname) . fst) $ requestHeaders req+-- | Remove a header (if it exists) from the 'Request'+removeRequestHeader :: Request -> H.HeaderName -> Request+removeRequestHeader req hname = req { requestHeaders = headers }+  where headers = List.filter ((/= hname) . fst) $ requestHeaders req+  -- -- Response

@@ -1,5 +1,5 @@ Name:           hails-Version:        0.9.2.1+Version:        0.9.2.2 build-type:     Simple License:        GPL-2 License-File:   LICENSE

@@ -16,7 +16,6 @@ import           Hails.Version  import           Network.Wai.Handler.Warp-import           Network.Wai.Middleware.MethodOverridePost import           Network.Wai.Middleware.RequestLogger  import           System.Posix.Env (setEnv)@@ -83,17 +82,17 @@       hmac_key = L8.pack . fromJust $ optHmacKey opts       persona = personaAuth hmac_key $ T.pack . fromJust . optPersonaAud $ opts       openid  = openIdAuth  $ T.pack . fromJust . optOpenID $ opts-      prodHailsApplication = if (isJust $ optPersonaAud opts)-                                then persona else openid-      f = case () of-           _ | optDev opts && -               (isJust (optPersonaAud opts) || isJust (optOpenID opts) ) ->-               logStdoutDev . prodHailsApplication . hailsApplicationToWai -           _ | optDev opts -> logStdoutDev . devHailsApplication-           _ -> logStdout . prodHailsApplication . hailsApplicationToWai +      logMiddleware  = if optDev opts then logStdoutDev  else logStdout+      authMiddleware = case () of+         -- dev/production mode with persona:+         _ | isJust (optPersonaAud opts) -> persona+         -- dev/productoin mode with openid:+         _ | isJust (optOpenID opts)     -> openid+         -- dev mode:+         _                               -> devBasicAuth   app <- loadApp (optSafe opts) (optPkgConf opts) (fromJust $ optName opts)-  runSettings (defaultSettings { settingsPort = port })-              (catchAllExceptions $ methodOverridePost $ f app)+  runSettings (defaultSettings { settingsPort = port }) $+    logMiddleware $ execHailsApplication authMiddleware app   -- | Given an application module name, load the main controller named