Commit 35ff8645 authored by Michael Hanus 's avatar Michael Hanus

Spicey framework adapted to use the new html2/wui2 packages

parent 7fd88476
......@@ -34,14 +34,16 @@ To generate an application, follow the steps below.
3. Change into the generated directory containing all sources as a
Curry package, e.g., by `cd Blog`.
4. Install all required packages by `make install`.
4. Define in the Makefile the variable WEBSERVERDIR (and possibly
other variables, like SYSTEM or CURRYOPTIONS).
5. Compile the generated programs by `make compile`.
5. Install all required packages by `make install`.
6. Configure the Makefile (variable WEBSERVERDIR) and execute
`make deploy` to deploy the web application.
6. Compile the generated programs by `make compile`.
7. After the successful compilation, the application is executable
7. Execute `make deploy` to deploy the web application.
8. After the successful compilation, the application is executable
in a web browser by loading `<URL of web dir>/spicey.cgi`.
Note that the database is generated with the `cdbi` package.
......
import Database.ERD
blogERD :: ERD
blogERD =
ERD "Blog"
[Entity "Entry"
[Attribute "Title" (StringDom Nothing) Unique False,
Attribute "Text" (StringDom Nothing) NoKey False,
Attribute "Author" (StringDom Nothing) NoKey False,
Attribute "Date" (DateDom Nothing) NoKey False],
Entity "Comment"
[Attribute "Text" (StringDom Nothing) NoKey False,
Attribute "Author" (StringDom Nothing) NoKey False,
Attribute "Date" (DateDom Nothing) NoKey False],
Entity "Tag"
[Attribute "Name" (StringDom Nothing) Unique False]
]
[Relationship "Commenting"
[REnd "Entry" "commentsOn" (Exactly 1),
REnd "Comment" "isCommentedBy" (Between 0 Infinite)],
Relationship "Tagging"
[REnd "Entry" "tags" (Between 0 Infinite),
REnd "Tag" "tagged" (Between 0 Infinite)]
]
blogERD = ERD "Blog"
[Entity "Entry"
[Attribute "Title" (StringDom Nothing) Unique False,
Attribute "Text" (StringDom Nothing) NoKey False,
Attribute "Author" (StringDom Nothing) NoKey False,
Attribute "Date" (DateDom Nothing) NoKey False],
Entity "Comment"
[Attribute "Text" (StringDom Nothing) NoKey False,
Attribute "Author" (StringDom Nothing) NoKey False,
Attribute "Date" (DateDom Nothing) NoKey False],
Entity "Tag"
[Attribute "Name" (StringDom Nothing) Unique False]
]
[Relationship "Commenting"
[REnd "Entry" "commentsOn" (Exactly 1),
REnd "Comment" "isCommentedBy" (Between 0 Infinite)],
Relationship "Tagging"
[REnd "Entry" "tags" (Between 0 Infinite),
REnd "Tag" "tagged" (Between 0 Infinite)]
]
......@@ -19,16 +19,19 @@ compileSpiceyApplication erdname = do
setCurrentDirectory testdir
system $ spiceup ++ " " ++
packagePath </> "examples" </> erdname ++ "ERD.curry"
let makecall = "make WEBSERVERDIR=/tmp"
putStrLn $ "Compiling Spicey application in directory '" ++ testdir ++ "'..."
ecode <- system $ "cd " ++ erdname ++ " && make install && " ++
"make CURRYOPTIONS=\":set parser -Wnone\" compile"
ecode <- system $ "cd " ++ erdname ++ " && " ++
makecall ++ " install && " ++
makecall ++ " CURRYOPTIONS=\":set parser -Wnone\" compile"
setCurrentDirectory curdir
system $ "/bin/rm -rf " ++ testdir
return ecode
-- Compile the Blog example.
testCompileBlog :: PropIO
testCompileBlog = compileSpiceyApplication "Blog" `returns` 0
-- Omitted due to bug in controller generation:
--testCompileUni :: PropIO
--testCompileUni = compileSpiceyApplication "Uni" `returns` 0
-- Compile the Uni example.
testCompileUni :: PropIO
testCompileUni = compileSpiceyApplication "Uni" `returns` 0
import Database.ERD
uniERD :: ERD
uniERD =
ERD "Uni"
[Entity "Student" [Attribute "MatNum" (IntDom Nothing) PKey False,
Attribute "Name" (StringDom Nothing) NoKey False,
Attribute "Firstname" (StringDom Nothing) NoKey False,
Attribute "Email" (StringDom Nothing) NoKey True],
Entity "Lecture" [Attribute "Id" (IntDom Nothing) PKey False,
Attribute "Title" (StringDom Nothing) Unique False,
Attribute "Hours" (IntDom (Just 4)) NoKey False],
Entity "Lecturer" [Attribute "Id" (IntDom Nothing) PKey False,
uniERD = ERD "Uni"
[Entity "Student" [Attribute "MatNum" (IntDom Nothing) PKey False,
Attribute "Name" (StringDom Nothing) NoKey False,
Attribute "Firstname" (StringDom Nothing) NoKey False,
Attribute "Email" (StringDom Nothing) NoKey True],
Entity "Lecture" [Attribute "Code" (StringDom Nothing) PKey False,
Attribute "Title" (StringDom Nothing) Unique False,
Attribute "Hours" (IntDom (Just 4)) NoKey False],
Entity "Lecturer" [Attribute "PersNum" (IntDom Nothing) PKey False,
Attribute "Name" (StringDom Nothing) NoKey False,
Attribute "Firstname" (StringDom Nothing) NoKey False],
Entity "Group" [Attribute "Time" (StringDom Nothing) NoKey False]]
Entity "Group" [Attribute "Time" (StringDom Nothing) NoKey False]]
[Relationship "Teaching"
[REnd "Lecturer" "taught_by" (Exactly 1),
REnd "Lecture" "teaches" (Between 0 Infinite)],
......@@ -21,5 +20,5 @@ uniERD =
[REnd "Student" "participated_by" (Between 0 Infinite),
REnd "Lecture" "participates" (Between 0 Infinite)],
Relationship "Membership"
[REnd "Student" "consists_of" (Exactly 3),
REnd "Group" "member_of" (Between 0 Infinite)]]
[REnd "Student" "consists_of" (Between 0 Infinite),
REnd "Group" "member_of" (Between 0 Infinite)]]
{
"name": "spicey",
"version": "3.1.0",
"version": "3.2.0",
"author": "Michael Hanus <mh@informatik.uni-kiel.de>",
"synopsis": "A web application framework for Curry",
"category": [ "Web", "Database" ],
......
......@@ -13,7 +13,7 @@ module System.Authentication (
) where
import System.SessionInfo
import System.Crypto
import Crypto.Hash
--------------------------------------------------------------------------
-- Operations for hashing.
......
--- Some global configurations for the Spicey application.
module Config.Spicey
where
--- Location of the directory containing private run-time data
--- such as session and authentication information.
spiceyDataDir :: String
spiceyDataDir = "data"
------------------------------------------------------------------------------
--- Some configurations where data is stored.
------------------------------------------------------------------------------
module Config.Storage where
import FilePath ( (</>) )
--- Prefix a file name with the directory where global form data
--- is stored during run-time.
inDataDir :: String -> String
inDataDir filename = "data" </> filename
......@@ -6,14 +6,19 @@
--------------------------------------------------------------------------
module Controller.SpiceySystem
(loginController,processListController,historyController)
( loginController, loginFormDef
, processListController, historyController
)
where
import Global
import ReadNumeric
import Config.Storage
import Config.UserProcesses
import System.Spicey
import System.Session
import HTML.Base
import HTML.Session
import System.Processes
import System.Authentication
import View.SpiceySystem
......@@ -24,7 +29,19 @@ import Controller.DefaultController
loginController :: Controller
loginController = do
login <- getSessionLogin
return $ loginView defaultController login
putSessionData loginViewData login
return [formExp loginFormDef]
loginFormDef :: HtmlFormDef (Maybe String)
loginFormDef =
formDefWithID "Controller.SpiceySystem.loginFormDef"
(getSessionData loginViewData Nothing)
(loginView defaultController)
--- The data processed by the login form.
loginViewData :: Global (SessionStore (Maybe String))
loginViewData =
global emptySessionStore (Persistent (inDataDir "loginViewData"))
-----------------------------------------------------------------------------
--- Controller for showing and selecting user processes.
......
----------------------------------------------------------------------------
--- This library contains operations to support simple cryptography.
--- In particular, it provides operations for hasing
--- (based on hashing algorithms from Unix).
---
--- @author Michael Hanus
----------------------------------------------------------------------------
module System.Crypto
( getHash, randomString )
where
import IO
import IOExts
import System.Random
--------------------------------------------------------------------------
-- Operations for hashing.
--- Default hashing function.
--- @param toHash - string which should be hashed
--- @return the hashSum of this str
getHash :: String -> IO String
getHash = getHashWith "md5sum"
--getHash = getHashWith "sha1sum"
--- Hashes a string with an explicit Unix hash command.
--- @param hashcmd - Unix command for hasing
--- @param toHash - string which should be hashed
--- @return the hashed string
getHashWith :: String -> String -> IO String
getHashWith hashcmd toHash = do
(sin, sout, _) <- execCmd hashcmd
hPutStrLn sin toHash
hClose sin
result <- hGetLine sout
return (head (words result))
--- Returns a random string (a hexadecimal string) of a particular length.
--- @param length - length of the desired string
--- @return the random string
randomString :: Int -> IO String
randomString n = do
seed <- getRandomSeed
ranString <- getHash (show (nextInt seed !! 3))
return (take n ranString)
--------------------------------------------------------------------------
......@@ -5,7 +5,7 @@
module Main where
import HTML.Base
import WUI
import HTML.WUI
import Config.ControllerMapping
import Config.RoutesData
......@@ -13,20 +13,18 @@ import System.Routes
import System.Processes
import System.Spicey
dispatcher :: IO HtmlForm
dispatcher :: IO HtmlPage
dispatcher = do
-- get url
(url,ctrlparams) <- getControllerURL
controller <- nextControllerRefInProcessOrForUrl url >>=
maybe (displayError "Illegal URL!")
getController
maybe displayUrlError getController
form <- getForm controller
page <- getPage controller
saveLastUrl (url ++ concatMap ("/"++) ctrlparams)
return form
return page
--- Main function: call the dispatcher
main :: IO HtmlForm
main :: IO HtmlPage
main = dispatcher
# Generic Makefile for Spicey applications
# Definition of the root of the Curry system to be used:
SYSTEM=XXXCURRYHOMEXXX
# Curry bin directory to be used:
export CURRYBIN=$(SYSTEM)/bin
CURRYOPTIONS=:set -time
# Target directory where the compiled cgi programs, style sheets, etc
# should be stored, e.g.: $(HOME)/public_html
WEBSERVERDIR = $(error "Define variable WEBSERVERDIR!")
# Definition of the Curry installation bin directory to be used:
export CURRYBIN=XXXCURRYBINXXX
# Executable of the Curry Package Manager CPM:
CPM := $(CURRYBIN)/cypm
# Executable of the curry2cgi:
CURRY2CGI := $(shell which curry2cgi)
# The root directory of the sources of the Spicey application:
SRCDIR := $(CURDIR)/src
# The load path for the Spicey application:
export CURRYPATH := $(SRCDIR):$(SRCDIR)/Model
# Executable of CPNSD:
CPNSD := $(shell which curry-cpnsd)
# Executable of the CGI registry and submission form:
CURRYCGI := $(shell which curry-cgi)
# Executable of the makecgi:
MAKECGI := $(shell which curry-makecgi)
############################################################################
.PHONY: all
......@@ -39,15 +38,9 @@ install:
# check presence of tools required for deployment and install them:
.PHONY: checkdeploy
checkdeploy:
@if [ ! -x "$(CPNSD)" ] ; then \
echo "Installing required executable 'curry-cpnsd'..." ; \
$(CPM) install cpns ; fi
@if [ ! -x "$(CURRYCGI)" ] ; then \
echo "Installing required executable 'curry-cgi'..." ; \
$(CPM) install html-cgi ; fi
@if [ ! -x "$(MAKECGI)" ] ; then \
echo "Installing required executable 'curry-makecgi'..." ; \
$(CPM) install html ; fi
@if [ ! -x "$(CURRY2CGI)" ] ; then \
echo "Installing required executable 'curry2cgi'..." ; \
$(CPM) install html2 ; fi
# Compile the generated Spicey application:
.PHONY: compile
......@@ -71,20 +64,26 @@ run:
.PHONY: deploy
deploy: checkdeploy
mkdir -p $(WEBSERVERDIR)
$(CPM) exec $(MAKECGI) -standalone -m main -o $(WEBSERVERDIR)/spicey.cgi Main.curry
$(MAKE) $(WEBSERVERDIR)/spicey.cgi
# copy other files (style sheets, images,...)
cp -r public/* $(WEBSERVERDIR)
mkdir -p $(WEBSERVERDIR)/data # create private data dir
cp -p data/htaccess $(WEBSERVERDIR)/data/.htaccess # and make it private
chmod -R go+rX $(WEBSERVERDIR)
# recreate directory for storing local session data:
/bin/rm -rf $(WEBSERVERDIR)/data
mkdir -p $(WEBSERVERDIR)/data
chmod 700 $(WEBSERVERDIR)/data
$(WEBSERVERDIR)/spicey.cgi: src/*.curry src/*/*.curry
$(CPM) exec $(CURRY2CGI) --system="$(SYSTEM)" \
-i Controller.SpiceySystem XXXICONTROLLERXXX \
-o $@ Main.curry
# clean up generated the package directory
.PHONY: clean
clean:
$(CPM) clean
# clean everything, including the deployed files (be sure to save the
# database files first!)
# clean everything, including the deployed files
.PHONY: cleanall
cleanall: clean
/bin/rm -rf $(WEBSERVERDIR)
/bin/rm -f $(WEBSERVERDIR)/spicey.cgi*
......@@ -8,17 +8,17 @@ module System.Processes
, nextControllerRefInProcessOrForUrl
) where
import Global
import Maybe
import ReadShowTerm
import Control.AllSolutions ( getOneValue )
import Global
import HTML.Base
import HTML.Session
import Config.RoutesData
import Config.UserProcesses
import System.Routes
import System.Session
--------------------------------------------------------------------------
-- A operations on the datatype for process systems.
......@@ -47,7 +47,7 @@ currentProcess = global emptySessionStore Temporary
--- Returns the process state stored in the user session.
getCurrentProcess :: IO (Maybe _)
getCurrentProcess = do
curProc <- getSessionData currentProcess
curProc <- getSessionMaybeData currentProcess
case curProc of
Just sids -> return $ Just (readQTerm sids)
Nothing -> return Nothing
......@@ -55,12 +55,12 @@ getCurrentProcess = do
--- Is the current user session in a process interaction?
isInProcess :: IO Bool
isInProcess =
getSessionData currentProcess >>= return . maybe False (const True)
getSessionMaybeData currentProcess >>= return . maybe False (const True)
--- Saves the state of a process, i.e., a node in the process graph,
--- in the user session.
saveCurrentProcess :: _ -> IO ()
saveCurrentProcess sid = putSessionData (showQTerm sid) currentProcess
saveCurrentProcess sid = putSessionData currentProcess (showQTerm sid)
--- Deletes the process in the user session.
removeCurrentProcess :: IO ()
......
--------------------------------------------------------------------------
--- This module implements the management of sessions.
--- In particular, it defines a cookie that must be sent to the client
--- in order to enable the handling of sessions.
--- Based on session, this module defines also a session store
--- that can be used by various parts of the application in order
--- to hold some session-specific data.
--------------------------------------------------------------------------
module System.Session (
sessionCookie,
SessionStore, emptySessionStore,
getSessionData, putSessionData, removeSessionData
) where
import FilePath ( (</>) )
import Global
import List
import Time
import HTML.Base
import Config.Spicey ( spiceyDataDir )
import System.Crypto
--- The life span in minutes to store data in sessions.
--- Thus, older data is deleted by a clean up that is initiated
--- whenever new data is stored in a session.
sessionLifespan :: Int
sessionLifespan = 60
--- The name of the persistent global where the last session id is stored.
sessionCookieName :: String
sessionCookieName = "spiceySessionId"
--- This global value saves time and last session id.
lastId :: Global (Int, Int)
lastId = global (0, 0) (Persistent (spiceyDataDir </> sessionCookieName))
--- The abstract type to represent session identifiers.
data SessionId = SessionId String
deriving Eq
getId :: SessionId -> String
getId (SessionId i) = i
--- Creates a new unused session id.
getUnusedId :: IO SessionId
getUnusedId = do
(ltime,lsid) <- readGlobal lastId
clockTime <- getClockTime
if clockTimeToInt clockTime /= ltime
then writeGlobal lastId (clockTimeToInt clockTime, 0)
else writeGlobal lastId (clockTimeToInt clockTime, lsid+1)
rans <- randomString 30
return (SessionId (show (clockTimeToInt clockTime) ++ show (lsid+1) ++ rans))
--- Gets the id of the current user session.
--- If this is a new session, a new id is created and returned.
getSessionId :: IO SessionId
getSessionId = do
cookies <- getCookies
case (lookup sessionCookieName cookies) of
Just sessionCookieValue -> return (SessionId sessionCookieValue)
Nothing -> getUnusedId
--- Creates a cookie to hold the current session id.
--- This cookie should be sent to the client together with every form.
sessionCookie :: IO FormParam
sessionCookie = do
sessionId <- getSessionId
clockTime <- getClockTime
return (FormCookie sessionCookieName (getId (sessionId))
[CookiePath "/",
CookieExpire (addMinutes sessionLifespan clockTime)])
----------------------------------------------------------------------------
-- Implementation of session stores.
--- The type of a session store that holds particular data used in a session.
--- A session store consists of list of data items for each session in the
--- system together with the clock time of the last access.
--- The clock time is used to remove old data in the store.
data SessionStore a = SStore [(SessionId, Int, a)]
--- An initial value for the empty session store.
emptySessionStore :: SessionStore _
emptySessionStore = SStore []
--- Retrieves data for the current user session stored in a session store.
getSessionData :: Global (SessionStore a) -> IO (Maybe a)
getSessionData sessionData = do
sid <- getSessionId
SStore sdata <- readGlobal sessionData
return (findInSession sid sdata)
where
findInSession si ((id, _, storedData):rest) =
if getId id == getId si
then Just storedData
else findInSession si rest
findInSession _ [] = Nothing
--- Stores data related to the current user session in a session store.
putSessionData :: a -> Global (SessionStore a) -> IO ()
putSessionData newData sessionData = do
sid <- getSessionId
SStore sdata <- readGlobal sessionData
currentTime <- getClockTime
case findIndex (\ (id, _, _) -> id == sid) sdata of
Just i ->
writeGlobal sessionData
(SStore (replace (sid, clockTimeToInt currentTime, newData) i
(cleanup currentTime sdata)))
Nothing ->
writeGlobal sessionData
(SStore ((sid, clockTimeToInt currentTime, newData)
: cleanup currentTime sdata))
--- Removes data related to the current user session from a session store.
removeSessionData :: Global (SessionStore a) -> IO ()
removeSessionData sessionData = do
sid <- getSessionId
SStore sdata <- readGlobal sessionData
currentTime <- getClockTime
writeGlobal sessionData
(SStore (filter (\ (id, _, _) -> id /= sid)
(cleanup currentTime sdata)))
-- expects that clockTimeToInt converts time into ascending integers!
-- we should write our own conversion-function
cleanup :: ClockTime -> [(SessionId, Int, a)] -> [(SessionId, Int, a)]
cleanup currentTime sessionData =
filter (\ (_, time, _) ->
time > clockTimeToInt (addMinutes (0-sessionLifespan) currentTime))
sessionData
--------------------------------------------------------------------------
......@@ -14,12 +14,10 @@ module System.SessionInfo (
getUserSessionInfo, updateUserSessionInfo
) where
import FilePath ( (</>) )
import Global
import HTML.Session
import Config.Spicey ( spiceyDataDir )
import System.Session
import Config.Storage
--------------------------------------------------------------------------
--- The data associated to a user session.
......@@ -44,17 +42,15 @@ setUserLoginOfSession login (SD _) = SD login
--- Definition of the session state to store the login name (as a string).
userSessionInfo :: Global (SessionStore UserSessionInfo)
userSessionInfo =
global emptySessionStore (Persistent (spiceyDataDir </> "userSessionInfo"))
global emptySessionStore (Persistent (inDataDir "userSessionInfo"))
--- Gets the data of the current user session.
getUserSessionInfo :: IO UserSessionInfo
getUserSessionInfo =
getSessionData userSessionInfo >>= return . maybe emptySessionInfo id
getSessionData userSessionInfo emptySessionInfo
--- Updates the data of the current user session.
updateUserSessionInfo :: (UserSessionInfo -> UserSessionInfo) -> IO ()
updateUserSessionInfo upd = do
sd <- getUserSessionInfo
putSessionData (upd sd) userSessionInfo
updateUserSessionInfo = updateSessionData userSessionInfo emptySessionInfo
--------------------------------------------------------------------------
......@@ -4,17 +4,14 @@
--------------------------------------------------------------------------
module System.Spicey (
module System,
module HTML.Base,
module ReadNumeric,
Controller, EntityController(..), applyControllerOn,
nextController, nextControllerForData,
confirmDeletionPage,
transactionController,
getControllerURL,getControllerParams, showControllerURL,
getForm, wDateType, wBoolean, wUncheckMaybe, wFloat,
getPage, wDateType, wBoolean, wUncheckMaybe, wFloat,
displayError, displayUrlError, cancelOperation,
renderWuiForm, renderLabels,
renderWUI, renderLabels,
nextInProcessOr,
stringToHtml, maybeStringToHtml,
intToHtml,maybeIntToHtml, floatToHtml, maybeFloatToHtml,
......@@ -25,26 +22,24 @@ module System.Spicey (
saveLastUrl, getLastUrl, getLastUrls
) where
import Char (isSpace,isDigit)
import Char ( isSpace, isDigit )
import Global
import ReadNumeric
import ReadShowTerm(readsQTerm)