import Rakka.Resource
import Rakka.Storage
import Rakka.SystemConfig
+import Rakka.Utils
import Rakka.Wiki.Engine
import System.FilePath
+import Text.XML.HXT.Arrow.Namespace
import Text.XML.HXT.Arrow.WriteDocument
import Text.XML.HXT.Arrow.XmlArrow
import Text.XML.HXT.Arrow.XmlIOStateArrow
= return $ Just $ ResourceDef {
resUsesNativeThread = False
, resIsGreedy = True
- , resGet = Just $ handleGet env (toPageName path)
+ , resGet = Just $ handleGet env (toPageName path)
, resHead = Nothing
, resPost = Nothing
- , resPut = Just $ handlePut env (toPageName path)
- , resDelete = Nothing
+ , resPut = Just $ handlePut env (toPageName path)
+ , resDelete = Just $ handleDelete env (toPageName path)
}
where
toPageName :: [String] -> PageName
= runIdempotentA $ proc ()
-> do pageM <- getPageA (envStorage env) -< (name, Nothing)
case pageM of
- Nothing
- -> handlePageNotFound env -< name
+ Nothing -> handlePageNotFound env -< name
+ Just page -> if isEntity page then
+ handleGetEntity env -< page
+ else
+ handleRedirect env -< page
- Just redir@(Redirection _ _ _ _ _)
- -> handleRedirect env -< redir
-
- Just entity@(Entity _ _ _ _ _ _ _ _ _ _ _ _ _ _ _)
- -> handleGetEntity env -< entity
{-
HTTP/1.1 302 Found
-> do SiteName siteName <- getSysConfA (envSysConf env) -< ()
BaseURI baseURI <- getSysConfA (envSysConf env) -< ()
StyleSheet styleSheet <- getSysConfA (envSysConf env) -< ()
+ GlobalLock isGLocked <- getSysConfA (envSysConf env) -< ()
- name <- (getXPathTreesInDoc "/page/@name/text()" >>> getText) -< page
+ name <- (getXPathTreesInDoc "/page/@name/text()" >>> getText) -< page
+ isLocked <- (getXPathTreesInDoc "/page/@isLocked/text()" >>> getText >>> parseYesOrNo) -< page
let cssHref = [uriToString id (mkObjectURI baseURI styleSheet) ""]
scriptSrc = [uriToString id (baseURI { uriPath = uriPath baseURI </> "js" }) ""]
+= sattr "type" "text/javascript"
+= attr "src" (arr id >>> mkText)
)
+ += ( eelem "script"
+ += sattr "type" "text/javascript"
+ += txt ("Rakka.baseURI=\"" ++ uriToString id baseURI "" ++ "\";")
+ += txt ("Rakka.isLocked=" ++ trueOrFalse isLocked ++ ";")
+ += txt ("Rakka.isGlobalLocked=" ++ trueOrFalse isGLocked ++ ";")
+ )
)
+= ( eelem "body"
+= ( eelem "div"
)
)
)
+ >>>
+ uniqueNamespacesFromDeclAndQNames
) ) -<< page
-> do SiteName siteName <- getSysConfA (envSysConf env) -< ()
BaseURI baseURI <- getSysConfA (envSysConf env) -< ()
StyleSheet styleSheet <- getSysConfA (envSysConf env) -< ()
+ GlobalLock isGLocked <- getSysConfA (envSysConf env) -< ()
name <- (getXPathTreesInDoc "/pageNotFound/@name/text()" >>> getText) -< pageNotFound
+= sattr "type" "text/javascript"
+= attr "src" (arr id >>> mkText)
)
+ += ( eelem "script"
+ += sattr "type" "text/javascript"
+ += txt ("Rakka.baseURI = \"" ++ uriToString id baseURI "" ++ "\";")
+ += txt ("Rakka.isGlobalLocked=" ++ trueOrFalse isGLocked ++ ";")
+ )
)
+= ( eelem "body"
+= ( eelem "div"
)
)
)
+ >>>
+ uniqueNamespacesFromDeclAndQNames
) ) -<< pageNotFound
handlePut :: Environment -> PageName -> Resource ()
handlePut env name
- = runXmlA env "rakka-page-1.0.rng" $ proc tree
- -> do page <- parseXmlizedPage -< (name, tree)
- status <- putPageA (envStorage env) -< page
- returnA -< setStatus status
+ = do userID <- getUserID env
+ runXmlA env "rakka-page-1.0.rng" $ proc tree
+ -> do page <- parseXmlizedPage -< (name, tree)
+ status <- putPageA (envStorage env) -< (userID, page)
+ returnA -< setStatus status
+
+
+handleDelete :: Environment -> PageName -> Resource ()
+handleDelete env name
+ = do userID <- getUserID env
+ status <- deletePage (envStorage env) userID name
+ setStatus status