Commit 9d0e5bfb authored by Bas Lijnse's avatar Bas Lijnse

Added simple help texts to the services.

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@1128 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent cdbb85c2
......@@ -10,5 +10,7 @@ applicationService url html path req tst=:{staticInfo}
# json = JSONObject [("success", JSONBool True)
,("application", JSONString staticInfo.appName)
]
= (serviceResponse html "application" url [] json, tst)
_ = (notFoundResponse req, tst)
\ No newline at end of file
= (serviceResponse html "Application info" description url [] json, tst)
_ = (notFoundResponse req, tst)
description :== "This service provides basic information about the application such as it's name."
\ No newline at end of file
......@@ -15,32 +15,32 @@ documentService url html path req tst
[]
| isJust mbSessionErr
# json = JSONObject [("success",JSONBool False),("error", JSONString (fromJust mbSessionErr))]
= (serviceResponse html "list documents" url params json, tst)
= (serviceResponse html "Document list" listDescription url params json, tst)
# (documents, tst) = getDocuments tst
# json = JSONObject [("success",JSONBool True),("documents", toJSON documents)]
= (serviceResponse html "list documents" url params json, tst)
= (serviceResponse html "Document list" listDescription url params json, tst)
//Upload new documents (you can upload multiple documents at once)
["upload"]
| isJust mbSessionErr
# json = JSONObject [("success",JSONBool False),("error", JSONString (fromJust mbSessionErr))]
= (serviceResponse html "upload document" url params json, tst)
= (serviceResponse html "Upload document" uploadDescription url params json, tst)
| length req.arg_uploads == 0
# json = JSONObject [("success",JSONBool False),("error",JSONString "No documents were uploaded")]
= (serviceResponse html "upload document" url params json, tst)
= (serviceResponse html "Upload document" uploadDescription url params json, tst)
# (documents, tst) = createDocuments req.arg_uploads tst
# json = JSONObject [("success",JSONBool True),("documents", toJSON documents)]
= (serviceResponse html "upload document" url params json, tst)
= (serviceResponse html "Upload document" uploadDescription url params json, tst)
//Requests for a single request
[documentId]
| isJust mbSessionErr
# json = JSONObject [("success",JSONBool False),("error", JSONString (fromJust mbSessionErr))]
= (serviceResponse html "list documents" url params json, tst)
= (serviceResponse html "Document details" detailsDescription url params json, tst)
# (mbDocument, tst) = getDocument documentId tst
= case mbDocument of
Just document
# json = JSONObject [("success",JSONBool True),("document",toJSON document)]
= (serviceResponse html "list documents" url params json, tst)
= (serviceResponse html "Document details" detailsDescription url params json, tst)
Nothing
= (notFoundResponse req,tst)
//Download the document (without attachment header to show embedded in a browser)
......@@ -64,7 +64,7 @@ where
documentContent mbSessionErr documentId title download tst
| isJust mbSessionErr
# json = JSONObject [("success",JSONBool False),("error", JSONString (fromJust mbSessionErr))]
= (serviceResponse html title url params json, tst)
= (serviceResponse html title contentDescription url params json, tst)
# (mbDocument, tst) = getDocument documentId tst
# (mbContent, tst) = getDocumentContent documentId tst
= case (mbDocument, mbContent) of
......@@ -73,5 +73,9 @@ where
# headers = [("Status","200 OK"),("Content-Type", mime),("Content-Length", toString size):downloadHeader]
= ({HTTPResponse|rsp_headers = headers, rsp_data = content},tst)
_
= (notFoundResponse req,tst)
\ No newline at end of file
= (notFoundResponse req,tst)
listDescription :== "This service lists all documents stored on the server."
uploadDescription :== "This service let's you upload a new document."
detailsDescription :== "This service provides the meta-data of a document."
contentDescription :== "This service provides the content of a document."
\ No newline at end of file
......@@ -17,7 +17,7 @@ sessionService url html path req tst
# (mbErr,tst) = if ( sessionParam <> "") (initSession sessionParam tst) (Nothing,tst)
| isJust mbErr
# json = JSONObject [("success",JSONBool False),("error", JSONString (fromJust mbErr))]
= (serviceResponse html "sessions" url listParams json, tst)
= (serviceResponse html "Session list" listDetails url listParams json, tst)
# (session,tst) = getCurrentSession tst
# (sessions,tst) = case session.Session.user of
RootUser
......@@ -29,14 +29,14 @@ sessionService url html path req tst
= getSessionsForUser user tst
# json = JSONObject [("success",JSONBool True),("sessions", toJSON sessions)]
= (serviceResponse html "sessions" url listParams json, tst)
= (serviceResponse html "Session list" listDetails url listParams json, tst)
//Create a new session
["create"]
//Anonymous session
| usernameParam == "" && passwordParam == ""
# json = JSONObject [("success",JSONBool False),("error",JSONString "Anonymous sessions not yet supported")]
= (serviceResponse html "create session" url createParams json, tst)
= (serviceResponse html "Create session" createDescription url createParams json, tst)
//Authenticated session
| otherwise
# (mbUser, tst) = authenticateUser usernameParam passwordParam tst
......@@ -45,10 +45,10 @@ sessionService url html path req tst
# (session, tst) = createSession user tst
# tst = flushStore tst
# json = JSONObject [("success",JSONBool True),("session",toJSON session)]
= (serviceResponse html "create session" url createParams json, tst)
= (serviceResponse html "Create session" createDescription url createParams json, tst)
Nothing
# json = JSONObject [("success",JSONBool False),("error",JSONString "Incorrect username or password")]
= (serviceResponse html "create session" url createParams json, tst)
= (serviceResponse html "Create session" createDescription url createParams json, tst)
//Show details of an existing sessions
[sessionId]
......@@ -56,7 +56,7 @@ sessionService url html path req tst
= case mbSession of
Just session
# json = JSONObject [("success",JSONBool True),("session",toJSON session)]
= (serviceResponse html "session details" url [] json, tst)
= (serviceResponse html "Session details" detailsDescription url [] json, tst)
Nothing
= (notFoundResponse req, tst)
......@@ -66,7 +66,7 @@ sessionService url html path req tst
# tst = flushStore tst
# json = JSONObject [("success", JSONBool True)]
| deleted
= (serviceResponse html "session delete" url [] json, tst)
= (serviceResponse html "Delete session" deleteDescription url [] json, tst)
| otherwise
= (notFoundResponse req, tst)
......@@ -79,3 +79,8 @@ where
createParams = [("username",usernameParam,True),("password",passwordParam,True)]
usernameParam = paramValue "username" req
passwordParam = paramValue "password" req
listDetails :== "This service lists the active sessions.<br />You only get this list by providing the session id of a session of the root user."
createDescription :== "This service let's you create new sessions by sending a username/password combination."
detailsDescription :== "This service provides all data of a session"
deleteDescription :== "This service deletes an existing session"
\ No newline at end of file
......@@ -15,28 +15,28 @@ userService url html path req tst
//List users
[]
| isJust mbSessionErr
= (serviceResponse html "users" url params (jsonSessionErr mbSessionErr), tst)
= (serviceResponse html "User list" listDescription url params (jsonSessionErr mbSessionErr), tst)
# (users,tst) = getUsers tst
# items = [details \\ RegisteredUser details <- users]
# json = JSONObject [("success",JSONBool True),("users",toJSON items)]
= (serviceResponse html "users" url params json, tst)
= (serviceResponse html "User list" listDescription url params json, tst)
//List usernames
["names"]
| isJust mbSessionErr
= (serviceResponse html "users names" url params (jsonSessionErr mbSessionErr), tst)
= (serviceResponse html "User name list" nameListDescription url params (jsonSessionErr mbSessionErr), tst)
# (users,tst) = getUsers tst
# json = JSONObject [("success",JSONBool True),("users",toJSON (sort [toString u \\ u <- users]))]
= (serviceResponse html "users names" url params json, tst)
= (serviceResponse html "User name list" nameListDescription url params json, tst)
//Show user details
[userId]
| isJust mbSessionErr
= (serviceResponse html "user details" url params (jsonSessionErr mbSessionErr), tst)
= (serviceResponse html "User details" detailsDescription url params (jsonSessionErr mbSessionErr), tst)
# (mbUser,tst) = getUser userId tst
= case mbUser of
Just (RegisteredUser details)
# json = JSONObject [("success",JSONBool True),("user",toJSON details)]
= (serviceResponse html "user details" url params json, tst)
= (serviceResponse html "User details" detailsDescription url params json, tst)
_
= (notFoundResponse req,tst)
_
......@@ -46,4 +46,8 @@ where
params = [("session",sessionParam,True)]
jsonSessionErr (Just error)
= JSONObject [("success",JSONBool False),("error", JSONString error)]
\ No newline at end of file
= JSONObject [("success",JSONBool False),("error", JSONString error)]
listDescription :== "This service lists the details of all users."
nameListDescription :== "This service lists the usernames of all users."
detailsDescription :== "This service lists all information about a user."
\ No newline at end of file
......@@ -24,13 +24,13 @@ workflowService url html path req tst
# (mbErr,tst) = if ( sessionParam <> "") (initSession sessionParam tst) (Nothing,tst)
| isJust mbErr
# json = JSONObject [("success",JSONBool False),("error", JSONString (fromJust mbErr))]
= (serviceResponse html "workflows" url params json, tst)
= (serviceResponse html "workflows" description url params json, tst)
// List available flows
# (session,tst) = getCurrentSession tst
# (workflows,tst) = getWorkflows tst
# items = workflowItems path (session.Session.user) workflows
# json = JSONObject [("success",JSONBool True),("workflows",toJSON items)]
= (serviceResponse html "workflows" url params json, tst)
= (serviceResponse html "workflows" description url params json, tst)
where
sessionParam= paramValue "session" req
......@@ -55,4 +55,9 @@ where
= {WorkflowItem | name = wf.Workflow.path, label = shortPath, folder = False}
| otherwise
# label = shortPath % (0, slashPos - 1)
= {WorkflowItem | name = if (paths == "") label (paths +++ "/" +++ label), label = label, folder = True}
\ No newline at end of file
= {WorkflowItem | name = if (paths == "") label (paths +++ "/" +++ label), label = label, folder = True}
description :== "This service provides a directory of available workflows that can be started.<br />"
+++ "Only workflows are given that are allowed for the current session.<br />"
+++ "If the 'folder' field is set to true, the entry is not a workflow but a collection of flows that can be "
+++ "accessed by appending it's name to the URI. E.g workflows/Foo/Bar/Baz."
......@@ -10,19 +10,19 @@ import Html, JSON, Http
*/
embeddedStyle :: HtmlTag
/**
* Creates the basic layout for a page with a title and body
* Creates the basic layout for a page with a title, description and body
*/
pageLayout :: !String ![HtmlTag] -> HtmlTag
pageLayout :: !String !String ![HtmlTag] -> HtmlTag
/**
* Creates a simple page for accessing a service
*/
servicePage :: !String !String ![(String,String,Bool)] JSONNode -> HtmlTag
servicePage :: !String !String !String ![(String,String,Bool)] JSONNode -> HtmlTag
/**
* Creates an HTTP response of a service page
*/
serviceResponse :: !Bool !String !String ![(String,String,Bool)] JSONNode -> HTTPResponse
serviceResponse :: !Bool !String !String !String ![(String,String,Bool)] JSONNode -> HTTPResponse
/**
......
......@@ -12,6 +12,7 @@ where
+++ "#content { padding: 10px; } "
+++ ".buttons { padding: 5px; background-color: #3a81ad; } "
+++ ".section { margin: 10px; border: solid 1px #d1dded; -moz-border-radius: 10px; padding: 5px; overflow: auto;} "
+++ ".description { padding: 15px; } "
+++ ".parameters th, .parameters td { width: 25%; } "
+++ ".json { font-family: Courier, monotype; font-size: 12px;} "
+++ ".json ul { padding-left: 15px;} "
......@@ -20,17 +21,17 @@ where
+++ "p { margin: 0px 0px 10px 0px; } "
+++ "button {-moz-border-radius: 3px; }"
pageLayout :: !String ![HtmlTag] -> HtmlTag
pageLayout title content = HtmlTag [] [head,body]
pageLayout :: !String !String ![HtmlTag] -> HtmlTag
pageLayout title description content = HtmlTag [] [head,body]
where
head = HeadTag [] [TitleTag [] [Text title], embeddedStyle]
body = BodyTag [] [DivTag [IdAttr "main"] [header:content]]
body = BodyTag [] [DivTag [IdAttr "main"] (header ++ content)]
header = H1Tag [] [Text title]
header = [H1Tag [] [Text title],PTag [] [DivTag [ClassAttr "description"] [RawText description]]]
servicePage :: !String !String ![(String,String,Bool)] JSONNode -> HtmlTag
servicePage title url params json = pageLayout title [parameters, message, alternatives]
servicePage :: !String !String !String ![(String,String,Bool)] JSONNode -> HtmlTag
servicePage title description url params json = pageLayout title description [parameters, message, alternatives]
where
parameters = pageSection "Parameters" [FormTag [ActionAttr url,MethodAttr "get"] [TableTag [ClassAttr "parameters"] (rows ++ send)]]
rows = [TrTag [] [ThTag [] [Text n : if o [Text "*:"] [Text ":"]], TdTag [] [InputTag [NameAttr n, ValueAttr v]]] \\ (n,v,o) <- params]
......@@ -39,9 +40,9 @@ where
jsonurl = replaceSubString "services/html" "services/json" url
alternatives= pageSection "Alternative representations" [PTag [] [Text "JSON: ", ATag [HrefAttr jsonurl] [Text jsonurl]]]
serviceResponse :: !Bool !String !String ![(String,String,Bool)] JSONNode -> HTTPResponse
serviceResponse html title url params json =
if html {http_emptyResponse & rsp_data = toString (servicePage title url params json)}
serviceResponse :: !Bool !String !String !String ![(String,String,Bool)] JSONNode -> HTTPResponse
serviceResponse html title description url params json =
if html {http_emptyResponse & rsp_data = toString (servicePage title description url params json)}
{http_emptyResponse & rsp_data = toString json}
......@@ -58,7 +59,7 @@ formatJSON (JSONRaw r) = [PreTag [] [Text (toString r)]]
formatJSON _ = []
notFoundPage :: !HTTPRequest -> HtmlTag
notFoundPage req = pageLayout "404 - Not Found" message
notFoundPage req = pageLayout "404 - Not Found" "" message
where
message = [DivTag [IdAttr "content"] [Text "The resource you tried to access ",StrongTag [] [Text req.req_path], Text " could not be found."]]
......
......@@ -74,7 +74,7 @@ noErrors :: [(Maybe String)] -> Bool
noErrors errors = not (or (map isJust errors))
page :: !String ![HtmlTag] !*World -> (!HTTPResponse,!HTTPServerControl, !*World)
page appName content world = ({http_emptyResponse & rsp_data = toString (pageLayout (appName +++ " setup") content)}, HTTPServerContinue, world)
page appName content world = ({http_emptyResponse & rsp_data = toString (pageLayout (appName +++ " setup") "" content)}, HTTPServerContinue, world)
choicePage :: !String !Config ![Maybe String] !*World -> (!HTTPResponse,!HTTPServerControl,!*World)
choicePage appName config errors world = page appName [DivTag [IdAttr "content"] [instructions,showConfig config errors],buttons] world
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment