lio-simple (empty) → 0.0.0.1
raw patch · 7 files changed
+530/−0 lines, 7 filesdep +basedep +base64-bytestringdep +bytestringsetup-changed
Dependencies added: base, base64-bytestring, bytestring, conduit, directory, filepath, http-types, lio, simple, simple-templates, text, unix, wai, wai-extra, warp
Files
- LICENSE +165/−0
- LIO/Web/Simple.hs +83/−0
- LIO/Web/Simple/Auth.hs +46/−0
- LIO/Web/Simple/DCLabel.hs +21/−0
- LIO/Web/Simple/TCB.hs +166/−0
- Setup.hs +2/−0
- lio-simple.cabal +47/−0
+ LICENSE view
@@ -0,0 +1,165 @@+ GNU LESSER GENERAL PUBLIC LICENSE+ Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.+++ This version of the GNU Lesser General Public License incorporates+the terms and conditions of version 3 of the GNU General Public+License, supplemented by the additional permissions listed below.++ 0. Additional Definitions. ++ As used herein, "this License" refers to version 3 of the GNU Lesser+General Public License, and the "GNU GPL" refers to version 3 of the GNU+General Public License.++ "The Library" refers to a covered work governed by this License,+other than an Application or a Combined Work as defined below.++ An "Application" is any work that makes use of an interface provided+by the Library, but which is not otherwise based on the Library.+Defining a subclass of a class defined by the Library is deemed a mode+of using an interface provided by the Library.++ A "Combined Work" is a work produced by combining or linking an+Application with the Library. The particular version of the Library+with which the Combined Work was made is also called the "Linked+Version".++ The "Minimal Corresponding Source" for a Combined Work means the+Corresponding Source for the Combined Work, excluding any source code+for portions of the Combined Work that, considered in isolation, are+based on the Application, and not on the Linked Version.++ The "Corresponding Application Code" for a Combined Work means the+object code and/or source code for the Application, including any data+and utility programs needed for reproducing the Combined Work from the+Application, but excluding the System Libraries of the Combined Work.++ 1. Exception to Section 3 of the GNU GPL.++ You may convey a covered work under sections 3 and 4 of this License+without being bound by section 3 of the GNU GPL.++ 2. Conveying Modified Versions.++ If you modify a copy of the Library, and, in your modifications, a+facility refers to a function or data to be supplied by an Application+that uses the facility (other than as an argument passed when the+facility is invoked), then you may convey a copy of the modified+version:++ a) under this License, provided that you make a good faith effort to+ ensure that, in the event an Application does not supply the+ function or data, the facility still operates, and performs+ whatever part of its purpose remains meaningful, or++ b) under the GNU GPL, with none of the additional permissions of+ this License applicable to that copy.++ 3. Object Code Incorporating Material from Library Header Files.++ The object code form of an Application may incorporate material from+a header file that is part of the Library. You may convey such object+code under terms of your choice, provided that, if the incorporated+material is not limited to numerical parameters, data structure+layouts and accessors, or small macros, inline functions and templates+(ten or fewer lines in length), you do both of the following:++ a) Give prominent notice with each copy of the object code that the+ Library is used in it and that the Library and its use are+ covered by this License.++ b) Accompany the object code with a copy of the GNU GPL and this license+ document.++ 4. Combined Works.++ You may convey a Combined Work under terms of your choice that,+taken together, effectively do not restrict modification of the+portions of the Library contained in the Combined Work and reverse+engineering for debugging such modifications, if you also do each of+the following:++ a) Give prominent notice with each copy of the Combined Work that+ the Library is used in it and that the Library and its use are+ covered by this License.++ b) Accompany the Combined Work with a copy of the GNU GPL and this license+ document.++ c) For a Combined Work that displays copyright notices during+ execution, include the copyright notice for the Library among+ these notices, as well as a reference directing the user to the+ copies of the GNU GPL and this license document.++ d) Do one of the following:++ 0) Convey the Minimal Corresponding Source under the terms of this+ License, and the Corresponding Application Code in a form+ suitable for, and under terms that permit, the user to+ recombine or relink the Application with a modified version of+ the Linked Version to produce a modified Combined Work, in the+ manner specified by section 6 of the GNU GPL for conveying+ Corresponding Source.++ 1) Use a suitable shared library mechanism for linking with the+ Library. A suitable mechanism is one that (a) uses at run time+ a copy of the Library already present on the user's computer+ system, and (b) will operate properly with a modified version+ of the Library that is interface-compatible with the Linked+ Version. ++ e) Provide Installation Information, but only if you would otherwise+ be required to provide such information under section 6 of the+ GNU GPL, and only to the extent that such information is+ necessary to install and execute a modified version of the+ Combined Work produced by recombining or relinking the+ Application with a modified version of the Linked Version. (If+ you use option 4d0, the Installation Information must accompany+ the Minimal Corresponding Source and Corresponding Application+ Code. If you use option 4d1, you must provide the Installation+ Information in the manner specified by section 6 of the GNU GPL+ for conveying Corresponding Source.)++ 5. Combined Libraries.++ You may place library facilities that are a work based on the+Library side by side in a single library together with other library+facilities that are not Applications and are not covered by this+License, and convey such a combined library under terms of your+choice, if you do both of the following:++ a) Accompany the combined library with a copy of the same work based+ on the Library, uncombined with any other library facilities,+ conveyed under the terms of this License.++ b) Give prominent notice with the combined library that part of it+ is a work based on the Library, and explaining where to find the+ accompanying uncombined form of the same work.++ 6. Revised Versions of the GNU Lesser General Public License.++ The Free Software Foundation may publish revised and/or new versions+of the GNU Lesser General Public License from time to time. Such new+versions will be similar in spirit to the present version, but may+differ in detail to address new problems or concerns.++ Each version is given a distinguishing version number. If the+Library as you received it specifies that a certain numbered version+of the GNU Lesser General Public License "or any later version"+applies to it, you have the option of following the terms and+conditions either of that published version or of any later version+published by the Free Software Foundation. If the Library as you+received it does not specify a version number of the GNU Lesser+General Public License, you may choose any version of the GNU Lesser+General Public License ever published by the Free Software Foundation.++ If the Library as you received it specifies that a proxy can decide+whether future versions of the GNU Lesser General Public License shall+apply, that proxy's public statement of acceptance of any version is+permanent authorization for you to choose that version for the+Library.
+ LIO/Web/Simple.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++{-|+ + This module defines several instances needed to use 'LIO' as the+ underlying monad with "Web.Simple", the simple web framework.+ Additionally, we provide some middleware for executing apps in a safe+ manner.++ "LIO.Web.Simple.TCB" defines several functions that can be used to+ execute 'LIO' web applications with the Warp server.++-}+module LIO.Web.Simple (+ -- * Utilities for parsing request+ body, parseForm+ -- * Middleware+ , browserLabelGuard+ , removeRequestHeaders+ , removeResponseHeaders + -- * LIO applications+ , SimpleLIOApplication, SimpleLIOMiddleware+ , LIOController+ -- * Relevant modules+ , module Web.Simple.Responses+ , module Web.Simple.Templates+ , module Web.Simple.Controller.Trans+ ) where++import safe LIO+import LIO.TCB (ioTCB)+import LIO.Web.Simple.TCB++import safe Web.Simple hiding (request, body, parseForm)+import safe Web.Simple.Responses+import safe Web.Simple.Controller.Trans+import safe Web.Simple.Templates++import Network.Wai.Parse++import Data.Conduit+import qualified Data.Conduit.List as CL++import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L+import safe qualified Data.ByteString.Lazy.Char8 as L8+++-- | Controller with 'LIO' as the underlying monad.+type LIOController l = ControllerT (LIO l)++-- | Parses a HTML form from the request body. It returns a list of 'Param's as+-- well as a list of 'File's, which are pairs mapping the name of a /file/ form+-- field to a 'FileInfo' pointing to a temporary file with the contents of the+-- upload.+--+-- Currently only tursted code can read the file.+parseForm :: Label l+ => LIOController l r ([Param], [(S.ByteString, FileInfo L.ByteString)])+parseForm = do+ req <- request+ liftLIO . ioTCB $ parseRequestBody lbsBackEnd req++-- | Parses a HTML form from the request body. It returns a list of 'Param's as+-- well as a list of 'File's, which are pairs mapping the name of a /file/ form+-- field to a 'FileInfo' pointing to a temporary file with the contents of the++-- | Reads and returns the body of the HTTP request.+--+-- Note: @body@ function consumes the body from a Source IO+-- Bytestring. Since the 'Request' constructor is exposed by+-- "Network.Wai.Internal", it's important to disallow construction of+-- such values when considering untrusted code.+body :: Label l => LIOController l r L8.ByteString+body = do+ req <- request+ liftLIO . ioTCB $ L8.fromChunks `fmap` (requestBody req $$ CL.consume)++instance Label l => MonadLIO l (ControllerT (LIO l) r) where+ liftLIO act = ControllerT $ \st -> + liftLIO act >>= \r -> return (Right r, st)
+ LIO/Web/Simple/Auth.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Provides HTTP Basic Authentication.+module LIO.Web.Simple.Auth ( basicAuth) where++import Control.Monad+import qualified Data.ByteString.Char8 as S8+import Data.ByteString.Base64+import Network.HTTP.Types+import Network.Wai+import Web.Simple.Responses+import Web.Simple.Controller.Trans+++-- | A 'Route' that uses HTTP basic authentication to authenticate a+-- request for a realm with the given username ans password. The+-- request is rewritten with an 'X-User' header containing the+-- authenticated username before being passed to the next 'Route'.+basicAuth :: Monad m+ => String -- ^ Realm+ -> (S8.ByteString -> S8.ByteString -> m Bool)+ -> SimpleMiddleware m+basicAuth realm auth app req = + case getBasicAuthLogin req of+ Nothing -> return authResp+ Just (usr, pwd) -> do+ success <- auth usr pwd+ let req' = req { requestHeaders = ("X-User", usr) : requestHeaders req }+ if success+ then app req'+ else return authResp+ where authResp = requireBasicAuth realm+++-- | Helper method for implementing basic authentication. Given a+-- 'Request' returns the (username, password) pair from the basic+-- authentication header if present.+getBasicAuthLogin :: Request -> Maybe (S8.ByteString, S8.ByteString)+getBasicAuthLogin req = do+ authStr <- lookup hAuthorization $ requestHeaders req+ unless ("Basic" `S8.isPrefixOf` authStr) $ fail "Not basic auth."+ let up = fmap (S8.split ':') $ decode $ S8.drop 6 authStr+ case up of+ Right (user:pwd:[]) -> return (user, pwd)+ _ -> fail "Malformed basic auth header."
+ LIO/Web/Simple/DCLabel.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE Safe #-}++{- | ++This module exports several types that makes it easier to write LIO+web apps with DCLabels.++-}++module LIO.Web.Simple.DCLabel (+ DCController + , SimpleDCApplication+ , SimpleDCMiddleware+ ) where++import safe LIO.DCLabel+import safe LIO.Web.Simple++type DCController = LIOController DCLabel+type SimpleDCApplication = SimpleLIOApplication CNF DCLabel+type SimpleDCMiddleware = SimpleLIOMiddleware CNF DCLabel
+ LIO/Web/Simple/TCB.hs view
@@ -0,0 +1,166 @@+{-# LANGUAGE Unsafe #-}+{-# LANGUAGE FlexibleContexts #-}++{- |+ + This module exports a function 'run' for creating a runner that is+ used to run a "Web.Simple" 'SimpleApplication' in the 'LIO' monad.++ The runner is only available to trusted code since we do not impose+ any policy on how requests and responses should be handled.+ Middleware should be used on both ends to ensure safety. This module+ provides several such Middleware.++-}++module LIO.Web.Simple.TCB (+ -- * LIO applications+ SimpleLIOApplication, SimpleLIOMiddleware+ -- * Runners+ , run, runP+ -- * Middleware+ , browserLabelGuard+ , removeRequestHeaders+ , removeResponseHeaders+ -- * Templates+ , lioGetTemplateTCB+ ) where++import safe Control.Monad++import Data.Text.Encoding++import safe Control.Applicative++import safe LIO+import safe LIO.Error+import LIO.TCB (ioTCB, getLIOStateTCB)++import safe qualified Data.List as List+import safe qualified Data.ByteString.Char8 as S8+import safe qualified Data.ByteString.Lazy.Char8 as L8++import safe Web.Simple+import safe Web.Simple.Controller.Trans+import safe Web.Simple.Templates.Language++import Network.HTTP.Types+import Network.Wai.Internal+import Network.Wai.Handler.Warp hiding (run)+import qualified Network.Wai.Handler.Warp as Warp++import safe System.FilePath++-- | An LIO simple aplpication is an 'LIO' computation mapping a set+-- of privileges and request to a response. While privileges can be+-- provided in terms of a e.g., 'Reader' monad, in certain cases not+-- having the privilege as part of the sate is cleaner.+type SimpleLIOApplication p l = Priv p -> SimpleApplication (LIO l)++-- | Simple LIO middleware.+type SimpleLIOMiddleware p l = SimpleLIOApplication p l -> SimpleLIOApplication p l++-- | Run an LIO web app wrapped by some middleware. Since web servers+-- can be quite messy it is important that you provide middleware to+-- sanitize responses to prevent data leakage.+--+-- Since security properties vary across applications, we do not+-- impose any conditions on the requests and reponses. The latter can+-- be sanitized by supplying a middleware, while the former can simply+-- be baked-into the app (as 'SimpleMiddleware'.+run :: Label l => Port -> Middleware -> SimpleApplication (LIO l) -> LIO l ()+run port middleware app = runP port middleware noPrivs (const app)++-- | Same as 'run', but run 'SimpleLIOApplication's, i.e.,+-- applications that take privileges.+runP :: (PrivDesc l p, Label l)+ => Port -> Middleware -> Priv p -> SimpleLIOApplication p l -> LIO l ()+runP port middleware priv app = do+ state <- getLIOStateTCB+ ioTCB $ Warp.run port $ middleware . filterFileResponses $+ \req -> evalLIO (app priv req) state++-- | Remove any responses that were built with 'responseFile' or+-- 'responseSource'.+filterFileResponses :: Middleware+filterFileResponses app req = do+ resp <- app req+ return $ case resp of+ ResponseBuilder _ _ _ -> resp+ _ -> serverError $ L8.pack "App should not read directly from files."++-- | Middleware that ensures the 'Response' from the+-- application is readable by the client's browser (as determined by the+-- result label of the app computation and the label of the browser). If+-- the response is not readable by the browser, the middleware sends a+-- 403 (unauthorized) response instead.+browserLabelGuard :: MonadLIO l m => l -> SimpleMiddleware m+browserLabelGuard browserLabel app req = do+ resp <- app req+ resultLabel <- liftLIO $ getLabel+ return $ if resultLabel `canFlowTo` browserLabel+ then resp+ else forbidden++-- | Remove certain headers from the request.+removeRequestHeaders :: Monad m => [HeaderName] -> SimpleMiddleware m+removeRequestHeaders headers app req = do+ app $ foldr (\h r -> rmRequestHeader r h) req headers+ where rmRequestHeader r h = r { requestHeaders = rm h (requestHeaders r) }++-- | Remove certain headers from the response, e.g., Set-Cookie.+removeResponseHeaders :: Monad m => [HeaderName] -> SimpleMiddleware m+removeResponseHeaders headers app req = do+ resp <- app req+ return $ foldr (\h r -> rmResponseHeader r h) resp headers++rmResponseHeader :: Response -> HeaderName -> Response+rmResponseHeader (ResponseFile x hs y z) h = ResponseFile x hs' y z where hs' = rm h hs+rmResponseHeader (ResponseBuilder x hs y ) h = ResponseBuilder x hs' y where hs' = rm h hs+rmResponseHeader (ResponseSource x hs y ) h = ResponseSource x hs' y where hs' = rm h hs++rm :: HeaderName -> [Header] -> [Header]+rm h = List.filter ((/= h) . fst)++-- | Function to use to get a template. When the underlying monad is+-- 'LIO', it looks in the 'viewDirectory' for the given file name and+-- compiles the file into a template.+--+-- This function should be used only when the everything reachable+-- from the 'viewDirectory' is public.+--+-- To ensure that the function cannot be abused the function first+-- cleans up the file path: if it starts out with a @..@, we consider+-- this invalid as it can be used explore parts of the filesystem that+-- should otherwise be unaccessible. Similarly, we remove any @.@ from+-- the path.+--+-- Since this funciton does not use the 'lio-fs' filesystem @readFile@,+-- but rather the 'IO' @readFile@, it should not be exposed to+-- untrusted code.+lioGetTemplateTCB :: Label l => FilePath -> LIO l Template+lioGetTemplateTCB fp = do+ fp' <- cleanUpPath fp+ eres <- compileTemplate . decodeUtf8 <$> (ioTCB $ S8.readFile fp')+ case eres of+ Left str -> fail str+ Right tmpl -> return tmpl++-- | Cleanup a file path, if it starts out with a @..@, we consider this+-- invalid as it can be used explore parts of the filesystem that should+-- otherwise be unaccessible. Similarly, we remove any @.@ from the path.+cleanUpPath :: Label l => FilePath -> LIO l FilePath +cleanUpPath path = withContext "cleanUpPath" $+ doit . splitDirectories . normalise . stripSlash $ path+ where doit [] = return []+ doit ("..":_) = throwLIO $ userError "Path cannot contain .."+ doit (_:"..":xs) = doit xs+ doit (".":xs) = doit xs+ doit (x:xs) = (x </>) `liftM` doit xs++-- | Remove any 'pathSeparator's from the front of a file path.+stripSlash :: FilePath -> FilePath +stripSlash [] = []+stripSlash xx@(x:xs) | x == pathSeparator = stripSlash xs+ | otherwise = xx+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ lio-simple.cabal view
@@ -0,0 +1,47 @@+name: lio-simple+version: 0.0.0.1+synopsis: LIO support for the Simple web framework+description:++ LIO support for the Simple web framework.+ See the 'lio' and 'simple' packages for more information.++homepage: http://simple.cx+license: LGPL-3+license-file: LICENSE+author: Hails team+maintainer: hails@scs.stanford.edu+category: Web+build-type: Simple+cabal-version: >=1.10++library+ build-depends:+ base < 6+ , bytestring+ , conduit+ , directory+ , filepath+ , wai >= 2.0+ , wai-extra+ , warp+ , http-types+ , base64-bytestring+ , simple+ , simple-templates+ , lio+ , text+ , unix++ ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-orphans++ exposed-modules:+ LIO.Web.Simple+ LIO.Web.Simple.Auth+ LIO.Web.Simple.DCLabel+ LIO.Web.Simple.TCB+ default-language: Haskell2010++source-repository head+ type: git+ location: git://github.com/scslab/lio.git