content: {-# LANGUAGE Trustworthy #-}
  
  {- |
  
  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 (
    -- * Collection
      CollectionName
    , CollectionSet
    , Collection, colName, colLabel, colClearance, colPolicy
    -- * Database
    , DatabaseName
    , Database, databaseName, databaseLabel, databaseCollections
    -- * Labeled documents
    , LabeledHsonDocument
    -- * Hails DB monad
    , DBAction, DBActionState
    , withDBContext
    , MonadDB(..)
    , runDBAction, evalDBAction
    , getDatabase, getDatabaseP
    -- ** Database system configuration
    , Pipe, AccessMode(..), master, slaveOk
    ) where
  
  import           Data.Monoid
  import           Control.Monad
  import           Control.Monad.Trans.State
  
  import           LIO
  import           LIO.DCLabel
  import           LIO.Error
  
  import           Hails.Data.Hson
  import           Hails.Database.TCB
  
  
  --
  -- Labeled documents
  --
  -- | A labeled 'HsonDocument'.
  type LabeledHsonDocument = DCLabeled HsonDocument
  
  --
  -- DB monad
  --
  
  -- | 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)
  runDBAction = runStateT . unDBAction
  
  -- | Execute a database action returning the final result.
  evalDBAction :: DBAction a -> DBActionState -> DC a
  evalDBAction a s = fst `liftM` runDBAction a s
  
  
  -- | Execute a database action with a "stack" context.
  withDBContext :: String -> DBAction a -> DBAction a
  withDBContext ctx (DBActionTCB act) =
     DBActionTCB  . StateT $ \s ->
      withContext ctx $ runStateT act s
  
  -- | 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
  getDatabase = getDatabaseP mempty
  
  -- | Same as 'getDatabase', but uses privileges when raising the
  -- current label.
  getDatabaseP :: DCPriv -> DBAction Database
  getDatabaseP p = withDBContext "getDatabaseP" $ do
    db <- dbActionDB `liftM` getActionStateTCB
    liftLIO $ taintP p (databaseLabel db)
    return db
  
  -- | Arbitrary monad that can perform database actions.
  class Monad m => MonadDB m where
    -- | Lift a database action into the database monad.
    liftDB :: DBAction a -> m a
  
  instance MonadDB DBAction where liftDB = id
  