module Network.Orchid.Core.Liaison ( hWikiRetrieve , hWikiDelete , hWikiStore ) where import Control.Applicative ((<$>)) import Control.Monad.State (gets, lift) import Data.Encoding (encodeLazy) import Data.Encoding.UTF8 (UTF8 (..)) import Data.List (find) import qualified Data.ByteString.Lazy as B import Network.Salvia.Handlers.Error (safeIO, hError, hCustomError) import Network.Salvia.Handlers.File () import Network.Salvia.Handlers.Login (username, User) import Network.Salvia.Handlers.MethodRouter () import Network.Salvia.Handlers.PathRouter () import Network.Salvia.Httpd (UriHandler, sendBs, request, modResponse, contentsUtf8) import Network.Protocol.Http import Network.Orchid.Core.Backend (Backend (..), Revision (..)) import Network.Orchid.Core.Format (WikiFormat (..), Output (..)) import Network.Orchid.FormatRegister import qualified Network.Protocol.Uri as U -- TODO: should history be here instead of format dir? -------- showing wiki documents ----------------------------------------------- {- | Dependent on the `b' flag we either bounce the PUTted contents back in the requested format, or we open the source version of the requested resource and print this back in the requested format. -} hWikiRetrieve :: Backend -> FilePath -> Bool -> UriHandler () hWikiRetrieve backend workDir b u = do -- Fetch revision identifier from URI query string. rev <- Revision "" "" . U.query . uri <$> gets request -- Compute the source file and format handler. let src = U.relative $ U.setExtension Nothing u ext = maybe "txt" id $ U.extension u fmt = maybe defaultFormat id $ find ((ext==) . extension) wikiFormats -- The body might be retrieved from our backend or from the request itself. body <- if b then contentsUtf8 else lift (retrieve backend (U.path src) rev) -- Format the body using the selected wiki handler or return an error when -- the body could not be retrieved. case body of Nothing -> hError NotFound Just s -> do b <- lift $ (handler fmt) backend workDir src s (body, enc) <- return $ case b of TextOutput s -> (encodeLazy UTF8 s, Just utf8) BinaryOutput bs -> (bs, Nothing) modResponse $ setStatus OK . setContentType (mime fmt) enc . setContentLength (B.length body) sendBs body -------- deleting wiki documents ---------------------------------------------- -- TODO:generalize deletion/storage hWikiDelete :: Backend -> Maybe User -> UriHandler () hWikiDelete backend user u = do -- Fetch revision identifier from URI query string. revname <- gets (U.query . uri . request) let rev = Revision "" (maybe "guest" username user) revname let src = U.setExtension Nothing u safeIO (delete backend (U.path $ U.relative src) rev) (const $ return ()) -------- storing wiki documents ----------------------------------------------- hWikiStore :: Backend -> Maybe User -> UriHandler () hWikiStore backend user u = do -- Fetch revision identifier from URI query string. revname <- gets (U.query . uri . request) let rev = Revision "" (maybe "guest" username user) revname let src = U.setExtension Nothing u -- Check history to prevent duplicate revision name. p <- maybe [] (filter (\(Revision d a n) -> n == revname)) <$> lift (history backend (U.path $ U.relative src)) case p of x:xs -> hCustomError BadRequest "existing revision name" [] -> do c <- contentsUtf8 case c of Nothing -> modResponse $ setStatus BadRequest Just c' -> safeIO (store backend (U.path $ U.relative src) rev c') (const $ return ())