-- Hoogle documentation, generated by Haddock
-- See Hoogle, http://www.haskell.org/hoogle/
-- | Multi-app web platform framework
--
-- The rise of web platforms and their associated apps represents
-- a new way of developing and deploying software. Sites such as Facebook
-- and Yammer are no longer written by a single entity, but rather are
-- freely extended by third-party developers offering competing features
-- to users.
--
-- Allowing an app to access more user data allows developers to build
-- more compelling products. It also opens the door to accidental or
-- malicious breaches of user privacy. In the case of a website like
-- Facebook, exposing access to a user's private messages would allow an
-- external developer to build a search feature. Exciting! But, another
-- developer can take advantage of this feature to build an app that
-- mines private messages for credit card numbers, ad keywords, or other
-- sensitive data.
--
-- Frameworks such as Ruby on Rails, Django, Yesod, etc. are geared
-- towards building monolithic web sites. And, they are great for this!
-- However, they are not designed for websites that integrate third-party
-- code, and thus lack a good mechanism for building such multi-app
-- platforms without sacrificing a user's security or an app's
-- functionality.
--
-- Hails is explicitly designed for building web platforms, where
-- it is expected that a site will comprise many mutually-distrustful
-- components written by a variety of entities. We built Hails around two
-- core design principles.
--
--
-- - Separation of policy: Data access policies should be concisely
-- specified alongside data structures and schemas, rather than strewn
-- throughout the codebase in a series of conditionals. Code that
-- implements this is called a policy module in Hails (see
-- Hails.PolicyModule).
-- - Mandatory access control (MAC): Data access policies should be
-- mandatory even once code has obtained access to data. MAC lets
-- platform components modules productively interact by sharing data,
-- despite mutual distrust. Haskell lets us implement MAC at a fine
-- grained level using the information flow control library
-- LIO.
--
--
-- A Hails platform hosts two types of code: apps and /policy
-- modules/. Apps encompass what would traditionally be considered
-- controller and view logic. Policy modules are libraries that implement
-- both the model and the data security policy. They are invoked directly
-- by apps or other policy modules, but run with different privileges
-- from the invoking code. Both apps and policy modules can be
-- implemented by untrusted third parties, with the user only needing to
-- trust the policy module governing the data in question. Separating of
-- policy code from app code allows users to inspect and more easily
-- unserstand the overall security provided by the system, while MAC
-- guarantees that these policies are enforced in an end-to-end fashion.
@package hails
@version 0.9.2.2
-- | This module solely exports the versoin of hails.
module Hails.Version
version :: Version
-- | This module exports generic definitions for Wai-authentication
-- pipelines in Hails. requireLoginMiddleware looks for the
-- X-Hails-Login header from an Application 's
-- Response and, if present, responds to the user with an
-- authentication request instead of the Application response
-- (e.g., a redirect to a login page or an HTTP response with status
-- 401).
--
-- Additionally, this module exports authentication Middlewares
-- for basic HTTP authentication, devBasicAuth, (useful in
-- development environments) and federated (OpenID) authentication,
-- openIdAuth. In general, authentication Middlewares are
-- expected to set the X-Hails-User header on the request if it
-- is from an authenticated user.
module Hails.HttpServer.Auth
-- | Executes the app and if the app Response has header
-- X-Hails-Login and the user is not logged in, respond with an
-- authentication response (Basic Auth, redirect, etc.)
requireLoginMiddleware :: ResourceT IO Response -> Middleware
-- | Authentica user with Mozilla's persona. If the
-- X-Hails-Persona-Login header is set, this intercepts the
-- request and verifies the supplied identity assertion, supplied in the
-- request body.
--
-- If the authentication is successful, set the _hails_user and
-- _hails_user_hmac cookies to identify the user. The former
-- contains the user email address, the latter contains the MAC that is
-- used for verifications in later requests.
--
-- If the X-Hails-Persona-Logout header is set, this intercepts
-- the request and deletes the aforementioned cookies.
--
-- If the app wishes the user to authenticate (by setting
-- X-Hails-Login) this redirects to audience/login --
-- where the app can call navigator.request().
personaAuth :: ByteString -> Text -> Middleware
-- | Perform OpenID authentication.
openIdAuth :: Text -> Middleware
-- | Basic HTTP authentication middleware for development. Accepts any
-- username and password.
devBasicAuth :: Middleware
module Hails.HttpServer.Types
-- | A request sent by the end-user.
data Request
Request :: Method -> HttpVersion -> ByteString -> ByteString -> ByteString -> Int -> RequestHeaders -> Bool -> SockAddr -> [Text] -> Query -> ByteString -> UTCTime -> Request
-- | HTTP Request (e.g., GET, POST, etc.).
requestMethod :: Request -> Method
-- | HTTP version (e.g., 1.1 or 1.0).
httpVersion :: Request -> HttpVersion
-- | Extra path information sent by the client.
rawPathInfo :: Request -> ByteString
-- | If no query string was specified, this should be empty. This value
-- will include the leading question mark. Do not modify this raw
-- value- modify queryString instead.
rawQueryString :: Request -> ByteString
-- | Generally the host requested by the user via the Host request header.
-- Backends are free to provide alternative values as necessary. This
-- value should not be used to construct URLs.
serverName :: Request -> ByteString
-- | The listening port that the server received this request on. It is
-- possible for a server to listen on a non-numeric port (i.e., Unix
-- named socket), in which case this value will be arbitrary. Like
-- serverName, this value should not be used in URL construction.
serverPort :: Request -> Int
-- | The request headers.
requestHeaders :: Request -> RequestHeaders
-- | Was this request made over an SSL connection?
isSecure :: Request -> Bool
-- | The client's host information.
remoteHost :: Request -> SockAddr
-- | Path info in individual pieces- the url without a hostname/port and
-- without a query string, split on forward slashes,
pathInfo :: Request -> [Text]
-- | Parsed query string information
queryString :: Request -> Query
-- | Lazy ByteString containing the request body.
requestBody :: Request -> ByteString
-- | Time request was received.
requestTime :: Request -> UTCTime
-- | Get the request body type (copied from wai-extra).
getRequestBodyType :: Request -> Maybe RequestBodyType
data RequestBodyType :: *
UrlEncoded :: RequestBodyType
Multipart :: ByteString -> RequestBodyType
-- | Add/replace a Header to the Request
addRequestHeader :: Request -> Header -> Request
-- | Remove a header (if it exists) from the Request
removeRequestHeader :: Request -> HeaderName -> Request
-- | A response sent by the app.
data Response
Response :: Status -> ResponseHeaders -> ByteString -> Response
-- | Response status
respStatus :: Response -> Status
-- | Response headers
respHeaders :: Response -> ResponseHeaders
-- | Response body
respBody :: Response -> ByteString
-- | Add/replace a Header to the Response
addResponseHeader :: Response -> Header -> Response
-- | Remove a header (if it exists) from the Response
removeResponseHeader :: Response -> HeaderName -> Response
-- | Base Hails type implemented by untrusted applications.
type Application = RequestConfig -> DCLabeled Request -> DC Response
-- | The settings with which the app will run.
data RequestConfig
RequestConfig :: DCLabel -> DCLabel -> DCPriv -> RequestConfig
-- | The label of the browser the reponse will be sent to.
browserLabel :: RequestConfig -> DCLabel
-- | The label of the incoming request (with the logged in user's
-- integrity).
requestLabel :: RequestConfig -> DCLabel
-- | A privilege minted for the app.
appPrivilege :: RequestConfig -> DCPriv
-- | Convenience type for middleware components.
type Middleware = Application -> Application
instance Show Request
instance Show Response
instance Show RequestConfig
-- | This module exports the core of the Hails HTTP server. Specifically it
-- defines basic types, such as HTTP Request and Response,
-- used by the Hails web server and untrusted Hails Applications.
--
-- 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. Moreover, every
-- Request is sanitized with sanitizeReq before handed
-- over to authenticators.
--
-- Hails uses Wai, and as such we provide a function for converting Hails
-- Applications to Wai Applicatoins:
-- execHailsApplication.
module Hails.HttpServer
-- | Execute an application, safely filtering unsafe request headers,
-- overriding method posts, catching all exceptions, and sanitizing
-- responses.
execHailsApplication :: Middleware -> Application -> Application
-- | Remove any unsafe headers, in this case only X-Hails-User.
sanitizeReqMiddleware :: Middleware
-- | Hails 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 :: Middleware
-- | Adds the header X-Hails-Label to the response. If the label
-- of the computation does not flow to the public label, dcPub,
-- the JSON field isPublic is set to true, otherwise it
-- is set to true and the JSON label is set to the
-- secrecy component of the response label (if it is a disjunction of
-- principals is added). An example may be:
--
--
-- X-Hails-Label = { isPublic: true }
--
--
-- or
--
--
-- X-Hails-Label = { isPublic: false, label : ["http://google.com:80", "alice"] }
--
guardSensitiveResp :: Middleware
-- | Remove anything from the response that could cause inadvertant
-- declasification. Currently this only removes the Set-Cookie
-- header.
sanitizeResp :: Middleware
-- | Catch all exceptions thrown by middleware and return 500.
catchAllExceptions :: Middleware
-- | Exports basic HTTP client functions inside the DC Monad.
-- Computations are allowed to communicate over HTTP as long as they can
-- read and write to a labeled origin. An origin is associated with two
-- labels. When writing, the origin has a label of the form <
-- "scheme://authority", |True >, where scheme is either
-- 'http' or 'https', and authority is the domain name or IP
-- address used in the request and port number of the connection. In
-- other words, the secrecy component contains the origin information,
-- while the integrity component is the same as that of public data. When
-- reading, the origin has a label of the form < |True,
-- "scheme://authority" >.
--
-- This means that DC computations can export data if the current
-- label is not higher than that of the labeled origin, and read data
-- that is no more trustworthy than that of the origin. Practically, this
-- means that untrusted computation can export data so long as the they
-- have not observed any data more sensitive than the label of the target
-- domain. Reading (which also occurs on every request/write) further
-- raises the current label to the join of the current label and origin.
--
-- For example, suppose some piece of data, myLoc, has the
-- label:
--
--
-- aliceLocL = dcLabel ("alice" /\ "http://maps.googleapis.com:80") dcTrue
--
--
-- created as:
--
--
-- myLoc <- labelP alicePriv aliceLocL "3101 24th Street, San Francisco, CA"
--
--
-- Then, untrusted code (with initial label set to public) running on
-- behalf of "alice" , may perform the following operation:
--
--
-- let mapBase = "http://maps.googleapis.com/maps/api/geocode/json?sensor=false"
-- aliceLoc <- unlabelP alicePriv myLoc
-- resp <- simpleGetHttp $ mapBase ++ "&address=" ++ aliceLoc
--
--
-- In this case the unlabelP will raise the current label to the
-- label:
--
--
-- < "http://maps.googleapis.com:80", |True >
--
--
-- by exercising "alice"s privilges. Directly, the simpleHttp will
-- be permitted. However, if
--
--
-- let mapBase = "http://maps.evilalternatives.org/geocode/json?sensor=false"
--
--
-- an exception will be thrown since the current label does not flow to
-- the label of mapBase.
--
-- This module uses 'http-conduit' as the underlying client, we recommend
-- looking at the Network.HTTP.Conduit documentation on how to
-- construct Requests. Here, we highlight some important details:
--
--
-- - The headers Content-Length and Host are
-- automatically set, and should not be added to
-- requestHeaders.
-- - By default, the functions in this package will not throw
-- exceptions for non-2xx status codes. If you would like to use the
-- default http-conduit behavior, you should use checkStatus,
-- e.g.:
--
--
--
-- req <- parseUrl mapBase
-- resp <- simpleGetHttp $ req { checkStatus = \s@(Status sci _) hs ->
-- if 200 <= sci && sci < 300
-- then Nothing
-- else Just $ toException $ StatusCodeException s hs }
--
module Hails.HttpClient
-- | Reques type, wrapper for the conduit Request.
type Request = Request (ResourceT IO)
-- | HTTP request method, eg GET, POST.
method :: Request m -> Method
-- | Whether to use HTTPS (ie, SSL).
secure :: Request m -> Bool
host :: Request m -> ByteString
port :: Request m -> Int
-- | Everything from the host to the query string.
path :: Request m -> ByteString
queryString :: Request m -> ByteString
-- | Custom HTTP request headers
--
-- As already stated in the introduction, the Content-Length and Host
-- headers are set automatically by this module, and shall not be added
-- to requestHeaders.
--
-- Moreover, the Accept-Encoding header is set implicitly to gzip for
-- convenience by default. This behaviour can be overridden if needed, by
-- setting the header explicitly to a different value. In order to omit
-- the Accept-Header altogether, set it to the empty string "". If you
-- need an empty Accept-Header (i.e. requesting the identity encoding),
-- set it to a non-empty white-space string, e.g. " ". See RFC 2616
-- section 14.3 for details about the semantics of the Accept-Header
-- field. If you request a content-encoding not supported by this module,
-- you will have to decode it yourself (see also the decompress
-- field).
--
-- Note: Multiple header fields with the same field-name will result in
-- multiple header fields being sent and therefore it's the
-- responsibility of the client code to ensure that the rules from RFC
-- 2616 section 4.2 are honoured.
requestHeaders :: Request m -> RequestHeaders
requestBody :: Request m -> RequestBody m
-- | If True, a chunked and/or gzipped body will not be decoded.
-- Use with caution.
rawBody :: Request m -> Bool
-- | How many redirects to follow when getting a resource. 0 means follow
-- no redirects. Default value: 10.
redirectCount :: Request m -> Int
-- | Check the status code. Note that this will run after all redirects are
-- performed. Default: return a StatusCodeException on non-2XX
-- responses.
checkStatus :: Request m -> Status -> ResponseHeaders -> CookieJar -> Maybe SomeException
-- | Predicate to specify whether gzipped data should be decompressed on
-- the fly (see alwaysDecompress and
-- browserDecompress). Default: browserDecompress.
decompress :: Request m -> ContentType -> Bool
-- | A response sent by the app.
data Response
Response :: Status -> ResponseHeaders -> ByteString -> Response
-- | Response status
respStatus :: Response -> Status
-- | Response headers
respHeaders :: Response -> ResponseHeaders
-- | Response body
respBody :: Response -> ByteString
-- | Convert a URL into a Request.
--
-- This defaults some of the values in Request, such as setting
-- method to GET and requestHeaders to [].
parseUrl :: String -> DC Request
-- | Add a Basic Auth header (with the specified user name and password) to
-- the given Request. Ignore error handling:
--
-- applyBasicAuth user pass $ fromJust $ parseUrl url
applyBasicAuth :: ByteString -> ByteString -> Request m -> Request m
-- | Perform a simple HTTP(S) request.
simpleHttp :: Request -> DC Response
-- | Same as simpleHttp, but uses privileges.
simpleHttpP :: DCPriv -> Request -> DC Response
-- | Simple HTTP GET request.
simpleGetHttp :: String -> DC Response
-- | Simple HTTP GET request.
simpleGetHttpP :: DCPriv -> String -> DC Response
-- | Simple HTTP HEAD request.
simpleHeadHttp :: String -> DC Response
-- | Simple HTTP HEAD request.
simpleHeadHttpP :: DCPriv -> String -> DC Response
data HttpException :: *
StatusCodeException :: Status -> ResponseHeaders -> CookieJar -> HttpException
InvalidUrlException :: String -> String -> HttpException
-- | List of encountered responses containing redirects in reverse
-- chronological order; including last redirect, which triggered the
-- exception and was not followed.
TooManyRedirects :: [Response ByteString] -> HttpException
-- | Response containing unparseable redirect.
UnparseableRedirect :: Response ByteString -> HttpException
TooManyRetries :: HttpException
HttpParserException :: String -> HttpException
HandshakeFailed :: HttpException
OverlongHeaders :: HttpException
ResponseTimeout :: HttpException
-- | host/port
FailedConnectionException :: String -> Int -> HttpException
ExpectedBlankAfter100Continue :: HttpException
InvalidStatusLine :: ByteString -> HttpException
InvalidHeader :: ByteString -> HttpException
InternalIOException :: IOException -> HttpException
-- | host/port
ProxyConnectException :: ByteString -> Int -> Either ByteString HttpException -> HttpException
NoResponseDataReceived :: HttpException
TlsException :: SomeException -> HttpException
instance Exception e => Failure e (LIO DCLabel)
-- | This module defines some convenience functions for creating responses.
module Hails.Web.Responses
-- | Creates a 200 (OK) Response with the given content-type and
-- resposne body
ok :: ContentType -> ByteString -> Response
-- | Creates a 200 (OK) Response with content-type "text/html" and
-- the given resposne body
okHtml :: ByteString -> Response
-- | Given a URL returns a 301 (Moved Permanently) Response
-- redirecting to that URL.
movedTo :: String -> Response
-- | Given a URL returns a 303 (See Other) Response redirecting to
-- that URL.
redirectTo :: String -> Response
-- | Returns a 400 (Bad Request) Response.
badRequest :: Response
-- | Returns a 401 (Authorization Required) Response requiring basic
-- authentication in the given realm.
requireBasicAuth :: String -> Response
-- | Returns a 403 (Forbidden) Response.
forbidden :: Response
-- | Returns a 404 (Not Found) Response.
notFound :: Response
-- | Returns a 500 (Server Error) Response.
serverError :: Response
-- | Conceptually, a route is function that, given an HTTP request, may
-- return an action (something that would return a response for the
-- client if run). Routes can be concatenated--where each route is
-- evaluated until one matches--and nested. Routes are expressed through
-- the Routeable type class. runRoute transforms an
-- instance of Routeable to a function from Request to a
-- monadic action (in the ResourceT monad) that returns a
-- Maybe Response. The return type was chosen to be monadic
-- so routing decisions can depend on side-effects (e.g. a random number
-- or counter for A/B testing, IP geolocation lookup etc').
module Hails.Web.Router
-- | Routeable types can be converted into a route function using
-- runRoute. If the route is matched it returns a Response,
-- otherwise Nothing.
--
-- In general, Routeables are data-dependant (on the
-- Request), but don't have to be. For example, Application
-- is an instance of Routeable that always returns a
-- Response:
--
--
-- instance Routeable Application where
-- runRoute app req = app req >>= return . Just
--
class Routeable r
runRoute :: Routeable r => r -> RouteHandler
-- | Converts any Routeable into an Application that can be
-- passed directly to a WAI server.
mkRouter :: Routeable r => r -> Application
-- | Synonym for RouteM, the common case where the data parameter is
-- '()'.
type Route = RouteM ()
-- | The RouteM type is a basic instance of Routeable that
-- simply holds the routing function and an arbitrary additional data
-- parameter. In most cases this paramter is simply '()', hence we have a
-- synonym for RouteM '()' called Route. The power
-- is derived from the instances of Monad and Monoid, which
-- allow the simple construction of complex routing rules using either
-- lists (Monoid) or do-notation. Moreover, because of it's simple
-- type, any Routeable can be used as a Route (using
-- routeAll or by applying it to runRoute), making it
-- possible to leverage the monadic or monoid syntax for any
-- Routeable.
--
-- Commonly, route functions that construct a Route only inspect
-- the Request and other parameters. For example, routeHost
-- looks at the hostname:
--
--
-- routeHost :: Routeable r => S.ByteString -> r -> Route
-- routeHost host route = Route func ()
-- where func req = if host == serverName req
-- then runRoute route req
-- else return Nothing
--
--
-- However, because the result of a route is in the ResourceT
-- monad, routes have all the power of an Application and can make
-- state-dependant decisions. For example, it is trivial to implement a
-- route that succeeds for every other request (perhaps for A/B testing):
--
--
-- routeEveryOther :: (Routeable r1, Routeable r2)
-- => MVar Int -> r1 -> r2 -> Route
-- routeEveryOther counter r1 r2 = Route func ()
-- where func req = do
-- i liftIO . modifyMVar $ \i -
-- let i' = i+1
-- in return (i', i')
-- if i mod 2 == 0
-- then runRoute r1 req
-- else runRoute r2 req
--
data RouteM a
Route :: RouteHandler -> a -> RouteM a
-- | A route that always matches (useful for converting a Routeable
-- into a Route).
routeAll :: Routeable r => r -> Route
-- | Matches on the hostname from the Request. The route only
-- successeds on exact matches.
routeHost :: Routeable r => ByteString -> r -> Route
-- | Matches if the path is empty. Note that this route checks that
-- pathInfo is empty, so it works as expected when nested under
-- namespaces or other routes that pop the pathInfo list.
routeTop :: Routeable r => r -> Route
-- | Matches on the HTTP request method (e.g. GET, POST,
-- PUT)
routeMethod :: Routeable r => StdMethod -> r -> Route
-- | Routes the given URL pattern. Patterns can include directories as well
-- as variable patterns (prefixed with :) to be added to
-- queryString (see routeVar)
--
--
-- - /posts/:id
-- - /posts/:id/new
-- - /:date/posts/:category/new
--
routePattern :: Routeable r => ByteString -> r -> Route
-- | Matches if the first directory in the path matches the given
-- ByteString
routeName :: Routeable r => ByteString -> r -> Route
-- | Always matches if there is at least one directory in pathInfo
-- but and adds a parameter to queryString where the key is the
-- supplied variable name and the value is the directory consumed from
-- the path.
routeVar :: Routeable r => ByteString -> r -> Route
instance Routeable (RouteM a)
instance Monoid Route
instance Monad RouteM
instance Routeable Response
instance Routeable Application
-- | Frank is a Sinatra-inspired DSL (see http://www.sinatrarb.com)
-- for creating routes. It is composable with all Routeable types,
-- but is designed to be used with Controllers. Each verb
-- (get, post, put, etc') takes a URL pattern of the
-- form "/dir/:paramname/dir" (see routePattern for details) and a
-- Routeable:
--
--
-- module SimpleFrank (server) where
--
-- import Data.String
-- import Data.Maybe
-- import Control.Monad
--
-- import LIO
-- import Hails.HttpServer.Types
-- import Hails.Web
-- import qualified Hails.Web.Frank as F
--
-- server :: Application
-- server = mkRouter $ do
-- F.get "/users" $ do
-- req <- request >>= unlabel
-- return $ okHtml $ fromString $
-- "Welcome Home " ++ (show $ serverName req)
-- F.get "/users/:id" $ do
-- userId <- fromMaybe "" `liftM` queryParam "id"
-- return $ ok "text/json" $ fromString $
-- "{\"myid\": " ++ (show userId) ++ "}"
-- F.put "/user/:id" $ do
-- ...
--
--
-- With hails, you can directly run this:
--
--
-- hails --app=SimpleFrank
--
--
-- And, with curl, you can now checkout your page:
--
--
-- $ curl localhost:8080/users
-- Welcome Home "localhost"
--
-- $ curl localhost:8080/users/123
-- {"myid": "123"}
--
-- $ ...
--
module Hails.Web.Frank
-- | Matches the GET method on the given URL pattern
get :: Routeable r => ByteString -> r -> Route
-- | Matches the POST method on the given URL pattern
post :: Routeable r => ByteString -> r -> Route
-- | Matches the PUT method on the given URL pattern
put :: Routeable r => ByteString -> r -> Route
-- | Matches the DELETE method on the given URL pattern
delete :: Routeable r => ByteString -> r -> Route
-- | Matches the OPTIONS method on the given URL pattern
options :: Routeable r => ByteString -> r -> Route
-- | REST is a DSL for creating routes using RESTful HTTP verbs. See
-- http://en.wikipedia.org/wiki/Representational_state_transfer
--
-- For example, an app handling users may define a REST controller as:
--
--
-- module SimpleREST (server) where
--
-- import Data.String
-- import Data.Maybe
-- import Control.Monad
--
-- import LIO
-- import Hails.HttpServer.Types
-- import Hails.Web
-- import qualified Hails.Web.REST as REST
--
-- server :: Application
-- server = mkRouter $ routeName "users" $ do
-- REST.index $ do
-- req <- request >>= unlabel
-- return $ okHtml $ fromString $
-- "Welcome Home " ++ (show $ serverName req)
-- REST.show $ do
-- userId <- fromMaybe "" `liftM` queryParam "id"
-- return $ ok "text/json" $ fromString $
-- "{\"myid\": " ++ (show userId) ++ "}"
-- ...
--
--
-- With hails, you can directly run this:
--
--
-- hails --app=SimpleREST
--
--
-- And, with curl, you can now checkout your page:
--
--
-- $ curl localhost:8080/users
-- Welcome Home "localhost"
--
-- $ curl localhost:8080/users/123
-- {"myid": "123"}
--
-- $ ...
--
module Hails.Web.REST
-- | Monad used to encode a REST controller incrementally. The return type
-- is not used, hence always '()'.
type RESTController = RESTControllerM ()
-- | GET /
index :: Routeable r => r -> RESTController
-- | GET /:id
show :: Routeable r => r -> RESTController
-- | POST /
create :: Routeable r => r -> RESTController
-- | PUT /:id
update :: Routeable r => r -> RESTController
-- | DELETE /:id
delete :: Routeable r => r -> RESTController
-- | GET /:id/edit
edit :: Routeable r => r -> RESTController
-- | GET /new
new :: Routeable r => r -> RESTController
instance Routeable (RESTControllerM a)
instance Routeable RESTControllerState
-- | This module exports a definition of a Controller, which is
-- simply a DC action with the Labeled HTTP Request
-- in the environment (i.e., it is a Reader monad).
module Hails.Web.Controller
-- | A controller is simply a reader monad atop DC with the
-- Labeled Request as the environment.
type Controller = ReaderT ControllerState DC
data ControllerState
ControllerState :: DCLabeled Request -> ControllerState
csRequest :: ControllerState -> DCLabeled Request
-- | Get the underlying request.
request :: Controller (DCLabeled Request)
-- | Get a request header
requestHeader :: HeaderName -> Controller (Maybe ByteString)
-- | Extract the body in the request (after unlabeling it).
body :: Controller ByteString
-- | Get the query parameter mathing the supplied variable name.
queryParam :: ByteString -> Controller (Maybe ByteString)
-- | Produce a response.
respond :: Routeable r => r -> Controller r
-- | Redirect back acording to the referer header. If the header is not
-- present redirect to root (i.e., /).
redirectBack :: Controller Response
-- | Redirect back acording to the referer header. If the header is not
-- present return the given response.
redirectBackOr :: Response -> Controller Response
instance Routeable (Controller Response)
instance MonadLIO DCLabel Controller
-- | This module exports a type corresponding to user's in Hails and some
-- helper functions.
module Hails.Web.User
-- | User name.
type UserName = Text
-- | Get the current user.
getHailsUser :: Controller (Maybe UserName)
-- | Execute action with the current user's name. Otherwise, request that
-- the user authenticate.
withUserOrDoAuth :: (UserName -> Controller Response) -> Controller Response
-- | This module re-exports the routing and controller modules. See each
-- module for their corresponding documentation.
--
-- Though you can implement a controller using the methods supplied by
-- this module (actually, Hails.Web.Router), we recommend using
-- the DSLs provided by Hails.Web.Frank or Hails.Web.REST.
module Hails.Web
-- | This module exports the type for a Hails BSON document,
-- HsonDoc. A Hails document is akin to Data.Bson's
-- documents, but differs in two ways. First, Hails restricts the number
-- of types to a subset of BSON's (see BsonVal). This
-- restriction is primarily due to the fact that many of the BSON types
-- are redundant and not used (at least within Hails). Second, Hails
-- allows for documents to contain policy-labeled values.
--
-- Policy labeled values (PolicyLabeled) are permitted only at the
-- "top-level" of a document. (This is primarily done to keep
-- policy-specification simple and may change in the future.)
-- Consequently to allow for nested documents and documents containing an
-- array of values we separate top-level fields (HsonField), that
-- may contain policy labeled values, from potentially-nested fields
-- (BsonField). A top-level field HsonField is thus either
-- a BsonField or a PolicyLabled value.
--
-- To keep the TCB compact, this module does not export the combinators
-- used to create documents in a friendly fashion. See
-- Hails.Data.Hson for the safe external API.
--
-- Credit: Much of this code is based on/reuses Data.Bson.
module Hails.Data.Hson.TCB
-- | A top-level document containing HsonFields.
type HsonDocument = [HsonField]
-- | A (possibly top-)level document containing BsonFields.
type BsonDocument = [BsonField]
-- | The name of a field.
type FieldName = Text
-- | A field containing a named HsonValue
data HsonField
HsonField :: !FieldName -> HsonValue -> HsonField
-- | A field containing a named BsonValue
data BsonField
BsonField :: !FieldName -> BsonValue -> BsonField
-- | An HsonValue is a top-level value that may either be a
-- BsonValue or a policy labeled value. The separation of values
-- into BsonValue and HsonValue is solely due to the
-- restriction that policy-labeled values may only occur at the top level
-- and BsonValues may be nested (e.g. using BsonArray and
-- BsonDoc).
data HsonValue
-- | Bson value
HsonValue :: BsonValue -> HsonValue
-- | Policy labeled value
HsonLabeled :: PolicyLabeled -> HsonValue
-- | A BsonValue is a subset of BSON (Data.Bson) values.
-- Note that a BsonValue cannot contain any labeled values; all
-- labeled values occur in a document as HsonValues.
-- Correspondingly, BsonValues may be arbitrarily nested.
data BsonValue
-- | Float value
BsonFloat :: Double -> BsonValue
-- | String value
BsonString :: Text -> BsonValue
-- | Inner document
BsonDoc :: BsonDocument -> BsonValue
-- | List of values
BsonArray :: [BsonValue] -> BsonValue
-- | Binary blob value
BsonBlob :: Binary -> BsonValue
-- | Object Id value
BsonObjId :: ObjectId -> BsonValue
-- | Boolean value
BsonBool :: Bool -> BsonValue
-- | Time stamp value
BsonUTC :: UTCTime -> BsonValue
-- | The NULL value
BsonNull :: BsonValue
-- | 32-bit integer
BsonInt32 :: Int32 -> BsonValue
-- | 64-bit integer
BsonInt64 :: Int64 -> BsonValue
-- | A PolicyLabeled value can be either an unlabeled value for
-- which the policy needs to be applied (NeedPolicyTCB), or an
-- already labeled value (HasPolicyTCB). PolicyLabeled
-- is a partially-opaque type; code should not be able to inspect the
-- value of an unlabeleda value, but may inspect an already labeled
-- value.
data PolicyLabeled
-- | Policy was not applied
NeedPolicyTCB :: BsonValue -> PolicyLabeled
-- | Policy applied
HasPolicyTCB :: (DCLabeled BsonValue) -> PolicyLabeled
-- | A BSON ObjectID is a 12-byte value consisting of a 4-byte timestamp
-- (seconds since epoch), a 3-byte machine id, a 2-byte process id, and a
-- 3-byte counter. Note that the timestamp and counter fields must be
-- stored big endian unlike the rest of BSON. This is because they are
-- compared byte-by-byte and we want to ensure a mostly increasing order.
data ObjectId :: *
Oid :: Word32 -> Word64 -> ObjectId
-- | Arbitrary binary blob
newtype Binary
Binary :: S8 -> Binary
unBinary :: Binary -> S8
-- | Strict ByeString
type S8 = ByteString
-- | Convert a top-level document (i.e., HsonDocument) to a
-- Data.Bson Document. This is the primary marshall-out
-- function. All PolicyLabeled values are marshalled out as
-- Data.Bson UserDefined values. This means that the
-- UserDefined type is reserved and exposing it as a type in
-- BsonValue would potentially lead to vulnerabilities in which
-- labeled values can be marshalled in from well-crafted ByteStrings.
-- Moreover, untrusted code should not have access to this function;
-- having such access would allow it to inspect the serialized labeled
-- values and thus violate IFC.
hsonDocToDataBsonDocTCB :: HsonDocument -> Document
-- | Convert Data.Bson Document to a HsonDocument.
-- This is the top-level function that marshalls BSON documents to Hails
-- documents. This function assumes that all documents have been
-- marshalled out using hsonDocToDataBsonDocTCB. Otherwise, the
-- PolicyLabled values that are created from the document may be
-- forged.
dataBsonDocToHsonDocTCB :: Document -> HsonDocument
-- | Convert a BsonDocument to a Data.Bson Document.
bsonDocToDataBsonDocTCB :: BsonDocument -> Document
-- | Convert a Data.Bson Value to a HsonValue. See
-- dataBsonDocToHsonDocTCB.
dataBsonValueToHsonValueTCB :: Value -> HsonValue
-- | Hails internal prefix that is used to serialized labeled values.
add__hails_prefix :: FieldName -> FieldName
instance Typeable Binary
instance Typeable BsonValue
instance Typeable BsonField
instance Typeable PolicyLabeled
instance Typeable HsonValue
instance Typeable HsonField
instance Show Binary
instance Read Binary
instance Eq Binary
instance Ord Binary
instance Eq BsonValue
instance Ord BsonValue
instance Eq BsonField
instance Ord BsonField
instance Eq HsonValue
instance Ord HsonValue
instance Eq HsonField
instance Ord HsonField
instance Show PolicyLabeled
instance Ord PolicyLabeled
instance Eq PolicyLabeled
-- | This module exports the type for a Hails BSON document,
-- HsonDoc and related classes for creating such documents. A
-- Hails document is similar to Data.Bson's documents, but differs
-- in two ways. First, Hails restricts the number of types to a subset of
-- BSON's (see BsonVal). This restriction is primarily due to the
-- fact that many of the BSON types are redundant and not used (at least
-- within Hails). Second, Hails allows for documents to contain
-- policy-labeled values.
--
-- Policy labeled values (PolicyLabeled) are permitted only at the
-- "top-level" of a document. (This is primarily done to keep
-- policy-specification simple and may change in the future.)
-- Consequently to allow for nested documents and documents containing an
-- array of values we separate top-level fields (HsonField), that
-- may contain policy labeled values, from potentially-nested fields
-- (BsonField). A top-level field HsonField is thus either
-- a BsonField or a PolicyLabled value.
--
-- Example:
--
--
-- module Main (x, y) where
--
-- import Data.Text (Text)
--
-- import LIO.DCLabel
-- import LIO.Labeled.TCB (labelTCB)
-- import Hails.Data.Hson
--
-- -- | Create document, verbose approach
-- x :: HsonDocument
-- x = [ "myInt" =: BsonInt32 42
-- , "nested" =: BsonDoc [ "flag" =: BsonBool True]
-- , "secret" =: (HsonLabeled $ hasPolicy (labelTCB dcPub (BsonString "hi")))
-- ]
--
-- -- | Create same document, clean approach
-- y :: HsonDocument
-- y = [ "myInt" -: (42 :: Int)
-- , "nested" -: ([ "flag" -: True] :: BsonDocument)
-- , "secret" -: labelTCB dcPub (toBsonValue ("hi" :: Text))
-- ]
--
--
-- Both x and y with -XOverloadedStrings:
--
--
-- [myInt -: 42,nested -: [flag -: True],secret -: HsonLabeled]
--
module Hails.Data.Hson
-- | A top-level document containing HsonFields.
type HsonDocument = [HsonField]
-- | Synonym for HsonDocument
type Document = HsonDocument
-- | A (possibly top-)level document containing BsonFields.
type BsonDocument = [BsonField]
-- | Class used to implement operatoins on documents that return
-- HsonValues or BsonValues. The main role of this function
-- is to impose the functional dependency between values and fields. As a
-- consequence looking up and getting valueAt in a
-- HsonDocument (resp. BsonDocument) will return a
-- HsonValue (resp. BsonValue). This eliminates the need to
-- specify the end type of very query, but forces the programmer to cast
-- between Hson and Bson values.
class Field v f => DocOps v f | v -> f, f -> v where look n doc = case find ((== n) . fieldName) doc of { Just v -> fieldValue v _ -> fail $ "look: Not found " ++ show n } valueAt n = runIdentity . look n
look :: (DocOps v f, Field v f, Monad m) => FieldName -> [f] -> m v
valueAt :: (DocOps v f, Field v f) => FieldName -> [f] -> v
serialize :: DocOps v f => [f] -> ByteString
-- | Class used to implement operations on documents that return Haskell
-- values (as opposed to HsonValue or BsonValue).
class DocValOps d v where at n = runIdentity . lookup n
lookup :: (DocValOps d v, Monad m) => FieldName -> d -> m v
at :: DocValOps d v => FieldName -> d -> v
-- | Only include fields specified.
include :: IsField f => [FieldName] -> [f] -> [f]
-- | Exclude fields specified.
exclude :: IsField f => [FieldName] -> [f] -> [f]
-- | Merge documents with preference given to first one when both have the
-- same field name.
merge :: IsField f => [f] -> [f] -> [f]
-- | Convert BsonDocument to HsonDocument
bsonDocToHsonDoc :: BsonDocument -> HsonDocument
-- | Convert BsonField to HsonField
bsonFieldToHsonField :: BsonField -> HsonField
-- | Returns true if the document is composed solely of BsonValues.
-- This function is useful when converting from HsonDocument to
-- BsonDocument.
isBsonDoc :: HsonDocument -> Bool
-- | This is a relaxed version of hsonDocToBsonDocStrict that only
-- converts fields containing BsonValues. In other words, the
-- PolicyLabeled values are dropped.
hsonDocToBsonDoc :: HsonDocument -> BsonDocument
-- | Convert an HsonDocument to a BsonDocument. If any of the
-- fields contain PolicyLabeled values (i.e., are
-- HsonLabeled values) this function fails, otherwise it
-- returns the converted document. To check for failure use
-- isBsonDoc.
hsonDocToBsonDocStrict :: Monad m => HsonDocument -> m BsonDocument
-- | Convert a labeled request to a labeled document. Values of fields that
-- have a name that ends with [] are converted to arrays and the
-- suffix [] is stripped from the name.
labeledRequestToHson :: MonadDC m => DCLabeled Request -> m (DCLabeled HsonDocument)
-- | The name of a field.
type FieldName = Text
-- | A field containing a named HsonValue
data HsonField
HsonField :: !FieldName -> HsonValue -> HsonField
-- | A field containing a named BsonValue
data BsonField
BsonField :: !FieldName -> BsonValue -> BsonField
-- | Class for retrieving the name of a field.
class IsField f
fieldName :: IsField f => f -> FieldName
-- | Class used to define fields.
class (IsField f, Show v, Show f) => Field v f
(=:) :: Field v f => FieldName -> v -> f
fieldValue :: (Field v f, Monad m) => f -> m v
-- | Class used to define fields.
class (Show v, Show f) => GenField v f
(-:) :: GenField v f => FieldName -> v -> f
-- | An HsonValue is a top-level value that may either be a
-- BsonValue or a policy labeled value. The separation of values
-- into BsonValue and HsonValue is solely due to the
-- restriction that policy-labeled values may only occur at the top level
-- and BsonValues may be nested (e.g. using BsonArray and
-- BsonDoc).
data HsonValue
-- | Bson value
HsonValue :: BsonValue -> HsonValue
-- | Policy labeled value
HsonLabeled :: PolicyLabeled -> HsonValue
-- | Class used to (de)construct HsonValues
class (Typeable a, Show a) => HsonVal a
toHsonValue :: HsonVal a => a -> HsonValue
fromHsonValue :: (HsonVal a, Monad m) => HsonValue -> m a
-- | A BsonValue is a subset of BSON (Data.Bson) values.
-- Note that a BsonValue cannot contain any labeled values; all
-- labeled values occur in a document as HsonValues.
-- Correspondingly, BsonValues may be arbitrarily nested.
data BsonValue
-- | Float value
BsonFloat :: Double -> BsonValue
-- | String value
BsonString :: Text -> BsonValue
-- | Inner document
BsonDoc :: BsonDocument -> BsonValue
-- | List of values
BsonArray :: [BsonValue] -> BsonValue
-- | Binary blob value
BsonBlob :: Binary -> BsonValue
-- | Object Id value
BsonObjId :: ObjectId -> BsonValue
-- | Boolean value
BsonBool :: Bool -> BsonValue
-- | Time stamp value
BsonUTC :: UTCTime -> BsonValue
-- | The NULL value
BsonNull :: BsonValue
-- | 32-bit integer
BsonInt32 :: Int32 -> BsonValue
-- | 64-bit integer
BsonInt64 :: Int64 -> BsonValue
-- | Class used to (de)construct BsonValues
class (Typeable a, Show a) => BsonVal a
toBsonValue :: BsonVal a => a -> BsonValue
fromBsonValue :: (BsonVal a, Monad m) => BsonValue -> m a
-- | A PolicyLabeled value can be either an unlabeled value for
-- which the policy needs to be applied (NeedPolicyTCB), or an
-- already labeled value (HasPolicyTCB). PolicyLabeled
-- is a partially-opaque type; code should not be able to inspect the
-- value of an unlabeleda value, but may inspect an already labeled
-- value.
data PolicyLabeled
-- | Create a policy labeled value given an unlabeled HsonValue.
needPolicy :: BsonValue -> PolicyLabeled
-- | Create a policy labeled value a labeled HsonValue.
hasPolicy :: DCLabeled BsonValue -> PolicyLabeled
-- | Get the policy labeled value, only if the policy has been applied.
getPolicyLabeled :: Monad m => PolicyLabeled -> m (DCLabeled BsonValue)
-- | Arbitrary binary blob
newtype Binary
Binary :: S8 -> Binary
unBinary :: Binary -> S8
-- | A BSON ObjectID is a 12-byte value consisting of a 4-byte timestamp
-- (seconds since epoch), a 3-byte machine id, a 2-byte process id, and a
-- 3-byte counter. Note that the timestamp and counter fields must be
-- stored big endian unlike the rest of BSON. This is because they are
-- compared byte-by-byte and we want to ensure a mostly increasing order.
data ObjectId :: *
Oid :: Word32 -> Word64 -> ObjectId
-- | Create a fresh ObjectId.
genObjectId :: MonadDC m => m ObjectId
instance [overlap ok] HsonVal (DCLabeled BsonValue)
instance [overlap ok] Show (DCLabeled BsonValue)
instance [overlap ok] HsonVal PolicyLabeled
instance [overlap ok] HsonVal BsonValue
instance [overlap ok] HsonVal Integer
instance [overlap ok] HsonVal Int
instance [overlap ok] HsonVal Int64
instance [overlap ok] HsonVal Int32
instance [overlap ok] (HsonVal a, BsonVal a) => HsonVal (Maybe a)
instance [overlap ok] HsonVal (Maybe BsonValue)
instance [overlap ok] HsonVal UTCTime
instance [overlap ok] HsonVal Bool
instance [overlap ok] HsonVal ObjectId
instance [overlap ok] HsonVal Binary
instance [overlap ok] (HsonVal a, BsonVal a) => HsonVal [a]
instance [overlap ok] HsonVal [BsonValue]
instance [overlap ok] HsonVal BsonDocument
instance [overlap ok] HsonVal String
instance [overlap ok] HsonVal Text
instance [overlap ok] HsonVal Float
instance [overlap ok] HsonVal Double
instance [overlap ok] HsonVal HsonValue
instance [overlap ok] BsonVal Integer
instance [overlap ok] BsonVal Int
instance [overlap ok] BsonVal Int64
instance [overlap ok] BsonVal Int32
instance [overlap ok] BsonVal a => BsonVal (Maybe a)
instance [overlap ok] BsonVal (Maybe BsonValue)
instance [overlap ok] BsonVal UTCTime
instance [overlap ok] BsonVal Bool
instance [overlap ok] BsonVal ObjectId
instance [overlap ok] BsonVal Binary
instance [overlap ok] BsonVal a => BsonVal [a]
instance [overlap ok] BsonVal [BsonValue]
instance [overlap ok] BsonVal BsonDocument
instance [overlap ok] BsonVal ByteString
instance [overlap ok] BsonVal ByteString
instance [overlap ok] BsonVal String
instance [overlap ok] BsonVal Text
instance [overlap ok] BsonVal Float
instance [overlap ok] BsonVal Double
instance [overlap ok] HsonVal v => GenField v HsonField
instance [overlap ok] BsonVal v => GenField v BsonField
instance [overlap ok] BsonVal v => DocValOps BsonDocument v
instance [overlap ok] HsonVal v => DocValOps HsonDocument v
instance [overlap ok] DocOps BsonValue BsonField
instance [overlap ok] DocOps HsonValue HsonField
instance [overlap ok] ShowTCB PolicyLabeled
instance [overlap ok] ShowTCB HsonValue
instance [overlap ok] Show HsonValue
instance [overlap ok] Show BsonValue
instance [overlap ok] Field HsonValue HsonField
instance [overlap ok] Field BsonValue HsonField
instance [overlap ok] Field BsonValue BsonField
instance [overlap ok] IsField HsonField
instance [overlap ok] IsField BsonField
instance [overlap ok] Show HsonField
instance [overlap ok] Show BsonField
-- | This module exports the basic database types and constructors. See
-- Hails.Database for a description of the Hails database system.
module Hails.Database.TCB
-- | The name of a collection.
type CollectionName = Text
-- | A labeled Collection set.
type CollectionSet = DCLabeled (Set Collection)
-- | A Collection is a MongoDB collection name with an associated
-- label, clearance and labeling policy. Access to the collection is
-- restricted according to the collection label. Data inserted-to and
-- retrieved-from the collection will be labeled according to the
-- collection policy, with the guarantee that no data more sensitive than
-- the collection clearance can be inserted into the collection.
data Collection
CollectionTCB :: CollectionName -> DCLabel -> DCLabel -> CollectionPolicy -> Collection
-- | Collection name
colName :: Collection -> CollectionName
-- | Collection label
colLabel :: Collection -> DCLabel
-- | Collection clearance
colClearance :: Collection -> DCLabel
-- | Collection labeling policies
colPolicy :: Collection -> CollectionPolicy
-- | Create a Collection, ignoring any IFC restrictions.
collectionTCB :: CollectionName -> DCLabel -> DCLabel -> CollectionPolicy -> Collection
-- | The name of a database.
type DatabaseName = Text
-- | A Database is a MongoDB database with an associated label and
-- set of collections. The label is used to restrict access to the
-- database. Since collection policies are specified by policy modules,
-- every collection must always be associated with some database
-- (and thereby, policy module); a policy module is not allowed to
-- create a collection (and specify policies on it) in an arbitrary
-- database. We allow for the existance of a collection to be secrect,
-- and thus protect the set of collections with a label.
data Database
DatabaseTCB :: DatabaseName -> DCLabel -> CollectionSet -> Database
-- | Database name
databaseName :: Database -> DatabaseName
-- | Label of database
databaseLabel :: Database -> DCLabel
-- | Collections associated with databsae
databaseCollections :: Database -> CollectionSet
-- | A collection policy contains the policy for labeling documents
-- (documentLabelPolicy) at a coarse grained level, and a set of
-- policies for labeling fields of a document
-- (fieldLabelPolicies).
--
-- Specific fields can be associated with a FieldPolicy, which
-- allows the policy module to either:
--
--
-- - Explicitly make a field publicly readable to anyone who can access
-- the collection by declaring the field to be a SearchableField,
-- or
-- - Label a field given the full documnet (see
-- FieldPolicy).
--
--
-- Fields that do not have an associated policy are (conceputally)
-- labeled with the document label (documentLabelPolicy).
-- Similarly, the labels on the label of a policy-labeled field is the
-- document label created with documentLabelPolicy. Note:
-- the label on SearchableFields is solely the collection label.
data CollectionPolicy
CollectionPolicy :: (HsonDocument -> DCLabel) -> Map FieldName FieldPolicy -> CollectionPolicy
-- | The label on documents of the collection.
documentLabelPolicy :: CollectionPolicy -> HsonDocument -> DCLabel
-- | The policies associated with specific fields.
fieldLabelPolicies :: CollectionPolicy -> Map FieldName FieldPolicy
-- | A FieldPolicy is a security policy associated with fields.
-- SearchabelField specifies that the field can be referenced in
-- the selection clause of a Query, and therefore only the
-- collection label protects such fields. Conversely, FieldPolicy
-- specifies a labeling policy for the field.
data FieldPolicy
-- | Unlabeled, searchable field.
SearchableField :: FieldPolicy
-- | Policy labeled field.
FieldPolicy :: (HsonDocument -> DCLabel) -> FieldPolicy
-- | A DBAction is the monad within which database actions can be
-- executed, and policy modules are defined. The monad is simply a state
-- monad with DC as monad as the underlying monad with access to a
-- database system configuration (Pipe, AccessMode, and
-- Database). The value constructor is part of the TCB as
-- to disallow untrusted code from modifying the access mode.
newtype DBAction a
DBActionTCB :: StateT DBActionState DC a -> DBAction a
unDBAction :: DBAction a -> StateT DBActionState DC a
-- | The database system state threaded within a Hails computation.
data DBActionState
DBActionStateTCB :: Pipe -> AccessMode -> Database -> DCPriv -> DBActionState
-- | Pipe to underlying database system
dbActionPipe :: DBActionState -> Pipe
-- | Types of reads/write to perform
dbActionMode :: DBActionState -> AccessMode
-- | Database computation is currently executing against
dbActionDB :: DBActionState -> Database
-- | Privilege of the policy module related to the DB
dbActionPriv :: DBActionState -> DCPriv
-- | Get the underlying state.
getActionStateTCB :: DBAction DBActionState
-- | Get the underlying state.
putActionStateTCB :: DBActionState -> DBAction ()
-- | Update the underlying state using the supplied function.
updateActionStateTCB :: (DBActionState -> DBActionState) -> DBAction ()
-- | Given a policy module's privileges, database name, pipe and access
-- mode create the initial state for a DBAction. The underlying
-- database is labeled with the supplied privileges: both components of
-- the label (secrecy and integrity) are set to the privilege
-- description. In other words, only code that owns the policy module's
-- privileges can modify the database configuration. Policy modules can
-- use setDatabaseLabelP to change the label of their database,
-- and setCollectionMapLabelP to change the label of the
-- collection map.
makeDBActionStateTCB :: DCPriv -> DatabaseName -> Pipe -> AccessMode -> DBActionState
-- | Set the label of the underlying database to the supplied label,
-- ignoring IFC.
setDatabaseLabelTCB :: DCLabel -> DBAction ()
-- | Set the label of the underlying database to the supplied label,
-- ignoring IFC.
setCollectionSetLabelTCB :: DCLabel -> DBAction ()
-- | Associate a collection with underlying database, ignoring IFC.
associateCollectionTCB :: Collection -> DBAction ()
-- | Thread-safe TCP connection with pipelined requests
type Pipe = Pipeline Response Message
-- | Type of reads and writes to perform
data AccessMode :: *
-- | Read-only action, reading stale data from a slave is OK.
ReadStaleOk :: AccessMode
-- | Read-write action, slave not OK, every write is fire & forget.
UnconfirmedWrites :: AccessMode
-- | Read-write action, slave not OK, every write is confirmed with
-- getLastError.
ConfirmWrites :: GetLastError -> AccessMode
-- | Same as ConfirmWrites []
master :: AccessMode
-- | Same as ReadStaleOk
slaveOk :: AccessMode
-- | Exceptions thrown by invalid database queries.
data DBError
-- | Collection does not exist
UnknownCollection :: DBError
-- | Policy module not found
UnknownPolicyModule :: DBError
-- | Execution of action failed
ExecFailure :: Failure -> DBError
-- | Lift a mongoDB action into the DBAction monad. This function
-- always executes the action with Database.MongoDB's
-- access. If the database action fails an exception of type
-- Failure is thrown.
execMongoActionTCB :: Action IO a -> DBAction a
instance Typeable DBError
instance Monad DBAction
instance Functor DBAction
instance Applicative DBAction
instance Show DBError
instance Exception DBError
instance MonadLIO DCLabel DBAction
instance Ord Collection
instance Eq Collection
-- | This module exports labeled documents and the databse monad
-- (DBAction). The database monad is used by apps and policy
-- modules to execute database actions against a policy module's databse
-- (see Hails.PolicyModule). The Hails database model and
-- interface is documented in Hails.Database.
module Hails.Database.Core
-- | The name of a collection.
type CollectionName = Text
-- | A labeled Collection set.
type CollectionSet = DCLabeled (Set Collection)
-- | A Collection is a MongoDB collection name with an associated
-- label, clearance and labeling policy. Access to the collection is
-- restricted according to the collection label. Data inserted-to and
-- retrieved-from the collection will be labeled according to the
-- collection policy, with the guarantee that no data more sensitive than
-- the collection clearance can be inserted into the collection.
data Collection
-- | Collection name
colName :: Collection -> CollectionName
-- | Collection label
colLabel :: Collection -> DCLabel
-- | Collection clearance
colClearance :: Collection -> DCLabel
-- | Collection labeling policies
colPolicy :: Collection -> CollectionPolicy
-- | The name of a database.
type DatabaseName = Text
-- | A Database is a MongoDB database with an associated label and
-- set of collections. The label is used to restrict access to the
-- database. Since collection policies are specified by policy modules,
-- every collection must always be associated with some database
-- (and thereby, policy module); a policy module is not allowed to
-- create a collection (and specify policies on it) in an arbitrary
-- database. We allow for the existance of a collection to be secrect,
-- and thus protect the set of collections with a label.
data Database
-- | Database name
databaseName :: Database -> DatabaseName
-- | Label of database
databaseLabel :: Database -> DCLabel
-- | Collections associated with databsae
databaseCollections :: Database -> CollectionSet
-- | A labeled HsonDocument.
type LabeledHsonDocument = DCLabeled HsonDocument
-- | A DBAction is the monad within which database actions can be
-- executed, and policy modules are defined. The monad is simply a state
-- monad with DC as monad as the underlying monad with access to a
-- database system configuration (Pipe, AccessMode, and
-- Database). The value constructor is part of the TCB as
-- to disallow untrusted code from modifying the access mode.
data DBAction a
-- | The database system state threaded within a Hails computation.
data DBActionState
-- | Arbitrary monad that can perform database actions.
class Monad m => MonadDB m
liftDB :: MonadDB m => DBAction a -> m a
-- | Execute a database action returning the final result and state. In
-- general, code should instead use evalDBAction. This function is
-- primarily used by trusted code to initialize a policy module which may
-- have modified the underlying database.
runDBAction :: DBAction a -> DBActionState -> DC (a, DBActionState)
-- | Execute a database action returning the final result.
evalDBAction :: DBAction a -> DBActionState -> DC a
-- | Get the underlying database. Must be able to read from the database as
-- enforced by applying taint to the database label. This is
-- required because the database label protects the label on collections
-- which can be projected given a Database value.
getDatabase :: DBAction Database
-- | Same as getDatabase, but uses privileges when raising the
-- current label.
getDatabaseP :: DCPriv -> DBAction Database
-- | Thread-safe TCP connection with pipelined requests
type Pipe = Pipeline Response Message
-- | Type of reads and writes to perform
data AccessMode :: *
-- | Read-only action, reading stale data from a slave is OK.
ReadStaleOk :: AccessMode
-- | Read-write action, slave not OK, every write is fire & forget.
UnconfirmedWrites :: AccessMode
-- | Read-write action, slave not OK, every write is confirmed with
-- getLastError.
ConfirmWrites :: GetLastError -> AccessMode
-- | Same as ConfirmWrites []
master :: AccessMode
-- | Same as ReadStaleOk
slaveOk :: AccessMode
instance MonadDB DBAction
-- | This module exports a newtype wrapper for DBAction that
-- restricts certain combinators solely to policy modules. Specifically,
-- this policy module monad (PMAction) is used when setting
-- labels, specifing policies, creating collections, etc. The newtype is
-- used to restrict such functionality to policy modules; apps cannot and
-- should not be concerned with specifying data models and policies.
module Hails.PolicyModule.TCB
-- | A policy module action (PMAction) is simply a wrapper for
-- database action (DBAction). The wrapper is used to restrict
-- app code from specifying policies; only policy module may
-- execute PMActions, and thus create collections, set a label
-- on their databases, etc.
newtype PMAction a
PMActionTCB :: DBAction a -> PMAction a
unPMActionTCB :: PMAction a -> DBAction a
instance Monad PMAction
instance Functor PMAction
instance Applicative PMAction
instance MonadDB PMAction
instance MonadLIO DCLabel PMAction
-- | A policy module is a library with access to the privileges of a
-- dedicated principal (conceptually, the author of the library) and
-- associated with a dedicated database. The job of the policy module is
-- to specify what sort of data may be stored in this database, and what
-- access-control policies should be applied to it. However, because
-- Hails uses information flow control (IFC) to enforce policies, a
-- policy specified by a policy module on a piece of data is enforce even
-- when an app gets a hold of the data.
--
-- IFC lets apps and policy modules productively use other policy
-- modules despite mutual distrust. Moreover, IFC prevents malicious apps
-- from violating any of the policies specified by a policy module. As a
-- consequence, users need not place as much trust in apps. Rather, they
-- need to trust or verify the policies specified by policy modules.
--
-- This moule exports the class which every policy module must be an
-- instance of. Though simple, the class allows a policy module to create
-- collections with a set of policies and associate them with the policy
-- module's underlying database.
module Hails.PolicyModule
-- | A policy module is specified as an instance of the
-- PolicyModule class. The role of this class is to define an
-- entry point for policy modules. The policy module author should set up
-- the database labels and create all the database collections in
-- initPolicyModule. It is these collections and corresponding
-- policies that apps and other policy modules use when interacting with
-- the policy module's database using withPolicyModule.
--
-- The Hails runtime system relies on the policy module's type
-- pm to load the corresponding initPolicyModule when
-- some code "invokes" the policy module using withPolicyModule.
-- In fact when a piece of code wishes to execute a database action on
-- the policy module, withPolicyModule first executes the policy
-- module's initPolicyModule and passes the result (of type
-- pm) to the invoking code.
--
-- Observe that initPolicyModule has access to the policy module's
-- privileges, which are passed in as an argument. This allows the policy
-- module to encapsulate its privileges in its pm type and allow
-- code it trusts to use its privileges when executing a database action
-- using withPolicyModule. Of course, untrusted code (which is
-- usually the case) should not be allow to inspect values of type
-- pm to get the encapsulated privileges.
--
-- Consider the example below:
--
--
-- module My.Policy ( MyPolicyModule ) where
--
-- import LIO
-- import LIO.DCLabel
-- import Data.Typeable
-- import Hails.PolicyModule
--
-- -- | Handle to policy module, not exporting @MyPolicyModuleTCB@
-- data MyPolicyModule = MyPolicyModuleTCB DCPriv deriving Typeable
--
-- instance PolicyModule MyPolicyModule where
-- initPolicyModule priv = do
-- -- Get the policy module principal:
-- let this = privDesc priv
-- -- Create label:
-- l = dcLabel dcTrue -- Everybody can read
-- this -- Only policy module can modify
-- -- Label database and collection-set:
-- labelDatabaseP priv l l
-- -- Create collections:
-- createCollectionP priv "collection1" ...
-- createCollectionP priv "collection2" ...
-- ....
-- createCollectionP priv "collectionN" ...
-- -- Return the policy module:
-- return (MyPolicyModuleTCB priv)
--
--
-- Here the policy module labels the database, labels the list of
-- collections and finally creates N collections. The
-- computation returns a value of type MyPolicyModule which
-- wraps the policy module's privileges. As a consequence, trustworthy
-- code that has access to the value constructor can use the policy
-- module's privileges:
--
--
-- -- Trustworthy code within the same module (My.Policy)
--
-- alwaysInsert doc = withPolicyModule $ \(MyPolicyModuleTCB priv) ->
-- insertP priv "collection1" doc
--
--
-- Here alwaysInsert uses the policy module's privileges to
-- insert a document into collection "collection1". As such, if
-- doc is well-formed the function always succeeds. (Of course,
-- such functions should not be exported.)
--
-- Untrusted code in a different module cannot, however use the policy
-- module's privilege:
--
--
-- -- Untrusted code in a separate module
-- import My.Policy
--
-- maybeInsertIntoDB appPriv doc = withPolicyModule $ (_ :: MyPolicyModule) ->
-- insertP appPriv "collection1" doc
--
--
-- Depending on the privileges passed to maybeInsertIntoDB, and
-- set policies, the insertion may or may not succeed.
class Typeable pm => PolicyModule pm
initPolicyModule :: PolicyModule pm => DCPriv -> PMAction pm
-- | A policy module action (PMAction) is simply a wrapper for
-- database action (DBAction). The wrapper is used to restrict
-- app code from specifying policies; only policy module may
-- execute PMActions, and thus create collections, set a label
-- on their databases, etc.
data PMAction a
-- | This is the first action that any policy module should execute. It is
-- simply a wrapper for setDatabaseLabelP and
-- setCollectionSetLabelP. Given the policy module's privilges,
-- label for the database, and label for the collection-set
-- labelDatabaseP accordingly sets the labels.
labelDatabaseP :: DCPriv -> DCLabel -> DCLabel -> PMAction ()
-- | Set the label of the underlying database. The supplied label must be
-- bounded by the current label and clearance as enforced by
-- guardAlloc. Moreover the current computation mut write to the
-- database, as enforce by applying guardWrite to the current
-- database label. The latter requirement suggests that every policy
-- module use setDatabaseLabelP when first changing the label.
setDatabaseLabel :: DCLabel -> PMAction ()
-- | Same as setDatabaseLabel, but uses privileges when performing
-- label comparisons. If a policy module wishes to allow other policy
-- modules or apps to access the underlying databse it must use
-- setDatabaseLabelP to "downgrade" the database label, which by
-- default only allows the policy module itself to access any of the
-- contents (including collection-set).
setDatabaseLabelP :: DCPriv -> DCLabel -> PMAction ()
-- | The collections label protects the collection-set of the database. It
-- is used to restrict who can name a collection in the database and who
-- can modify the underlying collection-set (e.g., by creating a new
-- collection). The policy module may change the default collections
-- label, which limits access to the policy module alone, using
-- setCollectionSetLabel.
--
-- The new label must be bounded by the current label and clearance as
-- checked by guardAlloc. Additionally, the current label must
-- flow to the label of the database which protects the label of the
-- colleciton set. In most cases code should use
-- setCollectionSetLabelP.
setCollectionSetLabel :: DCLabel -> PMAction ()
-- | Same as setCollectionSetLabel, but uses the supplied privileges
-- when performing label comparisons.
setCollectionSetLabelP :: DCPriv -> DCLabel -> PMAction ()
-- | Create a Collection given a name, label, clearance, and policy.
-- Several IFC rules must be respected for this function to succeed:
--
--
-- - The supplied collection label and clearance must be above the
-- current label and below the current clearance as enforced by
-- guardAlloc.
-- - The current computation must be able to read the database
-- collection-set protected by the database label. The guard taint
-- is used to guarantee this and raise the current label (to the join of
-- the current label and database label) appropriately.
-- - The computation must be able to modify the database
-- collection-set. The guard guardWrite is used to guarantee that
-- the current label is essentially equal to the collection-set
-- label.
--
--
-- Note: the collection policy is modified to make the _id field
-- explicitly a SearchableField.
createCollection :: CollectionName -> DCLabel -> DCLabel -> CollectionPolicy -> PMAction ()
-- | Same as createCollection, but uses privileges when performing
-- IFC checks.
createCollectionP :: DCPriv -> CollectionName -> DCLabel -> DCLabel -> CollectionPolicy -> PMAction ()
-- | A collection policy contains the policy for labeling documents
-- (documentLabelPolicy) at a coarse grained level, and a set of
-- policies for labeling fields of a document
-- (fieldLabelPolicies).
--
-- Specific fields can be associated with a FieldPolicy, which
-- allows the policy module to either:
--
--
-- - Explicitly make a field publicly readable to anyone who can access
-- the collection by declaring the field to be a SearchableField,
-- or
-- - Label a field given the full documnet (see
-- FieldPolicy).
--
--
-- Fields that do not have an associated policy are (conceputally)
-- labeled with the document label (documentLabelPolicy).
-- Similarly, the labels on the label of a policy-labeled field is the
-- document label created with documentLabelPolicy. Note:
-- the label on SearchableFields is solely the collection label.
data CollectionPolicy
CollectionPolicy :: (HsonDocument -> DCLabel) -> Map FieldName FieldPolicy -> CollectionPolicy
-- | The label on documents of the collection.
documentLabelPolicy :: CollectionPolicy -> HsonDocument -> DCLabel
-- | The policies associated with specific fields.
fieldLabelPolicies :: CollectionPolicy -> Map FieldName FieldPolicy
-- | A FieldPolicy is a security policy associated with fields.
-- SearchabelField specifies that the field can be referenced in
-- the selection clause of a Query, and therefore only the
-- collection label protects such fields. Conversely, FieldPolicy
-- specifies a labeling policy for the field.
data FieldPolicy
-- | Unlabeled, searchable field.
SearchableField :: FieldPolicy
-- | Policy labeled field.
FieldPolicy :: (HsonDocument -> DCLabel) -> FieldPolicy
-- | Returns True if the field policy is a SearchableField.
isSearchableField :: FieldPolicy -> Bool
-- | Get the list of names corresponding to SearchableFields.
searchableFields :: CollectionPolicy -> [FieldName]
-- | This function is the used to execute database queries on policy module
-- databases. The function firstly invokes the policy module, determined
-- from the type pm, and creates a pipe to the policy module's
-- database. The supplied database query function is then applied to the
-- policy module. In most cases, the value of type pm is opaque
-- and the query is executed without additionally privileges.
--
--
-- withPolicyModule $ \(_ :: SomePolicyModule) -> do
-- -- Perform database operations: insert, save, find, delete, etc.
--
--
-- Trustworthy code (as deemed by the policy module) may, however, be
-- passed in additional privileges by encapsulating them in pm
-- (see PolicyModule).
withPolicyModule :: PolicyModule pm => (pm -> DBAction a) -> DC a
-- | Policy type name. Has the form:
--
--
-- <Policy module package>:<Fully qualified module>.<Policy module type>
--
type TypeName = String
-- | Get the name of a policy module.
policyModuleTypeName :: PolicyModule pm => pm -> TypeName
-- | This contains a map of all the policy modules. Specifically, it maps
-- the policy moule types to a pair of the policy module principal and
-- database name.
--
-- For the trusted programmer: The map itself is read from the
-- file pointed to by the environment variable
-- DATABASE_CONFIG_FILE. Each line in the file corresponds to a
-- policy module. The format of a line is as follows
--
--
-- ("<Policy module package>:<Fully qualified module>.<Policy module type>", "<Policy module database name>")
--
--
-- Example of valid line is:
--
--
-- ("my-policy-0.1.2.3:My.Policy.MyPolicyModule", "my_db")
--
--
-- The principal used by Hails is the first projection with a
-- "_" suffix. In the above, the principal assigned by Hails is:
--
--
-- "_my-policy-0.1.2.3:My.Policy.MyPolicyModule"
--
availablePolicyModules :: Map TypeName (Principal, DatabaseName)
-- | This module exports the trusted types and functions used by
-- Hails.Database.Query when performing database queries.
module Hails.Database.Query.TCB
-- | A labeled cursor. The cursor is labeled with the join of the database
-- and collection it reads from. The collection policies are "carried"
-- along since they are applied on-demand.
data Cursor
CursorTCB :: DCLabel -> Cursor -> [FieldName] -> Collection -> Cursor
-- | Cursor label
curLabel :: Cursor -> DCLabel
-- | Internal MongoDB cursor
curInternal :: Cursor -> Cursor
-- | Projector from query. Used to remove fields after performing query.
curProject :: Cursor -> [FieldName]
-- | Collection cursor is reading from
curCollection :: Cursor -> Collection
-- | This module exports the basic types used to create queries and
-- selections. Different from standard MongoDB, Hails queries are limited
-- to SearchableFields (similarly, ordering a query result is
-- limited to such fields) and projections are carried out by this
-- library and not the database. The later is a result of allowing policy
-- modules to express a labeling policy as a function of a document --
-- hence we cannot determine at compile time if a field is used in a
-- policy and thus must be included in the projection.
module Hails.Database.Query
-- | Class used to generalize insertion and saving of documents.
-- Specifically, it permits reusing function names when inserting/saving
-- both already-labeled and unlabeled documents. Minimal definition:
-- insertP and saveP.
class InsertLike doc where insert = insertP noPriv insert_ c d = void $ insert c d insertP_ p c d = void $ insertP p c d save = saveP noPriv
insert :: InsertLike doc => CollectionName -> doc -> DBAction ObjectId
insert_ :: InsertLike doc => CollectionName -> doc -> DBAction ()
insertP :: InsertLike doc => DCPriv -> CollectionName -> doc -> DBAction ObjectId
insertP_ :: InsertLike doc => DCPriv -> CollectionName -> doc -> DBAction ()
save :: InsertLike doc => CollectionName -> doc -> DBAction ()
saveP :: InsertLike doc => DCPriv -> CollectionName -> doc -> DBAction ()
-- | Class used to simplicy the creation of a 'Selection'/'Query'.
-- Specifically, select can be used to create a Section
-- in a straight foward manner, but similarly can be used to create a
-- Query with a set of default options.
class Select selectionOrQuery
select :: Select selectionOrQuery => Selector -> CollectionName -> selectionOrQuery
-- | A Section is a Selector query on a Collection.
-- In other words, a Selection is the necessary information for
-- performing a database query.
data Selection
Selection :: Selector -> CollectionName -> Selection
-- | Selection query.
selectionSelector :: Selection -> Selector
-- | Collection to perform query on.
selectionCollection :: Selection -> CollectionName
-- | Filter for a query, analogous to the WHERE clause in SQL.
-- [] matches all documents in collection. For example, [x
-- -: a, y -: b] is analogous to WHERE x = a AND y
-- = b in SQL.
--
-- Note: only FieldNames of SearchableFields may be
-- used in selections, and thus all other fields are ignored.
type Selector = BsonDocument
-- | Use select to create a basic query with defaults, then modify if
-- desired. Example: (select sel col) {limit =: 10}. For
-- simplicity, and since policies may be specified in terms of arbitrary
-- fields, The selection and sort fields are restricted to
-- SearchableFields, or the _id field that is
-- implicitly a SearchableField.
data Query
Query :: [QueryOption] -> Selection -> [FieldName] -> Word32 -> Limit -> [Order] -> BatchSize -> [FieldName] -> Query
-- | Query options, default [].
options :: Query -> [QueryOption]
-- | WHERE clause,default []. Non-SearchableFields
-- ignored.
selection :: Query -> Selection
-- | The fields to project. Default [] corresponds to all.
project :: Query -> [FieldName]
-- | Number of documents to skip, default 0.
skip :: Query -> Word32
-- | Max number of documents to return. Default, 0, means no limit.
limit :: Query -> Limit
-- | Sort result by given order, default [].
-- Non-SearchableFields ignored.
sort :: Query -> [Order]
-- | The number of document to return in each batch response from the
-- server. 0 means MongoDB default.
batchSize :: Query -> BatchSize
-- | Force mongoDB to use this index, default [], no hint.
-- Non-SearchableFields ignored.
hint :: Query -> [FieldName]
data QueryOption :: *
-- | Tailable means cursor is not closed when the last data is retrieved.
-- Rather, the cursor marks the final object's position. You can resume
-- using the cursor later, from where it was located, if more data were
-- received. Like any latent cursor, the cursor may become invalid
-- at some point – for example if the final object it references were
-- deleted. Thus, you should be prepared to requery on CursorNotFound
-- exception.
TailableCursor :: QueryOption
-- | The server normally times out idle cursors after 10 minutes to prevent
-- a memory leak in case a client forgets to close a cursor. Set this
-- option to allow a cursor to live forever until it is closed.
NoCursorTimeout :: QueryOption
-- | Use with TailableCursor. If we are at the end of the data, block for a
-- while rather than returning no data. After a timeout period, we do
-- return as normal. | Exhaust -- ^ Stream the data down full blast in
-- multiple more packages, on the assumption that the client will
-- fully read all data queried. Faster when you are pulling a lot of data
-- and know you want to pull it all down. Note: the client is not allowed
-- to not read all the data unless it closes the connection. Exhaust
-- commented out because not compatible with current Pipeline
-- implementation
AwaitData :: QueryOption
-- | Get partial results from a _mongos_ if some shards are down, instead
-- of throwing an error.
Partial :: QueryOption
-- | Maximum number of documents to return, i.e. cursor will close after
-- iterating over this number of documents. 0 means no limit.
type Limit = Word32
-- | The number of document to return in each batch response from the
-- server. 0 means use Mongo default.
type BatchSize = Word32
-- | Sorting fields in Ascending or Descending order.
data Order
-- | Ascending order
Asc :: FieldName -> Order
-- | Descending order
Desc :: FieldName -> Order
-- | Get the field name in the order.
orderName :: Order -> FieldName
-- | A labeled cursor. The cursor is labeled with the join of the database
-- and collection it reads from. The collection policies are "carried"
-- along since they are applied on-demand.
data Cursor
-- | Cursor label
curLabel :: Cursor -> DCLabel
-- | Fetch documents satisfying query. A labeled Cursor is returned,
-- which can be used to retrieve the actual HsonDocuments. For
-- this function to succeed the current computation must be able to read
-- from the database and collection (implicilty the database's
-- collection-set). This is satisfied by applying taint to the
-- join join of the collection, database, and ccollection-set label. The
-- curor label is labeled by the upperBound of the database and
-- collection labels and must be used within the same
-- withPolicyModule block.
--
-- Note that this function is quite permissive in the queries it accepts.
-- Specifically, any non-SearchableFields used in sort,
-- order, or hint are ignored (as opposed to
-- throwing an exception).
find :: Query -> DBAction Cursor
-- | Same as find, but uses privileges when reading from the
-- collection and database.
findP :: DCPriv -> Query -> DBAction Cursor
-- | Return next HsonDocument in the query result, or Nothing
-- if finished. Note that the current computation must be able to read
-- from the labeled Cursor. To enforce this, next uses
-- taint to raise the current label to join of the current label
-- and 'Cursor'\'s label. The returned document is labeled according to
-- the underlying Collection policy.
next :: Cursor -> DBAction (Maybe LabeledHsonDocument)
-- | Same as next, but usess privileges when raising the current
-- label.
nextP :: DCPriv -> Cursor -> DBAction (Maybe LabeledHsonDocument)
-- | Fetch the first document satisfying query, or Nothing if not
-- documents matched the query.
findOne :: Query -> DBAction (Maybe LabeledHsonDocument)
-- | Same as findOne, but uses privileges when performing label
-- comparisons.
findOneP :: DCPriv -> Query -> DBAction (Maybe LabeledHsonDocument)
-- | Same as delete, but uses privileges.
deleteP :: DCPriv -> Selection -> DBAction ()
-- | Delete documents according to the selection. It must be that the
-- current computation can overwrite the existing documents. That is, the
-- current label must flow to the label of each document that matches the
-- selection.
delete :: Selection -> DBAction ()
-- | Exceptions thrown by invalid database queries.
data DBError
-- | Collection does not exist
UnknownCollection :: DBError
-- | Policy module not found
UnknownPolicyModule :: DBError
-- | Execution of action failed
ExecFailure :: Failure -> DBError
-- | Apply a collection policy the given document, using privileges when
-- labeling the document and performing label comparisons. The labeling
-- proceeds as follows:
--
--
-- - If two fields have the same FieldName, only the first is
-- kept. This filtering is only perfomed at the top level.
-- - Each policy labeled value (HsonLabeled) is labled if the
-- policy has not been applied. If the value is already labeled, then the
-- label is checked to be equivalent to that generated by the policy. In
-- both cases a failure results in PolicyViolation being thrown;
-- the actual error must be hidden to retain the opaqueness of
-- PolicyLabeled.
--
--
-- Note: For each FieldNamed in the policy there
-- must be a field in the document corresponding to it. Moreover
-- its "type" must be correct: all policy labeled values must be
-- HsonLabeled values and all searchable fields must be
-- HsonValues. The _id field is always treated as a
-- SearchableField.
--
--
-- - The resulting document (from the above step) is labeled according
-- to the collection policy.
--
--
-- The labels on PolicyLabeled values and the document must be
-- bounded by the current label and clearance as imposed by
-- guardAllocP. Additionally, these labels must flow to the label
-- of the collection clearance. (Of course, in both cases privileges are
-- used to allow for more permissive flows.)
applyCollectionPolicyP :: MonadDC m => DCPriv -> Collection -> HsonDocument -> m (LabeledHsonDocument)
-- | A document policy error.
data PolicyError
-- | Document is not "well-typed"
TypeError :: String -> PolicyError
-- | Policy has been violated
PolicyViolation :: PolicyError
-- | This function "type-checks" a document against a set of policies.
-- Specifically, it checks that the set of policy labeled values is the
-- same between the policy and document, searchable fields are not policy
-- labeled, and all searchable/policy-labeled fields named in the
-- collection policy are present in the document (except for
-- _id).
typeCheckDocument :: Map FieldName FieldPolicy -> HsonDocument -> DC ()
instance Typeable PolicyError
instance Eq Order
instance Ord Order
instance Show Order
instance Show Selection
instance Show PolicyError
instance Exception PolicyError
instance InsertLike LabeledHsonDocument
instance InsertLike HsonDocument
instance Select Query
instance Select Selection
-- | This module exports the database interface used by apps and policy
-- modules to carry out database queries. The Hails data model is similar
-- to that of MongoDB. Below we highlight some similarities and
-- difference. We refer the interested reader to the documentation in
-- Hails.PolicyModule for more details on the role of labels in
-- Hails.
--
-- At the coarsest level code can execute database actions
-- (DBAction) against the Database of a policy module using
-- withPolicyModule. Different from MongoDB's notion of a
-- database, Hails databases have an associated Label which is
-- used to restrict who can access the database.
--
-- Each Database is composed of a set of Collections. The
-- existence of a collection is protected by a collection-set label,
-- which is, intern, protected by the database label. A collection is an
-- approach to organizing and grouping elements of the same model. For
-- example, collection "users" may contain elements (documents)
-- corresponding to users of the system. Each collection has a label,
-- clearance, and associated collection policy. The label of a collection
-- serves the same role as the database label, but at a finer grain: it
-- protects who can read and write to the collection. The collection
-- clearance is also a label, but its role is to set an upper bound on
-- the sensitivity of data that is and can be stored in the collection.
-- For example, the collection "user" may set a clearance such that the
-- system's private keys cannot be stored in the collection (by accident
-- or malice). The collection policy specifies how elements of the
-- collection are to be labeled when retrieved from the database.
--
-- The aforementioned elements of a collection are documents of type
-- HsonDocument. Documents are the basic storage units composed of
-- a fields (of type HsonField), which are effectively key-value
-- pairs. The first part of the collection policy is to specify how such
-- documents are labeled upon retrieval from the database. Namely, by
-- providing a function from the document to a label. Keys, or field
-- names, have type FieldName while values have type
-- HsonValue. Hails values are a subset of MongoDB's BSON
-- specification. The second part of the collection policy is used to
-- specify if a field value is publicly-searchable (i.e., readable by
-- anybody that can read from the collection) or labeled according to a
-- function that may depend on the data contained within the document
-- itself. Hence, different form MongoDB's documents, Hails documents are
-- typically labeled and thus protect the potentially-sensitive data
-- contained within.
--
-- This module is analogous to Database.MongoDB and uses MongoDB
-- as the backed. Since the interfaces are similar we recommend glancing
-- at their documentation as well.
module Hails.Database
-- | A DBAction is the monad within which database actions can be
-- executed, and policy modules are defined. The monad is simply a state
-- monad with DC as monad as the underlying monad with access to a
-- database system configuration (Pipe, AccessMode, and
-- Database). The value constructor is part of the TCB as
-- to disallow untrusted code from modifying the access mode.
data DBAction a
-- | Arbitrary monad that can perform database actions.
class Monad m => MonadDB m
liftDB :: MonadDB m => DBAction a -> m a
-- | This function is the used to execute database queries on policy module
-- databases. The function firstly invokes the policy module, determined
-- from the type pm, and creates a pipe to the policy module's
-- database. The supplied database query function is then applied to the
-- policy module. In most cases, the value of type pm is opaque
-- and the query is executed without additionally privileges.
--
--
-- withPolicyModule $ \(_ :: SomePolicyModule) -> do
-- -- Perform database operations: insert, save, find, delete, etc.
--
--
-- Trustworthy code (as deemed by the policy module) may, however, be
-- passed in additional privileges by encapsulating them in pm
-- (see PolicyModule).
withPolicyModule :: PolicyModule pm => (pm -> DBAction a) -> DC a
-- | Get the underlying database. Must be able to read from the database as
-- enforced by applying taint to the database label. This is
-- required because the database label protects the label on collections
-- which can be projected given a Database value.
getDatabase :: DBAction Database
-- | Same as getDatabase, but uses privileges when raising the
-- current label.
getDatabaseP :: DCPriv -> DBAction Database
-- | Exceptions thrown by invalid database queries.
data DBError
-- | Collection does not exist
UnknownCollection :: DBError
-- | Policy module not found
UnknownPolicyModule :: DBError
-- | Execution of action failed
ExecFailure :: Failure -> DBError
-- | The name of a database.
type DatabaseName = Text
-- | A Database is a MongoDB database with an associated label and
-- set of collections. The label is used to restrict access to the
-- database. Since collection policies are specified by policy modules,
-- every collection must always be associated with some database
-- (and thereby, policy module); a policy module is not allowed to
-- create a collection (and specify policies on it) in an arbitrary
-- database. We allow for the existance of a collection to be secrect,
-- and thus protect the set of collections with a label.
data Database
-- | Database name
databaseName :: Database -> DatabaseName
-- | Label of database
databaseLabel :: Database -> DCLabel
-- | Collections associated with databsae
databaseCollections :: Database -> CollectionSet
-- | The name of a collection.
type CollectionName = Text
-- | A labeled Collection set.
type CollectionSet = DCLabeled (Set Collection)
-- | A Collection is a MongoDB collection name with an associated
-- label, clearance and labeling policy. Access to the collection is
-- restricted according to the collection label. Data inserted-to and
-- retrieved-from the collection will be labeled according to the
-- collection policy, with the guarantee that no data more sensitive than
-- the collection clearance can be inserted into the collection.
data Collection
-- | Collection name
colName :: Collection -> CollectionName
-- | Collection label
colLabel :: Collection -> DCLabel
-- | Collection clearance
colClearance :: Collection -> DCLabel
-- | Collection labeling policies
colPolicy :: Collection -> CollectionPolicy
-- | A document policy error.
data PolicyError
-- | Document is not "well-typed"
TypeError :: String -> PolicyError
-- | Policy has been violated
PolicyViolation :: PolicyError
-- | A labeled HsonDocument.
type LabeledHsonDocument = DCLabeled HsonDocument
-- | Class used to generalize insertion and saving of documents.
-- Specifically, it permits reusing function names when inserting/saving
-- both already-labeled and unlabeled documents. Minimal definition:
-- insertP and saveP.
class InsertLike doc where insert = insertP noPriv insert_ c d = void $ insert c d insertP_ p c d = void $ insertP p c d save = saveP noPriv
insert :: InsertLike doc => CollectionName -> doc -> DBAction ObjectId
insert_ :: InsertLike doc => CollectionName -> doc -> DBAction ()
insertP :: InsertLike doc => DCPriv -> CollectionName -> doc -> DBAction ObjectId
insertP_ :: InsertLike doc => DCPriv -> CollectionName -> doc -> DBAction ()
save :: InsertLike doc => CollectionName -> doc -> DBAction ()
saveP :: InsertLike doc => DCPriv -> CollectionName -> doc -> DBAction ()
-- | Fetch documents satisfying query. A labeled Cursor is returned,
-- which can be used to retrieve the actual HsonDocuments. For
-- this function to succeed the current computation must be able to read
-- from the database and collection (implicilty the database's
-- collection-set). This is satisfied by applying taint to the
-- join join of the collection, database, and ccollection-set label. The
-- curor label is labeled by the upperBound of the database and
-- collection labels and must be used within the same
-- withPolicyModule block.
--
-- Note that this function is quite permissive in the queries it accepts.
-- Specifically, any non-SearchableFields used in sort,
-- order, or hint are ignored (as opposed to
-- throwing an exception).
find :: Query -> DBAction Cursor
-- | Same as find, but uses privileges when reading from the
-- collection and database.
findP :: DCPriv -> Query -> DBAction Cursor
-- | Return next HsonDocument in the query result, or Nothing
-- if finished. Note that the current computation must be able to read
-- from the labeled Cursor. To enforce this, next uses
-- taint to raise the current label to join of the current label
-- and 'Cursor'\'s label. The returned document is labeled according to
-- the underlying Collection policy.
next :: Cursor -> DBAction (Maybe LabeledHsonDocument)
-- | Same as next, but usess privileges when raising the current
-- label.
nextP :: DCPriv -> Cursor -> DBAction (Maybe LabeledHsonDocument)
-- | Fetch the first document satisfying query, or Nothing if not
-- documents matched the query.
findOne :: Query -> DBAction (Maybe LabeledHsonDocument)
-- | Same as findOne, but uses privileges when performing label
-- comparisons.
findOneP :: DCPriv -> Query -> DBAction (Maybe LabeledHsonDocument)
-- | A labeled cursor. The cursor is labeled with the join of the database
-- and collection it reads from. The collection policies are "carried"
-- along since they are applied on-demand.
data Cursor
-- | Cursor label
curLabel :: Cursor -> DCLabel
-- | Class used to simplicy the creation of a 'Selection'/'Query'.
-- Specifically, select can be used to create a Section
-- in a straight foward manner, but similarly can be used to create a
-- Query with a set of default options.
class Select selectionOrQuery
select :: Select selectionOrQuery => Selector -> CollectionName -> selectionOrQuery
-- | A Section is a Selector query on a Collection.
-- In other words, a Selection is the necessary information for
-- performing a database query.
data Selection
Selection :: Selector -> CollectionName -> Selection
-- | Selection query.
selectionSelector :: Selection -> Selector
-- | Collection to perform query on.
selectionCollection :: Selection -> CollectionName
-- | Filter for a query, analogous to the WHERE clause in SQL.
-- [] matches all documents in collection. For example, [x
-- -: a, y -: b] is analogous to WHERE x = a AND y
-- = b in SQL.
--
-- Note: only FieldNames of SearchableFields may be
-- used in selections, and thus all other fields are ignored.
type Selector = BsonDocument
-- | Use select to create a basic query with defaults, then modify if
-- desired. Example: (select sel col) {limit =: 10}. For
-- simplicity, and since policies may be specified in terms of arbitrary
-- fields, The selection and sort fields are restricted to
-- SearchableFields, or the _id field that is
-- implicitly a SearchableField.
data Query
Query :: [QueryOption] -> Selection -> [FieldName] -> Word32 -> Limit -> [Order] -> BatchSize -> [FieldName] -> Query
-- | Query options, default [].
options :: Query -> [QueryOption]
-- | WHERE clause,default []. Non-SearchableFields
-- ignored.
selection :: Query -> Selection
-- | The fields to project. Default [] corresponds to all.
project :: Query -> [FieldName]
-- | Number of documents to skip, default 0.
skip :: Query -> Word32
-- | Max number of documents to return. Default, 0, means no limit.
limit :: Query -> Limit
-- | Sort result by given order, default [].
-- Non-SearchableFields ignored.
sort :: Query -> [Order]
-- | The number of document to return in each batch response from the
-- server. 0 means MongoDB default.
batchSize :: Query -> BatchSize
-- | Force mongoDB to use this index, default [], no hint.
-- Non-SearchableFields ignored.
hint :: Query -> [FieldName]
data QueryOption :: *
-- | Tailable means cursor is not closed when the last data is retrieved.
-- Rather, the cursor marks the final object's position. You can resume
-- using the cursor later, from where it was located, if more data were
-- received. Like any latent cursor, the cursor may become invalid
-- at some point – for example if the final object it references were
-- deleted. Thus, you should be prepared to requery on CursorNotFound
-- exception.
TailableCursor :: QueryOption
-- | The server normally times out idle cursors after 10 minutes to prevent
-- a memory leak in case a client forgets to close a cursor. Set this
-- option to allow a cursor to live forever until it is closed.
NoCursorTimeout :: QueryOption
-- | Use with TailableCursor. If we are at the end of the data, block for a
-- while rather than returning no data. After a timeout period, we do
-- return as normal. | Exhaust -- ^ Stream the data down full blast in
-- multiple more packages, on the assumption that the client will
-- fully read all data queried. Faster when you are pulling a lot of data
-- and know you want to pull it all down. Note: the client is not allowed
-- to not read all the data unless it closes the connection. Exhaust
-- commented out because not compatible with current Pipeline
-- implementation
AwaitData :: QueryOption
-- | Get partial results from a _mongos_ if some shards are down, instead
-- of throwing an error.
Partial :: QueryOption
-- | Maximum number of documents to return, i.e. cursor will close after
-- iterating over this number of documents. 0 means no limit.
type Limit = Word32
-- | The number of document to return in each batch response from the
-- server. 0 means use Mongo default.
type BatchSize = Word32
-- | Sorting fields in Ascending or Descending order.
data Order
-- | Ascending order
Asc :: FieldName -> Order
-- | Descending order
Desc :: FieldName -> Order
-- | Delete documents according to the selection. It must be that the
-- current computation can overwrite the existing documents. That is, the
-- current label must flow to the label of each document that matches the
-- selection.
delete :: Selection -> DBAction ()
-- | Same as delete, but uses privileges.
deleteP :: DCPriv -> Selection -> DBAction ()
-- | This module exports a domain specific language for specifying policy
-- module policies. It is recommended that all policy modules use
-- this code when specifying security policies as it simplifies auditing
-- and building trust in the authors. Policy modules are described in
-- Hails.PolicyModule, which is a pre-required reading to this
-- module's documentation.
--
-- Consider creating a policy module where anybody can read and write
-- freely to the databse. In this databsae we wish to create a simple
-- user model collecting user names and passwords. This collection
-- "users" is also readable and writable by anybody. However, the
-- passwords must always belong to the named user. Specifically, only the
-- user (or policy module) may read and modify the password. This policy
-- is implemented below:
--
--
-- data UsersPolicyModule = UsersPolicyModuleTCB DCPriv
-- deriving Typeable
--
-- instance PolicyModule UsersPolicyModule where
-- initPolicyModule priv = do
-- setPolicy priv $ do
-- database $ do
-- readers ==> anybody
-- writers ==> anybody
-- admins ==> this
-- collection "users" $ do
-- access $ do
-- readers ==> anybody
-- writers ==> anybody
-- clearance $ do
-- secrecy ==> this
-- integrity ==> anybody
-- document $ doc -> do
-- readers ==> anybody
-- writers ==> anybody
-- field "name" $ searchable
-- field "password" $ labeled $ doc -> do
-- let user = "name" `at` doc :: String
-- readers ==> this \/ user
-- writers ==> this \/ user
-- return $ UsersPolicyModuleTCB priv
-- where this = privDesc priv
--
--
-- Notice that the database is public, as described above, but only this
-- policy module may modify the internal collection names (as indicated
-- by the admin keyword). Similarly the collection is publicly
-- accessible (as set with the access keyword), and may contain
-- data at most as sensitve as the policy module can read (i.e., the
-- clearance).
--
-- Documents retrieved from the "users" collection are public (as
-- indicated by the document data-dependent policy that sets the
-- readers and writers). The field "name" is
-- searchable (i.e., it is a SearchableField) and thus can
-- be used in query predicates. Conversely, the "password" field
-- is labeled using a data-dependent policy. Specifically the
-- field is labed using the "name" value contained in the document (i.e.,
-- the user's name): hence only the user having the right privilege or
-- the policy module (this) may read and create such data.
module Hails.PolicyModule.DSL
-- | High level function used to set the policy in a PolicyModule.
-- This function takes the policy module's privileges and a policy
-- expression, and produces a PMAction that sets the policy.
setPolicy :: DCPriv -> PolicyExpM () -> PMAction ()
-- | Set secrecy component of the label, i.e., the principals that can
-- read.
readers :: Readers
-- | Set secrecy component of the label, i.e., the principals that can
-- read.
secrecy :: Readers
-- | Set integrity component of the label, i.e., the principals that can
-- write.
writers :: Writers
-- | Set integrity component of the label, i.e., the principals that can
-- write.
integrity :: Writers
-- | Synonym for Admins.
admins :: Admins
-- | r ==> c effectively states that role r (i.e.,
-- readers, writers, admins must imply label
-- component c).
(==>) :: (Role r s m, ToComponent c) => r -> c -> m ()
-- | Inverse implication. Purely provided for readability. The direction is
-- not relevant to the internal representation.
(<==) :: (Role r s m, ToComponent c) => r -> c -> m ()
-- | Create a database lebeling policy The policy must set the label of the
-- database, i.e., the readers and writers. Additionally it
-- must state the admins that can modify the underlying
-- collection-set
--
-- For example, the policy
--
--
-- database $ do
-- readers ==> "Alice" \/ "Bob" \/ "Clarice"
-- writers ==> "Alice" \/ "Bob"
-- admins ==> "Alice"
--
--
-- states that Alice, Bob, and Clarice can read from the database,
-- including the collections in the database (the readers is used
-- as the secrecy component in the collection-set label). Only Alice or
-- Bob may, however, write to the database. Finally, only Alice can add
-- additional collections in the policy module code.
database :: DBExpM () -> PolicyExpM ()
-- | Set the collection labels and policies. Each collection, must
-- at least specify who can access the collection, what the
-- clearance of the data in the collection is, and how
-- documents are labeled. Below is an example that also labels the
-- password field and declares name a searchable key.
--
--
-- collection "w00t" $ do
-- access $ do
-- readers ==> "Alice" \/ "Bob"
-- writers ==> "Alice"
-- clearance $ do
-- secrecy ==> "Users"
-- integrity ==> "Alice"
-- document $ \doc -> do
-- readers ==> anybody
-- writers ==> "Alice" \/ (("name" `at`doc) :: String)
-- field "name" searchable
-- field "password" $ labeled $ \doc -> do
-- readers ==> (("name" `at`doc) :: String)
-- writers ==> (("name" `at`doc) :: String)
--
collection :: CollectionName -> ColExpM () -> PolicyExpM ()
-- | Set the collection access label. For example,
--
--
-- collection "w00t" $ do
-- ...
-- access $ do
-- readers ==> "Alice" \/ "Bob"
-- writers ==> "Alice"
--
--
-- states that Alice and Bob can read documents from the collection, but
-- only Alice can insert new documents or modify existing ones.
access :: ColAccExpM () -> ColExpM ()
-- | Set the collection clearance. For example,
--
--
-- collection "w00t" $ do
-- ...
-- clearance $ do
-- secrecy ==> "Alice" \/ "Bob"
-- integrity ==> "Alice"
--
--
-- states that all data in the collection is always readable by Alice and
-- Bob, and no more trustworthy than data Alice can create.
clearance :: ColClrExpM () -> ColExpM ()
-- | Set data-dependent document label. For example,
--
--
-- collection "w00t" $ do
-- ...
-- document $ \doc -> do
-- readers ==> anybody
-- writers ==> "Alice" \/ (("name" `at`doc) :: String)
--
--
-- states that every document in the collection is readable by anybody,
-- and only Alice or the principal named by the name value in
-- the document can modify or insert such data.
document :: (HsonDocument -> ColDocExpM ()) -> ColExpM ()
-- | Set field policy. A field can be declared to be a searchable
-- key or a labeled value.
--
-- Declaring a field to be a searchable key is straight forward:
--
--
-- collection "w00t" $ do
-- ...
-- field "name" searchable
--
--
-- The labeled field declaration is similar to the document
-- policy, but sets the label of a specific field. For example
--
--
-- collection "w00t" $ do
-- ...
-- field "password" $ labeled $ \doc -> do
-- let user = "name" `at` doc :: String
-- readers ==> user
-- writers ==> user
--
--
-- states that every password field in the is readable and
-- writable only by or the principal named by the name value of
-- the document can modify or insert such data.
field :: FieldName -> ColFieldExpM () -> ColExpM ()
-- | Set the underlying field to be a searchable key.
--
--
-- field "name" searchable
--
searchable :: ColFieldExpM ()
-- | Synonym for searchable
key :: ColFieldExpM ()
-- | Set data-dependent document label
--
--
-- field "password" $ labeled $ \doc -> do
-- readers ==> (("name" `at`doc) :: String)
-- writers ==> (("name" `at`doc) :: String)
--
labeled :: (HsonDocument -> ColLabFieldExpM ()) -> ColFieldExpM ()
instance Typeable PolicySpecificiationError
instance Show DBExp
instance Monad DBExpM
instance MonadState DBExpS DBExpM
instance Show ColAccExp
instance Monad ColAccExpM
instance MonadState ColAccExpS ColAccExpM
instance MonadReader CollectionName ColAccExpM
instance Show ColClrExp
instance Monad ColClrExpM
instance MonadState ColClrExpS ColClrExpM
instance MonadReader CollectionName ColClrExpM
instance Monad ColDocExpM
instance MonadState ColDocExpS ColDocExpM
instance MonadReader CollectionName ColDocExpM
instance Monad ColLabFieldExpM
instance MonadState ColLabFieldExpS ColLabFieldExpM
instance MonadReader (FieldName, CollectionName) ColLabFieldExpM
instance Monad ColFieldExpM
instance MonadState (Maybe ColFieldExp) ColFieldExpM
instance MonadReader (FieldName, CollectionName) ColFieldExpM
instance Show ColExp
instance Show ColExpT
instance Monad ColExpM
instance MonadState ColExpS ColExpM
instance MonadReader CollectionName ColExpM
instance Show PolicyExp
instance Show PolicyExpT
instance Monad PolicyExpM
instance MonadState PolicyExpS PolicyExpM
instance Show PolicySpecificiationError
instance Exception PolicySpecificiationError
instance Role Writers ColLabFieldExpS ColLabFieldExpM
instance Role Readers ColLabFieldExpS ColLabFieldExpM
instance Show ColFieldExp
instance Role Writers ColDocExpS ColDocExpM
instance Role Readers ColDocExpS ColDocExpM
instance Show ColDocExp
instance Role Writers ColClrExpS ColClrExpM
instance Role Readers ColClrExpS ColClrExpM
instance Role Writers ColAccExpS ColAccExpM
instance Role Readers ColAccExpS ColAccExpM
instance Role Admins DBExpS DBExpM
instance Role Writers DBExpS DBExpM
instance Role Readers DBExpS DBExpM
instance Show Admins
instance Show Writers
instance Show Readers
-- | This module exports a class Groups that policy modules must
-- define an instance of to define groups, or mappings between a group
-- Principaland the principals in the group.
--
-- An app may then relabel a labeled value by using labelRewrite.
module Hails.PolicyModule.Groups
class PolicyModule pm => Groups pm
groups :: Groups pm => pm -> DCPriv -> Principal -> DBAction [Principal]
groupsInstanceEndorse :: Groups pm => pm
-- | Given the policy module (which is used to invoke the right
-- groups function) and labeled value, relabel the value according
-- to the Groups of the policy module. Note that the first
-- argument may be bottom since it is solely used for typing purposes.
labelRewrite :: Groups unused_pm => unused_pm -> DCLabeled a -> DBAction (DCLabeled a)
-- | This module exports classes DCRecord and DCLabeledRecord
-- that provide a way for Hails applications to interact with persistent
-- data more easily. Specifically, it provides a way to work with Haskell
-- types as opposed to "unstructured" Documents.
module Hails.Database.Structured
-- | Class for converting from "structured" records to documents (and vice
-- versa). Minimal definition consists of toDocument,
-- fromDocument, and recordCollection. All database
-- operations performed on the collection defined by
-- recordCollection.
class DCRecord a where findBy = findByP noPriv findWhere = findWhereP noPriv insertRecord = insertRecordP noPriv saveRecord = saveRecordP noPriv insertRecordP p r = liftDB $ do { insertP p (recordCollection r) $ toDocument r } saveRecordP p r = liftDB $ do { saveP p (recordCollection r) $ toDocument r } findByP p cName k v = findWhereP p (select [k -: v] cName) findWhereP p query = liftDB $ do { mldoc <- findOneP p query; c <- getClearance; case mldoc of { Just ldoc | canFlowToP p (labelOf ldoc) c -> fromDocument `liftM` (liftLIO $ unlabelP p ldoc) _ -> return Nothing } }
fromDocument :: (DCRecord a, Monad m) => Document -> m a
toDocument :: DCRecord a => a -> Document
recordCollection :: DCRecord a => a -> CollectionName
findBy :: (DCRecord a, BsonVal v, MonadDB m) => CollectionName -> FieldName -> v -> m (Maybe a)
findWhere :: (DCRecord a, MonadDB m) => Query -> m (Maybe a)
insertRecord :: (DCRecord a, MonadDB m) => a -> m ObjectId
saveRecord :: (DCRecord a, MonadDB m) => a -> m ()
findByP :: (DCRecord a, BsonVal v, MonadDB m) => DCPriv -> CollectionName -> FieldName -> v -> m (Maybe a)
findWhereP :: (DCRecord a, MonadDB m) => DCPriv -> Query -> m (Maybe a)
insertRecordP :: (DCRecord a, MonadDB m) => DCPriv -> a -> m ObjectId
saveRecordP :: (DCRecord a, MonadDB m) => DCPriv -> a -> m ()
-- | Find all records that satisfy the query and can be read, subject to
-- the current clearance.
findAll :: (DCRecord a, MonadDB m) => Query -> m [a]
-- | Same as findAll, but uses privileges.
findAllP :: (DCRecord a, MonadDB m) => DCPriv -> Query -> m [a]
-- | Class used by a policy module to translate a labeled record to a
-- labeled document. Since the insert and save functions use the policy
-- module's privileges, only the policy module should be allowed to
-- create an instance of this class. Thus, we leverage the fact that the
-- value constructor for a PolicyModule is not exposed to
-- untrusted code and require the policy module to create such a value in
-- endorseInstance. The minimal implementation needs to define
-- endorseInstance.
class (PolicyModule pm, DCRecord a) => DCLabeledRecord pm a | a -> pm where insertLabeledRecord lrec = insertLabeledRecordP noPriv lrec saveLabeledRecord lrec = saveLabeledRecordP noPriv lrec insertLabeledRecordP p lrec = liftDB $ do { let cName = recordCollection (forceType lrec); ldoc <- toLabeledDocumentP p lrec; insertP p cName ldoc } saveLabeledRecordP p lrec = liftDB $ do { let cName = recordCollection (forceType lrec); ldoc <- toLabeledDocumentP p lrec; saveP p cName ldoc }
insertLabeledRecord :: (DCLabeledRecord pm a, MonadDB m) => DCLabeled a -> m ObjectId
saveLabeledRecord :: (DCLabeledRecord pm a, MonadDB m) => DCLabeled a -> m ()
insertLabeledRecordP :: (DCLabeledRecord pm a, MonadDB m) => DCPriv -> DCLabeled a -> m ObjectId
saveLabeledRecordP :: (DCLabeledRecord pm a, MonadDB m) => DCPriv -> DCLabeled a -> m ()
endorseInstance :: DCLabeledRecord pm a => DCLabeled a -> pm
-- | Convert labeled record to labeled document.
toLabeledDocument :: (MonadDB m, DCLabeledRecord pm a) => DCLabeled a -> m (DCLabeled Document)
-- | Convert labeled document to labeled record
fromLabeledDocument :: (MonadDB m, DCLabeledRecord pm a) => DCLabeled Document -> m (DCLabeled a)
-- | Uses the policy modules's privileges to convert a labeled record to a
-- labeled document, if the policy module created an instance of
-- DCLabeledRecord.
toLabeledDocumentP :: (MonadDB m, DCLabeledRecord pm a) => DCPriv -> DCLabeled a -> m (DCLabeled Document)
-- | Uses the policy modules's privileges to convert a labeled document to
-- a labeled record, if the policy module created an instance of
-- DCLabeledRecord.
fromLabeledDocumentP :: (MonadDB m, DCLabeledRecord pm a) => DCPriv -> DCLabeled Document -> m (DCLabeled a)