happs-tutorial 0.4.5 → 0.5.0
raw patch · 35 files changed
+932/−686 lines, 35 files
Files
- happs-tutorial.cabal +3/−16
- src/AppStateSetBased.hs +0/−242
- src/Controller.hs +4/−3
- src/ControllerGetActions.hs +3/−1
- src/ControllerMisc.hs +6/−41
- src/ControllerPostActions.hs +2/−43
- src/ControllerStressTests.hs +2/−1
- src/FromDataInstances.hs +1/−1
- src/Main.hs +2/−1
- src/Misc.hs +0/−8
- src/SerializeableJobs.hs +0/−38
- src/SerializeableSessions.hs +0/−29
- src/SerializeableUserInfos.hs +0/−56
- src/SerializeableUsers.hs +0/−71
- src/StateStuff.hs +0/−30
- src/StateVersions/AppState1.hs +390/−0
- src/View.hs +3/−3
- templates/cookies.st +45/−0
- templates/editconsultantprofile.st +1/−1
- templates/feedback.st +64/−0
- templates/foreignchars.st +3/−1
- templates/ghciflounderingaskdatastore.st +2/−2
- templates/home.st +30/−30
- templates/introductiontomacid.st +1/−1
- templates/maciddatasafety.st +1/−1
- templates/macidlimits.st +60/−0
- templates/macidmigration.st +221/−0
- templates/macidstresstest.st +12/−37
- templates/macidupdatesandqueries.st +16/−10
- templates/mainfunction.st +40/−16
- templates/menubar.st +1/−1
- templates/menubarmenu.st +3/−1
- templates/missinghappsdocumentation.st +1/−1
- templates/thanks.st +13/−0
- templates/toc.st +2/−0
happs-tutorial.cabal view
@@ -1,23 +1,15 @@ Name: happs-tutorial-Version: 0.4.5+Version: 0.5.0 Synopsis: A HAppS Tutorial that is is own demo Description: A nice way to learn how to build web sites with HAppS -- License: BSD3 License-file: LICENSE-Author: Thomas Hartman---+Author: Thomas Hartman, Eelco Lempsink Maintainer: thomashartman1 at gmail dot com Copyright: 2008 Thomas Hartman --- Stability: Experimental Category: Web Build-type: Simple@@ -38,7 +30,7 @@ hs-source-dirs: src Other-Modules:- AppStateSetBased+ StateVersions.AppState1 ControllerBasic ControllerGetActions Controller@@ -46,13 +38,8 @@ ControllerPostActions FromDataInstances Misc- SerializeableSessions- SerializeableUsers- SerializeableJobs- SerializeableUserInfos MiscMap ControllerStressTests- StateStuff View Build-Depends: base>=3.0.3.0, HStringTemplate, HStringTemplateHelpers, mtl, bytestring, HAppS-Server, HAppS-Data, HAppS-State,
− src/AppStateSetBased.hs
@@ -1,242 +0,0 @@-{-# LANGUAGE TemplateHaskell, FlexibleInstances, FlexibleContexts, - MultiParamTypeClasses, DeriveDataTypeable, TypeFamilies,- TypeSynonymInstances, ScopedTypeVariables #-}--module AppStateSetBased where --import qualified MiscMap as M--- import qualified Data.Set as S-import Data.Maybe -import Data.List--import Control.Monad (liftM)-import Control.Monad.Reader (ask)-import Control.Monad.State (modify,put,get,gets)-import Data.Generics-import HAppS.State-import qualified Data.ByteString.Char8 as B-import SerializeableSessions-import SerializeableUsers-import SerializeableUserInfos (UserProfile (..), UserInfos (..), add_job, del_job, set_userprofile, set_job )-import SerializeableJobs (Jobs (..), Job (..), JobName(..) )-import Misc---import Data.Graph.Inductive---- Think of appdatastore as the database in a traditional web app.--- Data there gets stored permanently--- Data in appsessions is stored permanently too, but we don't care as much about its persistence,--- it's just to keep track of who is logged in at a point in time.--- appsessions field could be less complicated, just have M.Map Int SessionData--- don't really see the advantage of declaring a wrapper over map.---- to do: appdatastore should be :: Map UserName User--- User :: Password ConsultantProfile Jobs--- Jobs :: Map JobName Job--- Job :: JobBudget JobBlurb--- thereafter.......... ---data AppState = AppState {- appsessions :: Sessions SessionData, - appdatastore :: Users-} deriving (Show,Read,Typeable,Data) --instance Version AppState--$(deriveSerialize ''AppState) --instance Component AppState where - type Dependencies AppState = End - initialValue = AppState { appsessions = (Sessions M.empty),- appdatastore = Users M.empty }----- myupdate field newval record = record { field = newval }--askDatastore :: Query AppState Users-askDatastore = do- (s :: AppState ) <- ask- return . appdatastore $ s---askSessions :: Query AppState (Sessions SessionData)-askSessions = return . appsessions =<< ask--setUserProfile :: UserName -> UserProfile -> Update AppState ()-setUserProfile uname newprofile = modUserInfos uname $ set_userprofile newprofile---- addJob :: UserName -> JobName -> Job -> Update AppState (Either String ())-addJob uname jn j = modUserInfosM uname $ add_job jn j----- delJob :: UserName -> JobName -> Update AppState (Either String ())-delJob uname jn = modUserInfosM uname $ del_job jn ---setJob uname jn j = modUserInfosM uname $ set_job j jn--modUserInfosM :: UserName -> (UserInfos -> Either String UserInfos) -> Update AppState (Either String ())-modUserInfosM un mf = do- (AppState sessions (Users users)) <- get- case (M.adjustMM un mf users) of- Left err -> return . Left $ err- Right um -> do put $ AppState sessions (Users um)- return . Right $ ()--modUserInfos :: UserName -> ( UserInfos -> UserInfos ) -> Update AppState ()-modUserInfos un f = do - (AppState sessions (Users users)) <- get- case (M.adjustM un f users) of- Left err -> fail err- Right um -> put $ AppState sessions (Users um)--------modify (\s -> (AppState (appsessions s) (f $ appdatastore s))) --modSessions :: (Sessions SessionData -> Sessions SessionData) -> Update AppState ()-modSessions f = modify (\s -> (AppState (f $ appsessions s) (appdatastore s))) ---- yecchh.--- the way setmap is being used seems kludgy--- should probably either be using HAppS IndexSet, or a Map instead of Set.--isUser :: UserName -> Query AppState Bool-isUser name = do- (Users us ) <- return . appdatastore =<< ask- if (isJust $ M.lookup name us)- then return True- else return False--{--addUser :: UserName -> B.ByteString -> Update AppState ()-addUser un@(UserName name) hashedpass = do- AppState s us <- get- case ( add_user un hashedpass us :: Either String Users) of- Left err -> fail $ "addUser, name: " ++ (B.unpack name)- Right newus -> put $ AppState s newus--}--addUser :: UserName -> B.ByteString -> Update AppState (Either String ())-addUser un@(UserName name) hashedpass = do- AppState s us <- get- case ( add_user un hashedpass us :: Either String Users) of- Left err -> if isInfixOf "duplicate key" err- then return . Left $ "username taken"- else return . Left $ "error: " ++ err- Right newus -> do put $ AppState s newus- return $ Right ()---changePassword :: UserName -> B.ByteString -> B.ByteString -> Update AppState ()-changePassword un oldpass newpass = do- AppState s us <- get- case ( set_user_password un (B.pack hashedoldpass) (B.pack hashednewpass) us :: Either String Users) of- Left err -> fail $ "changePassword"- Right newus -> put $ AppState s us- where hashedoldpass = scramblepass (B.unpack oldpass)- hashednewpass = scramblepass (B.unpack newpass)----- was getUser-getUserInfos :: UserName -> Query AppState (Maybe UserInfos)-getUserInfos u = ( return . M.lookup u . users ) =<< askDatastore--getUserProfile u = do- mbUI <- getUserInfos u- case mbUI of - Nothing -> return Nothing- Just (UserInfos pass profile jobs) -> return $ Just profile---- list all jobs along with the username who posted each job--- listAllJobs :: Query AppState (M.Map UserName Jobs)-listAllJobs = return .- concat . M.elems- . M.mapWithKey g - . M.map (unjobs . jobs) . users - =<< askDatastore - where g uname jobs = map ( \(jobname,job) -> (jobname,job,uname) ) . M.toList $ jobs----- lookupUser f users = find f . S.toList $ users-listUsers :: Query AppState [UserName]-listUsers = ( return . M.keys . users ) =<< askDatastore--listUsersWantingDevelopers = (return . M.keys . M.filter wantingDeveloper . users) =<< askDatastore- where wantingDeveloper uis = not . M.null . unjobs . jobs $ uis----newSession :: SessionData -> Update AppState SessionKey-newSession u = do - AppState (Sessions ss) us <- get- (newss,k) <- inssess u ss - -- check that random session key is really unique- --modSessions $ Sessions . (M.insert key u) . unsession- put $ AppState (Sessions newss) us- return k- where- inssess u sessions = do- key <- getRandom- case (M.insertUqM key u sessions) of- Nothing -> inssess u sessions- Just m -> return (m,key)--delSession :: SessionKey -> Update AppState ()-delSession sk = modSessions $ Sessions . (M.delete sk) . unsession--getSession::SessionKey -> Query AppState (Maybe SessionData)-getSession key = liftM (M.lookup key . unsession) askSessions--numSessions :: Query AppState Int-numSessions = liftM (M.size . unsession) askSessions---- initializeDummyData dd = modUsers (const dd)-initializeDummyData dd = do- AppState ss (Users us) <- get- if M.null us - then fail "initializeDummyData, users not empty"- else put $ AppState ss (Users dd)---- bad performance for large unumbers of users (>1000, with 200 jobs/dummy user)--- maybe macid doesn't like serializing large quantities of data at once-addDummyData dd = do- AppState ss (Users us) <- get- put $ AppState ss (Users (M.union us dd) )--addDummyUser (un,uis) = do- AppState ss (Users us) <- get- us' <- M.insertUqM un uis us- put $ AppState ss (Users us' )----- define types which are upper case of methods below, eg AddUser, AuthUser...--- these types work with HApppS query/update machinery--- in ghci, try :i AddUser-$(mkMethods ''AppState- ['askDatastore- , 'getUserInfos- , 'getUserProfile- , 'addUser- , 'changePassword - , 'setUserProfile- -- , 'updateUser- , 'isUser- , 'listUsers - , 'listAllJobs- , 'getSession- , 'newSession- , 'delSession- , 'numSessions- , 'initializeDummyData- , 'addDummyData- , 'addDummyUser- , 'addJob- , 'delJob- , 'setJob ]- )---
src/Controller.hs view
@@ -9,6 +9,7 @@ import qualified Data.Set as S import Data.Maybe import HAppS.Server+import HAppS.State import Text.StringTemplate import System.FilePath import System.Directory@@ -16,7 +17,7 @@ -- state-import StateStuff+import StateVersions.AppState1 import View import ControllerBasic@@ -60,8 +61,8 @@ , dir "logout" [ (logoutPage rglobs)] , dir "changepassword" [ methodSP POST $ changePasswordSP rglobs ] - , dir "editconsultantprofile" [ methodSP GET $ viewEditConsultantProfile rglobs ] - , dir "editconsultantprofile" [ methodSP POST $ processformEditConsultantProfile rglobs ]+ , dir "editconsultantprofile" [ methodSP GET $ viewEditConsultantProfile rglobs + , methodSP POST $ processformEditConsultantProfile rglobs ] , dir "editjob" [ methodSP GET $ viewEditJobWD rglobs ] , dir "deletejob" [ methodSP GET $ deleteJobWD rglobs ]
src/ControllerGetActions.hs view
@@ -3,12 +3,14 @@ import Control.Monad import Control.Monad.Reader import HAppS.Server+import HAppS.State+ import Data.List import HAppS.Helpers.HtmlOutput import qualified Data.ByteString.Char8 as B import Text.StringTemplate.Helpers import ControllerMisc-import StateStuff+import StateVersions.AppState1 import View import FromDataInstances
src/ControllerMisc.hs view
@@ -5,32 +5,22 @@ import Misc import View-import StateStuff+import StateVersions.AppState1 import Text.StringTemplate-import SerializeableJobs-import SerializeableUsers++import HAppS.State import Control.Monad+import Control.Monad.Reader import Control.Monad.Error import HAppS.Helpers import qualified Data.ByteString.Char8 as B import Text.StringTemplate.Helpers--- import SerializeableUsers (User(..))+-- (User(..)) -- The final value is HtmlString so that the HAppS machinery does the right thing with toMessage. -- If the final value was left as a String, the page would display as text, not html. --tutlayoutReq :: Request -> [([Char], String)] -> String -> WebT IO Response tutlayoutU rglobs attrs tmpl = ( toResponse . HtmlString . tutlayout rglobs attrs ) tmpl -{--getmbLoggedInUser :: Request -> IO (Maybe UserName)-getmbLoggedInUser rq = do- mbSd <- maybe ( return Nothing )- ( query . GetSession )- ( getMbSessKey rq )- return $ do- sd <- mbSd- return . sesUser $ sd- where --} getmbSession :: Request -> IO (Maybe SessionData) getmbSession rq = maybe ( return Nothing ) ( query . GetSession ) ( getMbSessKey rq ) @@ -62,29 +52,8 @@ return (uN,loggedInUserInfos) --- getMbSessKey rq = readData (readCookieValue "sid") rq getMbSessKey :: Request -> Maybe SessionKey-getMbSessKey rq = readData (readCookieValue "sid") rq---- updateUserSp :: RenderGlobals -> UserName -> (RenderGlobals -> ServerPartT IO Response) -> Request -> WebT IO Response--- take the current user and replace him with newuser. --- and what to do in the sp after the update.--- ugh! rewrite!--- updateUserSp rglobs newuser withrgSp rq = do-{--updateUserSp rglobs action withrgSp rq = do- case mbUser rglobs of- Nothing -> return $ tutlayoutU rglobs [("errormsg", "updateUserSp: no user")] "errortemplate"- Just uname -> do- mbUis <- query $ GetUser uname- case mbUis of- Nothing -> return $ tutlayoutU rglobs [("errormsg", "updateUserSp: no user infos")] "errortemplate"- Just uis -> - updateuser olduser newuser- let newrglobs = RenderGlobals (templates rglobs) (Just newuser)- unServerPartT ( withrgSp newrglobs ) rq --}-+getMbSessKey rq = runReaderT (readCookieValue "sid") (rqInputs rq,rqCookies rq) updateuser olduser newuser = do --update (UpdateUser olduser newuser)@@ -100,10 +69,6 @@ getTemplates :: IO (STGroup String) getTemplates = directoryGroupSafer "templates" ----very, VERY hackish way of reading a checkbox-readcheckbox :: String -> RqData Bool-readcheckbox checkboxname = return . not . (=="noval") =<< look checkboxname `mplus` return "noval" logoutPage :: RenderGlobals -> ServerPartT IO Response logoutPage rglobs@(RenderGlobals origRq ts mbU) =
src/ControllerPostActions.hs view
@@ -10,9 +10,10 @@ import System.FilePath (takeFileName) import HAppS.Server+import HAppS.State import HAppS.Helpers -import StateStuff+import StateVersions.AppState1 import View import Misc import ControllerMisc@@ -49,34 +50,8 @@ ] where errW msg = return $ tutlayoutU rglobs [("loginerrormsg",msg)] "home" -{---- check if a username and password is valid. If it is, return the user as successful monadic value--- otherwise fail monadically-authUser :: Monad m => UserName -> B.ByteString -> WebT IO (m UserInfos)-authUser name pass = do- mbUser <- query (GetUserInfos name)- case mbUser of- Nothing -> return . fail $ "login failed"- (Just u) -> do- p <- return . password $ u- -- scramblepass works with lazy bytestrings, maybe that's by design. meh, leave it for now- if p == scramblepass pass - then return . return $ u- else return . fail $ "login failed"--} --- to do: make it so keeps your current page if you login/logout--- probably modify RenderGlobals to keep track of that bit of state-{--startsess :: RenderGlobals -> UserName -> WebT IO Response-startsess (RenderGlobals ts _) user = do- key <- update $ NewSession (SessionData user)- addCookie (3600) (mkCookie "sid" (show key))- let newRGlobs = RenderGlobals ts (Just user) - (return . tutlayoutU newRGlobs [] ) "home"--} - -- check if a username and password is valid. If it is, return the user as successful monadic value -- otherwise fail monadically authUser' :: (UserName -> WebT IO (Maybe String) ) -> UserName -> B.ByteString -> WebT IO Bool@@ -87,22 +62,6 @@ return $ maybe False ( == scramblepass (B.unpack pass) ) mbP -{--changePasswordSP rglobs = withData $ \(ChangeUserInfo oldpass newpass1 newpass2) -> [ ServerPartT $ \rq -> do- if newpass1 == newpass2 - then do mbL <- liftIO $ getmbLoggedInUser rq- maybe- (errW "Not logged in" rq)- (\u -> do mbUis <- query (GetUserInfos u)- case mbUis of- Nothing -> errW ("bad username: " ++ (B.unpack . unusername $ u)) rq - Just uis -> do update $ ChangePassword u oldpass newpass1- return $ tutlayoutU rglobs [] "accountsettings-changed" )- (mbL :: Maybe UserName)- else errW "new passwords did not match" rq- ]- where errW msg rq = ( return . tutlayoutU rglobs [("errormsgAccountSettings", msg)] ) "changepassword" --} changePasswordSP rglobs = withData $ \(ChangeUserInfo oldpass newpass1 newpass2) -> [ ServerPartT $ \rq -> do etRes <- runErrorT $ getLoggedInUserInfos rglobs case etRes of
src/ControllerStressTests.hs view
@@ -2,6 +2,7 @@ module ControllerStressTests where import HAppS.Server+import HAppS.State import Data.List import Misc import qualified MiscMap as M @@ -11,7 +12,7 @@ import Text.ParserCombinators.Parsec import qualified Data.ByteString.Char8 as B -import StateStuff+import StateVersions.AppState1 import ControllerMisc import System.IO import View
src/FromDataInstances.hs view
@@ -1,7 +1,7 @@ module FromDataInstances where import HAppS.Server-import StateStuff+import StateVersions.AppState1 import Control.Monad import Control.Monad.Reader import Safe
src/Main.hs view
@@ -3,11 +3,12 @@ module Main where import HAppS.Server+import HAppS.State import Controller import Misc import System.Environment import Control.Concurrent-import StateStuff+import StateVersions.AppState1 import System.Time import HAppS.Server.Helpers
src/Misc.hs view
@@ -14,10 +14,7 @@ import Safe (readMay) import System.Time import Data.Char (isAlphaNum)---- import Text.StringTemplate import Data.Monoid-import Control.Monad.Reader import Data.Char (toLower) newtype HtmlString = HtmlString String@@ -34,11 +31,6 @@ else mempty pp[] = ( PP.render . vcat . map text . map show )-------------------- reading data -----------------readData :: RqData a -> Request -> Maybe a-readData rqDataReader rq = runReaderT rqDataReader $ (rqInputs rq,rqCookies rq) pathPartsSp pps f = ServerPartT $ \rq -> if rqPaths rq == pps
− src/SerializeableJobs.hs
@@ -1,38 +0,0 @@-{-# LANGUAGE TemplateHaskell, DeriveDataTypeable, NoMonomorphismRestriction, ScopedTypeVariables #-}-module SerializeableJobs where--import HAppS.State-import Data.Generics-import qualified MiscMap as M-import qualified Data.ByteString.Char8 as B---- JobName is like a primary key, Job is like the other fields, if we were in rdbms land--t = let f (JobName (j :: B.ByteString)) = B.unpack j in f . JobName $ (B.pack "job")--- It might be a bit of overkill to declare things with this level of specificity--- but I think it'll make the type signatures easier to read later on.-newtype JobName = JobName { unjobname :: B.ByteString }- deriving (Show,Read,Ord, Eq, Typeable,Data)--instance Version JobName-$(deriveSerialize ''JobName) --data Job = Job {jobbudget :: B.ByteString -- we allow jobs with unspecified budgets- , jobblurb :: B.ByteString}- deriving (Show,Read,Ord, Eq, Typeable,Data)-instance Version Job-$(deriveSerialize ''Job) ---- because Haskell records are a kludge, define mutator functions. bleh. oh well.--- mod_field takes a mutator function--- set_field takes a value-set_jobbudget = mod_jobbudget . const-mod_jobbudget f (Job bud blu) = Job (f bud) blu--set_jobblurb = mod_jobblurb . const -mod_jobblurb f (Job bud blu) = Job bud (f blu)--newtype Jobs = Jobs { unjobs :: M.Map JobName Job }- deriving (Show,Read,Ord, Eq, Typeable,Data)-instance Version Jobs-$(deriveSerialize ''Jobs)
− src/SerializeableSessions.hs
@@ -1,29 +0,0 @@-{-# LANGUAGE TemplateHaskell, DeriveDataTypeable #-}--module SerializeableSessions where--import Data.Generics --for deriving Typeable-import HAppS.State -- for deriving Serialize--import SerializeableUsers (UserName (..))--import qualified Data.Map as M-----type SessionKey = Integer -newtype SessionData = SessionData { - sesUser :: UserName-} deriving (Read,Show,Eq,Typeable,Data,Ord)-instance Version SessionData -$(deriveSerialize ''SessionData)-----data Sessions a = Sessions {unsession::M.Map SessionKey a} - deriving (Read,Show,Eq,Typeable,Data)-instance Version (Sessions a)-$(deriveSerialize ''Sessions)-
− src/SerializeableUserInfos.hs
@@ -1,56 +0,0 @@-{-# LANGUAGE TemplateHaskell, DeriveDataTypeable, NoMonomorphismRestriction #-}-module SerializeableUserInfos where-import HAppS.State-import Data.Generics--import qualified MiscMap as M-import qualified Data.ByteString.Char8 as B-import SerializeableJobs--data UserProfile = UserProfile {- --billing_rate :: String -- eg "" (blank is ok), "$30-$50/hour", "40-50 Euro/hour", "it depends on the project", etc.- contact :: B.ByteString -- eg, "thomashartman1 at gmail, 917 915 9941"- -- tell something about yourself. Edited via a text area. should replace newlines with <br> when displayed.- , blurb :: B.ByteString- , consultant :: Bool -- this is what actually determines whether the profile will list as a consultant or not- , avatar :: B.ByteString -- path to an image file-} deriving (Show,Read,Ord, Eq, Typeable,Data)-instance Version UserProfile-$(deriveSerialize ''UserProfile) ----mutators-set_contact = mod_contact . const-mod_contact f (UserProfile contact blurb consultant avatar) = UserProfile (f contact) blurb consultant avatar--set_blurb = mod_blurb . const-mod_blurb f (UserProfile contact blurb consultant avatar) = UserProfile contact (f blurb) consultant avatar--set_consultant = mod_consultant . const-mod_consultant f (UserProfile contact blurb consultant avatar) = UserProfile contact blurb (f consultant) avatar--data UserInfos = UserInfos { - password :: B.ByteString- , userprofile :: UserProfile- , jobs :: Jobs-} deriving (Show,Read,Ord, Eq, Typeable,Data)-instance Version UserInfos-$(deriveSerialize ''UserInfos) ----- as a security measure, require that oldpass agrees with real old pass-set_password oldpass newpass (UserInfos pass up jobs) | pass == oldpass = return $ UserInfos newpass up jobs- | otherwise = fail $ "bad old password: " ---- mod_password f (UserInfos pass up jobs) = UserInfos (f pass) up jobs-set_userprofile = mod_userprofile . const-mod_userprofile f (UserInfos pass up jobs) = UserInfos pass (f up) jobs--- set_jobs = mod_jobs . const-add_job jobname job = mod_jobs $ M.insertUqM jobname job-del_job jobname = mod_jobs $ M.deleteM jobname--set_job = mod_job . const-mod_job f jobname = mod_jobs $ M.adjustM jobname f -mod_jobs mf (UserInfos pass up (Jobs jobs) ) = either (fail . ("mod_jobs: " ++) )- (\js -> return $ UserInfos pass up (Jobs js) )- (mf jobs)-
− src/SerializeableUsers.hs
@@ -1,71 +0,0 @@-{-# LANGUAGE TemplateHaskell, DeriveDataTypeable, NoMonomorphismRestriction #-}-module SerializeableUsers {- (- module SerializeableUserInfos,- Users (..), UserName -- , add_user_job- -) -} where-import HAppS.State-import Data.Generics-import qualified MiscMap as M-import qualified Data.Set as S-import qualified Data.ByteString.Char8 as B--import SerializeableUserInfos--import SerializeableJobs-import Misc---newtype UserName = UserName { unusername :: B.ByteString }- deriving (Show,Read,Ord, Eq, Typeable,Data)-instance Version UserName-$(deriveSerialize ''UserName)--data Users = Users { users :: M.Map UserName UserInfos }- deriving (Show,Read,Ord, Eq, Typeable,Data)-instance Version Users-$(deriveSerialize ''Users)---- can fail monadically if the username doesn't exist, or the job name is a duplicate-add_user_job un jn job = mod_userMM un $ add_job jn job----- adjust users, where the adjustment function can fail monadically--- mod_userMM :: (Monad m) => UserName -> (UserInfos -> Either [Char] UserInfos) -> Users -> m Users-mod_userMM username f (Users us) = either (fail . ("mod_userMM: " ++) )- (return . Users)- (M.adjustMM username f us)---- adjust users, where the adjustment function is presumed to be infallible,--- but can still fail monadically if the username is invalid-mod_userM username f (Users us) = return . Users =<< M.adjustM username f us--set_user_userprofile_contact username c = mod_userM username $ ( mod_userprofile . set_contact $ c )-set_user_userprofile_blurb username b = mod_userM username $ ( mod_userprofile . set_blurb $ b )-set_user_userprofile_consultant username isconsultant =- mod_userM username $ ( mod_userprofile . set_consultant $ isconsultant )---- fails monadically if oldpass doesn't match password in user profile, via set_password-set_user_password :: (Monad m) => UserName -> B.ByteString -> B.ByteString -> Users -> m Users-set_user_password username oldpass newpass = mod_userMM username $ set_password oldpass newpass---- set_user_userprofile username p = mod_userM username $ Right . set_userprofile p --add_user username hashedpass (Users us)- | B.null . unusername $ username = fail "blank username"- | B.null hashedpass = fail "error: blank password"- | not . isalphanum_S . B.unpack . unusername $ username- = fail $ "bad username, " ++ allowedCharactersSnip- | otherwise = either (fail . ("add_user: " ++))- (return . Users)- ( M.insertUqM username uis us )- where uis = UserInfos hashedpass (UserProfile (B.pack "") (B.pack "")- False (B.pack "") )- (Jobs $ M.empty)--del_user username uis (Users us) = either (fail . ("del_user: " ++))- (return . Users)- ( M.deleteM username us )---
− src/StateStuff.hs
@@ -1,30 +0,0 @@-module StateStuff (-- module HAppS.State-- -- If you substitute AppStateGraphBased for AppStateSetBased, - -- , move _local ot _local.bak (backup your serialized state)- -- , and restart app- -- , your datastore is now graph based- -- User nodes can connect to each other simply using mkEdge, or whatever else from the fgl.- -- Now you can clone facebook.- -- Try doing that with mysql! :)-- , module AppStateSetBased -- AppStateGraphBased -- -- , module SerializeableUsers- , module SerializeableSessions- , module SerializeableUserInfos- , module SerializeableJobs-{- , B.ByteString- , B.unpack - , B.pack -}- ) where-import HAppS.State-import qualified Data.ByteString.Char8 as B-import AppStateSetBased -- AppStateGraphBased -- -import SerializeableUsers-import SerializeableSessions-import SerializeableUsers-import SerializeableUserInfos-import SerializeableJobs
+ src/StateVersions/AppState1.hs view
@@ -0,0 +1,390 @@+{-# LANGUAGE TemplateHaskell, DeriveDataTypeable, NoMonomorphismRestriction, ScopedTypeVariables,+ TypeFamilies, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, TypeSynonymInstances #-}+module StateVersions.AppState1 {- (+ module SerializeableUserInfos,+ Users (..), UserName -- , add_user_job+ +) -} where+import HAppS.State+import Data.Generics+import Control.Monad (liftM)+import Control.Monad.Reader (ask)+import Control.Monad.State (modify,put,get,gets)+import Data.Maybe+import Data.List++import qualified MiscMap as M+import qualified Data.Set as S+import qualified Data.ByteString.Char8 as B++import Misc++t = let f (JobName (j :: B.ByteString)) = B.unpack j in f . JobName $ (B.pack "job")+-- It might be a bit of overkill to declare things with this level of specificity+-- but I think it'll make the type signatures easier to read later on.+newtype JobName = JobName { unjobname :: B.ByteString }+ deriving (Show,Read,Ord, Eq, Typeable,Data)++instance Version JobName+$(deriveSerialize ''JobName) ++data Job = Job {jobbudget :: B.ByteString -- we allow jobs with unspecified budgets+ , jobblurb :: B.ByteString}+ deriving (Show,Read,Ord, Eq, Typeable,Data)+instance Version Job+$(deriveSerialize ''Job) ++-- because Haskell records are a kludge, define mutator functions. bleh. oh well.+-- mod_field takes a mutator function+-- set_field takes a value+set_jobbudget = mod_jobbudget . const+mod_jobbudget f (Job bud blu) = Job (f bud) blu++set_jobblurb = mod_jobblurb . const +mod_jobblurb f (Job bud blu) = Job bud (f blu)++newtype Jobs = Jobs { unjobs :: M.Map JobName Job }+ deriving (Show,Read,Ord, Eq, Typeable,Data)+instance Version Jobs+$(deriveSerialize ''Jobs) ++--import SerializeableUserInfos++--import SerializeableJobs+++data UserProfile = UserProfile {+ --billing_rate :: String -- eg "" (blank is ok), "$30-$50/hour", "40-50 Euro/hour", "it depends on the project", etc.+ contact :: B.ByteString -- eg, "thomashartman1 at gmail, 917 915 9941"+ -- tell something about yourself. Edited via a text area. should replace newlines with <br> when displayed.+ , blurb :: B.ByteString+ , consultant :: Bool -- this is what actually determines whether the profile will list as a consultant or not+ , avatar :: B.ByteString -- path to an image file+} deriving (Show,Read,Ord, Eq, Typeable,Data)+instance Version UserProfile+$(deriveSerialize ''UserProfile) ++--mutators+set_contact = mod_contact . const+mod_contact f (UserProfile contact blurb consultant avatar) = UserProfile (f contact) blurb consultant avatar++set_blurb = mod_blurb . const+mod_blurb f (UserProfile contact blurb consultant avatar) = UserProfile contact (f blurb) consultant avatar++set_consultant = mod_consultant . const+mod_consultant f (UserProfile contact blurb consultant avatar) = UserProfile contact blurb (f consultant) avatar++data UserInfos = UserInfos { + password :: B.ByteString+ , userprofile :: UserProfile+ , jobs :: Jobs+} deriving (Show,Read,Ord, Eq, Typeable,Data)+instance Version UserInfos+$(deriveSerialize ''UserInfos) +++-- as a security measure, require that oldpass agrees with real old pass+set_password oldpass newpass (UserInfos pass up jobs) | pass == oldpass = return $ UserInfos newpass up jobs+ | otherwise = fail $ "bad old password: " ++-- mod_password f (UserInfos pass up jobs) = UserInfos (f pass) up jobs+set_userprofile = mod_userprofile . const+mod_userprofile f (UserInfos pass up jobs) = UserInfos pass (f up) jobs+-- set_jobs = mod_jobs . const+add_job jobname job = mod_jobs $ M.insertUqM jobname job+del_job jobname = mod_jobs $ M.deleteM jobname++set_job = mod_job . const+mod_job f jobname = mod_jobs $ M.adjustM jobname f +mod_jobs mf (UserInfos pass up (Jobs jobs) ) = either (fail . ("mod_jobs: " ++) )+ (\js -> return $ UserInfos pass up (Jobs js) )+ (mf jobs)++++newtype UserName = UserName { unusername :: B.ByteString }+ deriving (Show,Read,Ord, Eq, Typeable,Data)+instance Version UserName+$(deriveSerialize ''UserName)++data Users = Users { users :: M.Map UserName UserInfos }+ deriving (Show,Read,Ord, Eq, Typeable,Data)+instance Version Users+$(deriveSerialize ''Users)++-- can fail monadically if the username doesn't exist, or the job name is a duplicate+add_user_job un jn job = mod_userMM un $ add_job jn job+++-- adjust users, where the adjustment function can fail monadically+-- mod_userMM :: (Monad m) => UserName -> (UserInfos -> Either [Char] UserInfos) -> Users -> m Users+mod_userMM username f (Users us) = either (fail . ("mod_userMM: " ++) )+ (return . Users)+ (M.adjustMM username f us)++-- adjust users, where the adjustment function is presumed to be infallible,+-- but can still fail monadically if the username is invalid+mod_userM username f (Users us) = return . Users =<< M.adjustM username f us++set_user_userprofile_contact username c = mod_userM username $ ( mod_userprofile . set_contact $ c )+set_user_userprofile_blurb username b = mod_userM username $ ( mod_userprofile . set_blurb $ b )+set_user_userprofile_consultant username isconsultant =+ mod_userM username $ ( mod_userprofile . set_consultant $ isconsultant )++-- fails monadically if oldpass doesn't match password in user profile, via set_password+set_user_password :: (Monad m) => UserName -> B.ByteString -> B.ByteString -> Users -> m Users+set_user_password username oldpass newpass = mod_userMM username $ set_password oldpass newpass++-- set_user_userprofile username p = mod_userM username $ Right . set_userprofile p ++add_user username hashedpass (Users us)+ | B.null . unusername $ username = fail "blank username"+ | B.null hashedpass = fail "error: blank password"+ | not . isalphanum_S . B.unpack . unusername $ username+ = fail $ "bad username, " ++ allowedCharactersSnip+ | otherwise = either (fail . ("add_user: " ++))+ (return . Users)+ ( M.insertUqM username uis us )+ where uis = UserInfos hashedpass (UserProfile (B.pack "") (B.pack "")+ False (B.pack "") )+ (Jobs $ M.empty)++del_user username uis (Users us) = either (fail . ("del_user: " ++))+ (return . Users)+ ( M.deleteM username us )+++type SessionKey = Integer +newtype SessionData = SessionData { + sesUser :: UserName+} deriving (Read,Show,Eq,Typeable,Data,Ord)+instance Version SessionData +$(deriveSerialize ''SessionData)+++++data Sessions a = Sessions {unsession::M.Map SessionKey a} + deriving (Read,Show,Eq,Typeable,Data)+instance Version (Sessions a)+$(deriveSerialize ''Sessions)+++-- Think of appdatastore as the database in a traditional web app.+-- Data there gets stored permanently+-- Data in appsessions is stored permanently too, but we don't care as much about its persistence,+-- it's just to keep track of who is logged in at a point in time.+-- appsessions field could be less complicated, just have M.Map Int SessionData+-- don't really see the advantage of declaring a wrapper over map.++-- to do: appdatastore should be :: Map UserName User+-- User :: Password ConsultantProfile Jobs+-- Jobs :: Map JobName Job+-- Job :: JobBudget JobBlurb+-- thereafter.......... +++data AppState = AppState {+ appsessions :: Sessions SessionData, + appdatastore :: Users+} deriving (Show,Read,Typeable,Data) ++instance Version AppState++$(deriveSerialize ''AppState) ++instance Component AppState where + type Dependencies AppState = End + initialValue = AppState { appsessions = (Sessions M.empty),+ appdatastore = Users M.empty }+++-- myupdate field newval record = record { field = newval }++askDatastore :: Query AppState Users+askDatastore = do+ (s :: AppState ) <- ask+ return . appdatastore $ s+++askSessions :: Query AppState (Sessions SessionData)+askSessions = return . appsessions =<< ask++setUserProfile :: UserName -> UserProfile -> Update AppState ()+setUserProfile uname newprofile = modUserInfos uname $ set_userprofile newprofile++-- addJob :: UserName -> JobName -> Job -> Update AppState (Either String ())+addJob uname jn j = modUserInfosM uname $ add_job jn j+++-- delJob :: UserName -> JobName -> Update AppState (Either String ())+delJob uname jn = modUserInfosM uname $ del_job jn +++setJob uname jn j = modUserInfosM uname $ set_job j jn++modUserInfosM :: UserName -> (UserInfos -> Either String UserInfos) -> Update AppState (Either String ())+modUserInfosM un mf = do+ (AppState sessions (Users users)) <- get+ case (M.adjustMM un mf users) of+ Left err -> return . Left $ err+ Right um -> do put $ AppState sessions (Users um)+ return . Right $ ()++modUserInfos :: UserName -> ( UserInfos -> UserInfos ) -> Update AppState ()+modUserInfos un f = do + (AppState sessions (Users users)) <- get+ case (M.adjustM un f users) of+ Left err -> fail err+ Right um -> put $ AppState sessions (Users um)++++++--modify (\s -> (AppState (appsessions s) (f $ appdatastore s))) ++modSessions :: (Sessions SessionData -> Sessions SessionData) -> Update AppState ()+modSessions f = modify (\s -> (AppState (f $ appsessions s) (appdatastore s))) ++-- yecchh.+-- the way setmap is being used seems kludgy+-- should probably either be using HAppS IndexSet, or a Map instead of Set.++isUser :: UserName -> Query AppState Bool+isUser name = do+ (Users us ) <- return . appdatastore =<< ask+ if (isJust $ M.lookup name us)+ then return True+ else return False++{-+addUser :: UserName -> B.ByteString -> Update AppState ()+addUser un@(UserName name) hashedpass = do+ AppState s us <- get+ case ( add_user un hashedpass us :: Either String Users) of+ Left err -> fail $ "addUser, name: " ++ (B.unpack name)+ Right newus -> put $ AppState s newus+-}++addUser :: UserName -> B.ByteString -> Update AppState (Either String ())+addUser un@(UserName name) hashedpass = do+ AppState s us <- get+ case ( add_user un hashedpass us :: Either String Users) of+ Left err -> if isInfixOf "duplicate key" err+ then return . Left $ "username taken"+ else return . Left $ "error: " ++ err+ Right newus -> do put $ AppState s newus+ return $ Right ()+++changePassword :: UserName -> B.ByteString -> B.ByteString -> Update AppState ()+changePassword un oldpass newpass = do+ AppState s us <- get+ case ( set_user_password un (B.pack hashedoldpass) (B.pack hashednewpass) us :: Either String Users) of+ Left err -> fail $ "changePassword"+ Right newus -> put $ AppState s us+ where hashedoldpass = scramblepass (B.unpack oldpass)+ hashednewpass = scramblepass (B.unpack newpass)+++-- was getUser+getUserInfos :: UserName -> Query AppState (Maybe UserInfos)+getUserInfos u = ( return . M.lookup u . users ) =<< askDatastore++getUserProfile u = do+ mbUI <- getUserInfos u+ case mbUI of + Nothing -> return Nothing+ Just (UserInfos pass profile jobs) -> return $ Just profile++-- list all jobs along with the username who posted each job+-- listAllJobs :: Query AppState (M.Map UserName Jobs)+listAllJobs = return .+ concat . M.elems+ . M.mapWithKey g + . M.map (unjobs . jobs) . users + =<< askDatastore + where g uname jobs = map ( \(jobname,job) -> (jobname,job,uname) ) . M.toList $ jobs+++-- lookupUser f users = find f . S.toList $ users+listUsers :: Query AppState [UserName]+listUsers = ( return . M.keys . users ) =<< askDatastore++listUsersWantingDevelopers = (return . M.keys . M.filter wantingDeveloper . users) =<< askDatastore+ where wantingDeveloper uis = not . M.null . unjobs . jobs $ uis++++newSession :: SessionData -> Update AppState SessionKey+newSession u = do + AppState (Sessions ss) us <- get+ (newss,k) <- inssess u ss + -- check that random session key is really unique+ --modSessions $ Sessions . (M.insert key u) . unsession+ put $ AppState (Sessions newss) us+ return k+ where+ inssess u sessions = do+ key <- getRandom+ case (M.insertUqM key u sessions) of+ Nothing -> inssess u sessions+ Just m -> return (m,key)++delSession :: SessionKey -> Update AppState ()+delSession sk = modSessions $ Sessions . (M.delete sk) . unsession++getSession::SessionKey -> Query AppState (Maybe SessionData)+getSession key = liftM (M.lookup key . unsession) askSessions++numSessions :: Query AppState Int+numSessions = liftM (M.size . unsession) askSessions++-- initializeDummyData dd = modUsers (const dd)+initializeDummyData dd = do+ AppState ss (Users us) <- get+ if M.null us + then fail "initializeDummyData, users not empty"+ else put $ AppState ss (Users dd)++-- bad performance for large unumbers of users (>1000, with 200 jobs/dummy user)+-- maybe macid doesn't like serializing large quantities of data at once+addDummyData dd = do+ AppState ss (Users us) <- get+ put $ AppState ss (Users (M.union us dd) )++addDummyUser (un,uis) = do+ AppState ss (Users us) <- get+ us' <- M.insertUqM un uis us+ put $ AppState ss (Users us' )+++-- define types which are upper case of methods below, eg AddUser, AuthUser...+-- these types work with HApppS query/update machinery+-- in ghci, try :i AddUser+$(mkMethods ''AppState+ ['askDatastore+ , 'getUserInfos+ , 'getUserProfile+ , 'addUser+ , 'changePassword + , 'setUserProfile+ -- , 'updateUser+ , 'isUser+ , 'listUsers + , 'listAllJobs+ , 'getSession+ , 'newSession+ , 'delSession+ , 'numSessions+ , 'initializeDummyData+ , 'addDummyData+ , 'addDummyUser+ , 'addJob+ , 'delJob+ , 'setJob ]+ )+++
src/View.hs view
@@ -16,11 +16,11 @@ import Network.HTTP (urlEncode) import System.Directory (doesFileExist) import Data.Maybe-import StateStuff+import StateVersions.AppState1 ---import SerializeableUsers +-- --import SerializeableUserInfos (UserProfile (..))---import SerializeableJobs (Job(..), JobName(..))+-- (Job(..), JobName(..)) import HAppS.Helpers --import MiscStringTemplate
+ templates/cookies.st view
@@ -0,0 +1,45 @@+<h3>Cookies</h3>++<p>Cookies don't work quite right in HAppS out of the box. The most common problem+ is that google analytics and HAppS session cookies are mutually incompatible.+ (There is a thread about what went wrong in the initial implementation in the happs googlegroup.)++<p>Hopefully the underlying problems will be fixed in the next HAppS hackathon.++<p>Meanwhile, there is a workaround in the HAppSHelpers package on hackage, which is used by happstutorial.+ So cookies do work in happstutorial: I use google analytics to track visitors, + along with normal HAppS session cookies.+ And if you use happstutorial as your template for happs apps you should be fine.++<p>The cookie fix is just a couple lines of code in Controller.hs: ++<p>import HAppS.Server.CookieFixer+<br>controller allowStressTests = map cookieFixer \$ ..... ++++<p>Besides the cookies used by google analytics, which are obfuscated by javascript, happstutorial+ uses cookies to track session state -- the data that corresponds to the current user's session in+<br>+<br>data AppState = AppState {+<br> appsessions :: Sessions SessionData, +<br> appdatastore :: Users+<br>} deriving (Show,Read,Typeable,Data)+++<p>When you log in, a cookie is created that expires in an hour + (3600 seconds). And every time a happs handler needs to check if a user is logged in (for example, + when it needs to decide whether to show the logged-in-user menubar) a check is made to see if a cookie+ has been set. ++<p>The cookie code is in <a href=/projectroot/src/Misc.hs>ControllerMisc.hs</a>: ++<br>+<br>startsess' getLandingpage (RenderGlobals origRq ts _) user = do+<br> let sd = SessionData user+<br> key <- update \$ NewSession sd+<br> addCookie (3600) (mkCookie "sid" (show key))+<br> .....+<br>+<br>getMbSessKey rq = runReaderT (readCookieValue "sid") (rqInputs rq,rqCookies rq)+
templates/editconsultantprofile.st view
@@ -7,7 +7,7 @@ <tr><td>Contact:</td><td colspan=2><textarea name="contact" rows=3 cols=64>$contact$</textarea></td></tr> <tr><td>List me on the HAppS developers page:</td>- <td colspan=2><input type="checkbox" name="listasconsultant" value="listasconsultant" $listAsConsultantChecked$ ></td></tr> + <td colspan=2><input type="checkbox" name="listasconsultant" $listAsConsultantChecked$ ></td></tr> <tr><td>Upload picture:</td> <td><input type="file" name="imagecontents">
+ templates/feedback.st view
@@ -0,0 +1,64 @@+<h3>Feedback</h3>++<p>Got feedback? ++<p>I created a + <a href="http://groups.google.com/group/HAppS/browse_thread/thread/cff2b9098c2b7a14#">happs tutorial feedback thread</a>+ at happs googlegroup. + My preference would be for feedback on happs tutorial to go there, particularly if it fixes a problem+ or describes things to watch out for. ++<p>For what it's worth, here are somthings people have said about happstutorial + in blogs, user groups, and private emails.++<hr>++<p>@tphyahoo Just wanted to thank you for your tutorial. I've used it to successfully create a blog-system (a pet project) in Haskell (http://gisli.hamstur.is/blog/). In the blog itself, which is in Icelandic, I'm going to explain the source code (http://gisli.hamstur.is/src/) to the Icelandic Haskell community (if one exists ;)++<p>I was getting nowhere before finding your tutorial. There was however a slight feeling of set back when I realized that you hadn't written about HAppS-State. To my relief you were further along with the locally installed tutorial than happstutorial.com. Keep up the good work!++<p>Best regards, Gísli (reddit)++<hr>+<p>Great work, thanks for the tutorials, they were definitely needed!++<p>And the tutorial demo itself is awesome!++<p>dons (reddit)+<hr>+<br>Thanks for the cool tutorial. I want to learn about HAppS but the+<br>documentation is so poor there is nowhere to start. This is awesome+<br>+<br>Justin Bailey++<hr>++<br>> What happens if your HAppS deployment server experiences a power outage?+<br>> The way I deal with this both these issues with a public-facing happs application is to have a cron job that runs every minute, that will start the happs application if it isn't running.+<br>+<br>I would definitely not recommend that solution. (in worst scenario you+<br>get 1 min + session restore downtime).+<br>+<br>Maybe you could try running happs in non-daemonizing mode under tools+<br>like svadmin or http://supervisord.org/ , or use simple script like:+<br>+<br>#!bash+<br>while [ 1 ]+<br>do+<br>echo \$(date) - restart+<br>RUN_HAPPS_IN_NON_DAEMON_MODE+<br>sleep 1 # We do not want to DoS the server+<br>done+<br>+<br>If found this solution more reliable than cronjob.+<br>+<br>It also has an advantage, because parent app is instantly notified of+<br>children's death.+<br>+<br>I also wanted to thank you for great tutorial - as RnD engineer I was+<br>starring at Happs for some time, but lack of happs documentation+<br>resulted in forgetting this project.+<br>+<br>Marek Pułczyński++<hr>
templates/foreignchars.st view
@@ -20,7 +20,7 @@ displays properly in kate with utf8, it should display properly in the live tutorial as well. <p>Another annoyance: when I attempted to create dummy data with utf8 data (edited in kate)-and save this to HAppS State, this did NOT display correctly. (See AppStateSetBased.hs) I got \123 type+and save this to HAppS State, this did NOT display correctly. (See StateVersions.AppState1.hs) I got \123 type character escape sequences. I think this is because Serialization is based on show instances of data, and ... well... <br>@@ -37,3 +37,5 @@ end of the string as was more proper. I then got bitten by show as above, causing much misery. <p>But all that having been said, as the live demo shows, in general utf8 data does work as it should.++<p>Next chapter is about using <a href="/tutorial/start-happs-on-boot">cron jobs</a> to keep happs running if it quits on your mysterious reasons.
templates/ghciflounderingaskdatastore.st view
@@ -32,7 +32,7 @@ <p>*Main> :i askDatastore <br>askDatastore :: Query AppState (Data.Set.Set User)-<br> -- Defined at src/AppStateSetBased.hs:43:0-11+<br> -- Defined at src/StateVersions/AppState1.hs <p><font color=orange>what's a Query?</font> @@ -53,7 +53,7 @@ this mess typechecks. </font> -<p>*AppStateSetBased Control.Monad.Reader GHC.Conc Data.Set> :t askDatastore :: Ev (ReaderT AppState STM) (Set User)+<p>*StateVersions.AppState1 Control.Monad.Reader GHC.Conc Data.Set> :t askDatastore :: Ev (ReaderT AppState STM) (Set User) <br>askDatastore :: Ev (ReaderT AppState STM) (Set User) :: Ev (ReaderT AppState STM) (Set User) <br>*Main> <br>
templates/home.st view
@@ -1,11 +1,17 @@ <h3>Real World HAppS</h3> -<p>Haskell is a great way to program.</p>+$!<p>Haskell is a great way to program.</p>!$ -<p>And <a href="http://www.happs.org">HAppS</a> is a great way to build-web applications. +<p><a href="http://www.happs.org">HAppS</a> is a great way to build web applications. + Besides having a great feature set in its own right, it is probably the leading solution+ for implementing web apps in <a href="http://www.google.com/search?hl=en&q=why+haskell">haskell</a>, + my favorite language. -<p>Especially if you believe, like I do, that as+$!<p>You also get all the <a href="http://www.google.com/search?hl=en&q=why+haskell">goodness</a>+that comes from programming in <a href="http://www.haskell.org">haskell</a>, my favorite language.</p>+!$++<p>HAppS is especially great if you believe, like I do, that as modern software systems tend toward ever increasing complexity, database usage is an unnecessary source of complication that <a href=http://gilesbowkett.blogspot.com/2007/05/sql-unnecessary-in-haskells-happs.html>should be factored out</a> where possible.@@ -20,30 +26,17 @@ $!Or to put it another way, that <a href=http://gilesbowkett.blogspot.com/2007/05/sql-unnecessary-in-haskells-happs.html>sql is an ugly hack</a>. !$-<p>-HAppS is haskell's answer to rails and django (and perl's <a href="http://www.catalystframework.org/">catalyst</a>, and <a href="http://www.php.net">php</a>).-$! , and every ORM ever written in the history of software) !$ -With HAppS, there is no wrangling data-structures into and out of the database, because there is no database. You use whatever data-structures are natural to your application, and serialize them-transparently using-<a href="http://www.google.com/search?q=scrap+your+boilerplate">powerful</a>-machinery</a> that's running <a href="http://www.haskell.org/th/">behind the-scenes</a>. And if there are existing databases that you need to connect to, you can do that too -- you're not locked in to using macid for everything.--<p>The above description is a bit idealized. Keeping everything in macid limits you to how much RAM you can afford,- and even if you can afford a lot (16GB in the amazon cloud costs \$576/month) there's no guarantee that you won't- max that out if your application has a lot of data.- (See the <a href=/tutorial/macid-stress-test>stress test</a> chapter for more caveats.)- The HAppS developers have promised a version of HAppS that will make it easy to share ram across computers- with a technique called sharding, but this hasn't been released in a way that inspires confidence in me- (on hackage, sufficient documentation),- and to be honest I don't really understand how it is supposed to work even in theory.- But what is realistic is to write an alpha version of an application without a database access layer, - and then add persistent hard drive storage (probably database, but could also be flat files or name your poison)- outside of macid when it becomes necessary. Most web projects do not get to a size where this is necessary,- so arguably coding in a database from a start is a form of insidious premature optimization, if you buy- the argument that using a database from the start introduces significant maintenance overhead.+<p> HAppS is haskell's answer to rails and django (and perl's <a href="http://www.catalystframework.org/">catalyst</a>, + and <a href="http://www.php.net">php</a>).+ $! , and every ORM ever written in the history of software) !$ + With HAppS, there is no wrangling data+ structures into and out of the database, because there is no database. You use whatever data+ structures are natural to your application, and serialize them+ transparently using+ <a href="http://www.google.com/search?q=scrap+your+boilerplate">powerful</a>+ machinery</a> that's running <a href="http://www.haskell.org/th/">behind the+ scenes</a>. And if there are existing databases that you need to connect to, you can do that too + -- you're not locked in to using macid for everything. <p><a href="http://hackage.haskell.org/packages/archive/HAppS-State/0.9.2.1/doc/html/HAppS-State.html#1">MACID</a>, the HAppS storage mechanism, is no vanilla serialization layer that will@@ -53,12 +46,19 @@ you get the same <a href="http://en.wikipedia.org/wiki/ACID">ACID</a> guarantees that normally only come with a database. </p> -<p>You also get all the <a href="http://www.google.com/search?hl=en&q=why+haskell">goodness</a>-that comes from programming in <a href="http://www.haskell.org">haskell</a>, my favorite language.</p> +<p>There are some <a href="/tutorial/macid-stress-test">limitations</a> to using macid + as a datastore that you should familiarize yourself with+ if you are looking into using HAppS for heavy-usage transactional applications.+ But long term, HAppS with macid looks promising enough that I've started+ using it as a platform for building commercial web 2.0 type apps. (My first + commercial happs app will be public soon, so stay tuned on + <a href=http://www.techcrunch.com>techcrunch</a>. :) )+ <p>In short, HAppS is awesome, and webmonkeys everywhere should use it. Except... <p>There is this one <a href="/tutorial/missing-happs-documentation">minor detail</a>.+
templates/introductiontomacid.st view
@@ -21,7 +21,7 @@ <p> thartman@thartman-laptop:~/happs-tutorial>grep -ra testuser _local-<br>_local/happs-tutorial_state/events-0000000000:ß\$6¡·¢:1525374391 696985193?AppStateSetBased.AddUsertestuser e1+<br>_local/happs-tutorial_state/events-0000000000:ß\$6¡·¢:1525374391 696985193?AppState1.AddUsertestuser e1 ... (and lots more lines of binary data) <p>Hm... let's see, can we be sneaky and grep for the password?
templates/maciddatasafety.st view
@@ -91,7 +91,7 @@ <p> Q: What if my hard drive dies and I can't get my data back? <p> A: Like with any other data storage system, if there's valuable data, you need to be making backups.- In the case of HAppS data stored under _local, I would probably be <a href="rsync.net">rsyncing</a>+ In the case of HAppS data stored under _local, I would probably be <a href="http://www.rsync.net">rsyncing</a> the _local directory to a remote server, or maybe multiple remote servers for extra safety. For now I am not worried about securing data, but when that day comes I'm pretty confident I'll be ok.
+ templates/macidlimits.st view
@@ -0,0 +1,60 @@+<h3>What can't you do with macid?</h3>+++<p>Keeping everything in macid limits you to how much RAM you can afford.+ Even if you have a business model where you can afford a lot (16GB in the amazon cloud costs \$576/month) + there's no guarantee that you won't+ max that out if your application has a lot of data, if you are limited to one computer.+ +<p>(See the <a href=/tutorial/macid-stress-test>stress test</a> chapter for more caveats.)+ The HAppS core developers have promised HAppS features+ that will make it easy to share application state+ across many computers, making scaling to ebay-sized proportions relatively straightforward: you + just add more computers to your amazon EC2 cloud. This hasn't happened yet, and I have a feeling that+ when (if?) it does happen it won't be a panacea for every scaling problem. But for reference, + the features are replication and sharding. You can search the happs googlegroup to learn more + about this.+++<p>My take is that, as currently implemented, Macid may be impractical for an app with tens of thousands of + concurrent sessions, especially if real acid transactionality is required. (EG, an accounting application.)+ The situation improves if you have large numbers of users but don't require transactionality. + (E.G, facebook, reddit, message boards.)+ This is true for web apps with a database backend as well, for more or less similar reasons.++<p>A realistic way to use HAppS with macid is to write an alpha version of an application + using macid (no database), + and then add some other type of persistent hard drive storage (probably database)+ outside of macid only if it becomes necessary. ++<p>This raises the question: if you are eventually going to have to put in a database back end, why use + macid at all?+++<p>The -- perhaps slightly depressing answer -- is that you probably won't have to put in a database back end, + because your app won't be so successful that this is required. If your state needs transcend what+ macid can deliver with reasonable performance, you will have+ to rewrite a lot of your state code, but it will be worth it, because venture capitalists will be + knocking down your door. (You're the next facebook, ebay, etc.) ++<p>In the best case scenario, the HAppS core team will deliver on their promise of easy scaling+ via ec2 and similar cloud solutions, in which case you won't even have to deal with a state rewrite.++ +<p>Since macid is available and macid is more straightforward to use than a database layer,+ coding in a database from a start is a form of insidious premature optimization, if you buy+ the argument that using a database from the start introduces significant maintenance overhead.++<p>Having made this lengthy argument for macid... I can see myself rewriting a future tutorial chapter+ that describes using HAppS with takusen and postresql as a backend rather than macid. But that hasn't + happened yet. If it needs to, it will. :) ++<hr>++<p>Well folks, that more or less wraps up the <a href="http://www.happstutorial.com">happs tutorial</a>.++<p>You can now go out and use happs, using happstutorial as a template to get you started if appropriate.++<p>The remaining chapters are of an appendix nature. Nice to have, but not fundamental.++<p>If you want to keep reading, the next chapter is about using <a href=/tutorial/foreignchars>utf8</a> in happs.
templates/macidmigration.st view
@@ -1,1 +1,222 @@ <h3>Macid migration</h3>++<p>What happens when your data model changes?++<p>People who have been following this tutorial for a while may have noticed that every time I come out with + a new version, the existing users and jobs disappear and we start out with a blank slate again.++<p>That's because changing the data schema of a happs-with-macid web app (aka migrating) is a chore.+ +<p>It's a chore with traditional web apps too. But it's probably more difficult with macid, especially+ given the sparse documentation.++<p>This isn't a problem for happstutorial.com, because typically there are only a + few dozen users and jobs, plus whatever dummy data I've entered myself. Who cares?+ So far, rather than migrating, I've just wiped the slate clean.++<p>However, that isn't going to work for your latest facebook-killer.++<p>The good news is, there is a way to migrate HAppS state through various iterations, it's sufficiently+ documented if you know where to look, and it's not too painful once you've gotten used to it.++<p>The main challenge is finding documentation. ++<p>The best documentation I have found is two threads in the happs googlegroup, along with the migration example+ that was produced by eelco lempsink during the thread. I have taken this migration example example and+ included it in the happstutorial distribution, with some improvements of my own.++<p>The googlegroup migration threads are + <a href="http://groups.google.com/group/HAppS/browse_thread/thread/c23101b258d337d0/261e3a871853b0e8?">here</a>+ and follow-up <a href="http://groups.google.com/group/HAppS/browse_thread/thread/98e129e6349e4b0b/0e174e9c36edbd72">here</a>.++<p>The migration example I've included with the tutorial is at <a href="/src/migrationexample">migrationexample</a>.++<p>My advice is to try the demo in <a href="/projectroot/src/migrationexample">migrationexample</a> first, + following the directions in the <a href ="/projectroot/src/migrationexample/README">README</a> file, + read through the source files to understand how the demo works,+ and then refer to the googlegroups thread if necessary.++<p>Possibly this is sufficient documentation for you to start doing migrations yourself. If so, great,+ ignore what follows.++<p>If you feel like you could use more guidance, read on for some notes I put together on my own+ migration experience.++<hr>++<p>Though I haven't started migration for the toy job board in happs-tutorial, I am using it for my + commercial project that is under development. This will be the basis of the notes that follow.++<p>I almost didn't include these notes, because I wanted to provide an+ easy step by step example that referenced the toy job board as I have done for other tutorial topics.+ However, doing this will be quite a bit of work, I haven't gotten around to doing this after many weeks.+ I want to get the information out, so I decided to just share what I have. ++<p>I apologize in advance if some of this seems confusing or fragmentary. I did my best, and I will + try to clean things up and integrate the example into the tutorial rather than snipping from an external app.++<hr>++<p>Ok... General migration notes:++<p> Old state module names should not change, nor be shifted around in+ directory structure (which is really just another kind of name+ change). Therefore it's a good idea to start out with a sane+ directory hierarchy for schema versions before you start doing+ migrations. I recommend keeping App state in one monolithic file, in+ a directory devoted to state versions. It makes schema migrations+ much easier, as all references to the old state can then be handle+ via import Qualified StateLast.hs as Old, then referenced via+ Old.whatever, when bits of logic that remain consistent between the+ old monolithic state file and the new monolithic state file. Resist+ the temptation to split state into multiple files. Bear in mind that due to template haskell the order of+ data structures declarations becomes significant, which is usually not+ the case with haskell. (I seem to reall this annoyance was part of the+ reason why I started splitting things into multiple files to begin+ with, which I later regretted because it made migration that much harder.) ++<p> Don't call HAppS State "State", as this conflicts with the+ State datatype in Control.Monad.State. I usually call my state+ datatype AppState.++<p> There will be code duplication, for the functions that get+ transformed to state modifiers in template haskell. This is a bad+ code smell, but I think it's unavoidable for the mkMethods directive with + all the methods template haskell needs.+ +<p> In the old state file (being migrated from), make sure it exports+ everything via module OldState ( ... everything gets exported here+ ...) where.... My way to do this is load the state module, :browse+ in ghci, copy the output, and clean it up using emacs regexen. In+ emacs, dired-mark-files-regexp and dired-do-query-replace-regexp are+ your friends.++<p> Then, (my way), cd StateVersions, cp AppState1.hs AppState2.hs (or whatever version number we're on.)++<p> Seems almost too obvious to say, but if you have live customer+ you're not going to want to migrate this without having tested the+ migration in a sandbox first. Create your sandbox, which should+ include a snapshot of live customer data. Good way to create a+ snapshot is tar -czvf _local on your live data. Test thoroughly on this + snapshot before doing the live migration. And even if you think you've tested enough, + tar snapshot your live data before the migration again, just in case.++<hr>++Notes for doing a step by step migration:++<p>Make a live data snapshot and copy it to your migration sandbox: _local.tar.gz. (If there is an unwieldy large + amount of data, create a smaller data set by setting up a server identical with the live server and doing some + actions manually.)++<p> cd StateVersions; cp AppState1.hs AppState2.hs (or whatever version we're on)+ For now, we just want a placeholder that will have AppState2 behaving exactly like AppState1.+ change references from AppState1.hs to AppState2.hs in app code.+ try running server, the result should be that it compiles, runs, but all data is all lost. (because we haven't written migration yet.)+ +<p>roll back from backup taken earlier: rm -rf _local and tar -xzvf _local.tar.gz (an explicit reminder to + rollback the live data tar may be omitted from future steps, but basically you keep rolling back until + you get a successful migration.)++<p> modify AppState (or whatever your main State datastructure is), say, adding a field. Don't write a Migrate instance + yet. Try running. You'll probably get an error like "Exception: Non-exhaustive patterns in case."+ Kind of a crappy error message if you ask me, but ok. What's happening is the pre-existing data in the + _local directory isn't compatible with your modified AppState. If you rm -rf _local and try running again, it should + work now. But of course you have lost all your data, and need to rollback the live data again for the next step. + +<p> Now make necessary changes in code for migration. + See eelco's and my uploads to happs google group (tk happs tutorial). Summary is:+ modify the version instance for AppState and add a migrate instance, allong the following lines. First, ++<p> import qualified StateVersions.AppState1 as Old+<br> ...+<br> -- we'll say 2 because this is StateVersions/AppState2.hs+<br> -- I don't think it matters what number you use as long as it's higher than the last version, +<br> -- but I'd like to have a core dev confirm that intuition.+<br> -- I wonder too what happens if you screw up this version number somehow. EG, what if you specify a version number+<br> -- identical to the version you're migrating from?+<br> instance Version AppState where+<br> mode = extension 2 (Proxy :: Proxy Old.AppState) ++<p> This won't compile, you'll get an error about a missing (Migrate Old.AppState AppState) + instance arising from use of extension. So we supply the instance++<p> instance Migrate Old.AppState AppState where+<br> migrate (Old.AppState s d) = AppState (migrates s) (migrated d)+<br> migrates s = undefined+<br> migrated (us, aus, rs, rus) = undefined++<p> We use undefined just to get it to compile and have something to darcs commit, and then write sensible code later.+ +<br>*Main> :! grep -irn AppState1 *.hs+<br>Controller.hs:27:import StateVersions.AppState1+<br>ControllerAppMigration.hs:18:import StateVersions.AppState1+<br>......+<br>View.hs:29:import StateVersions.AppState1++<p>These are the places in the code that need to be switched to use AppState2 instead.++<br>Let's test this by adding an emails field to UserInfos+<br>Actually, first let's try adding an email field to Macid1 and see if we get an error.+<br>We do get an error, and it's a weird error:+<br> *** Exception: src/Macid1/Repos.hs:45:2-24: Non-exhaustive patterns in case+<br> at \$(deriveSerialize ''Repos) ++<p>Is non-exhaustive pattern because somewhere behind the scenes there has been a macid version bump + when it detected that the schema changed?++<p>Dunno, but let's try now by switching state to AppState2.hs+<p>Let's also note the latest checkpoint in the _local directory. It is: ...+<br> ls -lth _local/patch-shack_state/ | head -n2+<br>... checkpoints-0000000014++<p>and back it up: +<br> tar -czvf _loacl.beforemigration.tar.gz _local++<p>Step1, cd StateVersions; cp AppState1.hs AppState2.hs. Ok, that works. (Haven't actually used migration machinery yet.)++<p>Now, let's try using the migration machinery, but the migrate is actually just id (so no data structure actually changes).++<p>The following is a snip from a working migration instance, where one field in an interior data structure+has been added. (Specifically, UserProfile has gone from a 3 argument constructor to a 4 argument constructor).++<p>You might think this looks like a lot of boilerplate for adding a single field, and I would agree. The good news+is that your migration code will look similar if you are making more than just that one change, and the problem+is still tractable.++<p>And of course, migrations with a database back-end are no picnic either.++<hr>+<p>Migrate instance example (add a field to UserProfile):++<font color=orange>+<p>instance Migrate Old.AppState AppState where+<br> migrate (Old.AppState s d) = AppState (migrates s) (migrated d)+<br>+<br>-- Nothing changed in sessions -- it's the second arg to appstate (AppDatastore users) that had a field added+<br>-- We could have avoided writing migrates by using type synonyms to exactly copy the types from AppState1, +<br>-- as is done in eelco's example.+<br>-- I prefer to write out the migration explicitly rather than use type synonyms, because then after a successful +<br>-- migration the Migrate instance and the old state code can be removed, and you wind up with just a monolithic+<br>-- state file evolving over time rather than a sequence of states each with a module dependency on the previous state+<br>-- . (I think this is the case -- still have to prove this works.)+<br>migrates :: Old.Sessions Old.SessionData -> Sessions SessionData+<br>migrates (Old.Sessions s) = Sessions . M.map f \$ s+<br> where f :: Old.SessionData -> SessionData+<br> f (Old.UserSession (Old.UserName u) ) = UserSession (UserName u)+<br> f (Old.AdminSession (Old.AdminUserName u) ) = AdminSession (AdminUserName u)+<br>+<br>migrated (Old.Users us, Old.AdminUsers aus, Old.Repos rs, Old.RepoUsers rus) = +<br> ( (Users . M.map ui . M.mapKeys uk \$ us), +<br> (AdminUsers . M.map auv . M.mapKeys auk \$ aus),+<br> (Repos . M.map rv . M.mapKeys rk \$ rs), +<br> (RepoUsers . IXS.fromSet . S.map ru . IXS.toSet \$ rus ) +<br> )+<br> where ui (Old.UserInfos p (Old.UserProfile c bl av ) ) = UserInfos p (UserProfile S.empty c bl av)+<br> uk (Old.UserName u) = UserName u+<br> auk (Old.AdminUserName u) = AdminUserName u+<br> auv (Old.AdminUserInfos p) = AdminUserInfos p+<br> rv (Old.Repo (Old.UserName u) bud blu isp) = Repo (UserName u) bud blu isp+<br> rk (Old.RepoName n) = RepoName n+<br> ru (Old.RepoUser (Old.RepoName n) (Old.UserName u) ) = RepoUser (RepoName n) (UserName u)+</font>
templates/macidstresstest.st view
@@ -26,7 +26,14 @@ and share what I learned with a wider audience. In a future release, I still intend to show how you can scale a HAppS app up to large numbers of users! :) -<p>The most important lesson I learned is that putting all application state into macid won't work if you +<p>Sidenote: as (I think) 37 Signals said, "you don't have a scaling problem." I certainly don't have a scaling problem,+ and if I did I would probably be jumping for joy even while I was tearing my hair out trying to figure out+ how to accomodate more users. My current plans are for a membership site with paying user count, optimistically,+ in the high thousands -- so I'm okay using macid even with all the caveats. I'm mainly working on the + user scaling problem because I find it interesting and am learning a lot; secondarily because I have ideas+ in the works that might actually run into the RAM limit. ++<p>That said, the most important lesson I learned is that putting all application state into macid won't work if you have a lot of data -- not even if you have one of those <a href="tk 16 gb box at amazon">heavy iron</a> boxen from amazon web services, or for that matter a whole virtual data center full of them. 16GB of RAM gets used up surprisingly fast if you are using ram for everything.@@ -89,39 +96,7 @@ 20,000 users (4 million jobs) before performance degraded because of the amount of data being kept in ram. (With 10,000 users it ran without breaking a sweat, 20,000 was doable but went into swap.) --$! <p>To be honest, maybe not. !$--$!-<p>I have done some preliminary testing to answer this question, and so far the results have been disappointing.--<p>I am hoping that I am doing something wrong, and that there is a way of using macid effectively- for more than just toy applications. I also asked the HAppS googlegroup for help, and if there is a - solution for the problems I found I will definitely be sharing it in the tutorial, so stay tuned.- -<p>I am seeking feedback from HAppS experts and educated users on the following questions: -<ul>- <li>Is building a heavy duty website like monster.com in HAppS a realistic goal -- say, in the next twelve months?- <li>Are there certain types of web apps that are <i>unlikely</i> to work well with the HAppS web architecture?- <li>Are there changes I can make to my toy app's architecture --- be it data structures, buying new hardware, whatever -- that will enable me to get good performance- against the stress test described below?- <li>Are there other HAppS stress tests in the public domain, and what are the results so far?-</ul>--<p>Thanks in advance for anybody who can help me <a href=http://www.youtube.com/watch?v=akaD9v460yI>push HAppS to 11</a>!--$!--<p>Still chugging... At 1:03, about 15 minutes after we started, the 200th- user is inserted. The jobs page loads slowly, but that's to be expected with - a 20000 jobs long pagination. I ctrk-c out, and restart. The state file for the last experiment- is 542M large. The jobs app gives the startup message ("exit :q ghci completely...")- but it seems to be starting very slowly, and gives no feedback why.- Also emacs is sluggish. I restarted at 1:10, it's 1:14 and localhost:5001 still doesn't show anything. - At 1:20 http://localhost:5001 loads normally.- ---!$-+<p> Obviously this chapter of the happs tutorial is in progress and, to some extent, in flux. There is a + thread about the stress tests in the <a href="tk">haspps googlegroup</a> that you can have a look at+ for even more information. I also say a few more words about what macid isn't good for in + <a href="/tutorial/macid-limits">macid limits</a>.
templates/macidupdatesandqueries.st view
@@ -18,12 +18,12 @@ If it's the empty set, there is no existing data and the dummy data can be added safely, and then a "dummy data success" page gets displayed. Otherwise no update happens and you get an error page. -<p>The macid state of our job board is defined in AppStateSetBased</a>,+<p>The macid state of our job board is defined in <a href="/src/StateVersions/AppState1.hs">StateVersions.AppState1</a>, in the AppState data declaration. As you may recall, we have seen AppState before, in runserver, in our lesson on the <a href="/tutorial/main-function">main module</a>. AppState's use in startSystemState, in Main.hs, is what makes it the primary state component of our web app. -<p>From <a href="/src/AppStateSetBased.hs">AppStateSetBased.hs</a>+<p>From <a href="/src/StateVersions/AppState1.hs">StateVersions.AppState1.hs</a> (for optimal learning, open this file in another window): <i>@@ -43,7 +43,7 @@ <ul> <li>You make the data declaration pretty much in the usual way- <li>You set the necessary LANGUAGE pragmas for the macid machinery to work (see top of AppStateSetBased.hs)+ <li>You set the necessary LANGUAGE pragmas for the macid machinery to work (see top of AppState1.hs) <li>You derive Read, Show, Typeable, and Data <li>You declare your data type an instance of Version (to allow migrations) <li>You have template haskell generate boilerplate that makes AppState an instance of Serializeable.@@ -57,6 +57,12 @@ As long as each subcomponent has been declared in the right way, components depending upon them can be derived more of less hassle-free. +<p>One thing to watch out for in mind is that because template haskell is being generated, the order that functions+ appear in the AppStaten.hs modules matters (which is generally not the case in haskell). If TH can't find+ generated code it needs, the module won't compile. (Perhaps this is something that could be fixed in TH + in the future.) + + <p>Because AppState is the top-level component, in addition to Read / Show / Serializeable / Version, it is also an instance of Method and Component. @@ -70,11 +76,11 @@ <i>query AskDatastore</i> and <i>update InitializeDummyData</i>. <p>AskDatastore and InitializeDummyData are generated with template haskell, based on the definitions of - askDatastore and initializeDummyData, in AppStateSetBased.+ askDatastore and initializeDummyData, in AppState1. <p>If you do -<p>*Main> :browse AppStateSetBased+<p>*Main> :browse StateVersions.AppState1 <p>you'll see a number of function/datatype pairs defined via template haskell, where the datatype has the same name as the function, except it is upper-cased. askDatastore / AskDatastore, getUser / GetUser,@@ -97,11 +103,11 @@ <p>*Main> :i AskDatastore <br>data AskDatastore = AskDatastore-<br> -- Defined at src/AppStateSetBased.hs:(178,2)-(191,27)+<br> -- Defined at src/StateVersions/AppState1.hs <br>instance Serialize AskDatastore-<br> -- Defined at src/AppStateSetBased.hs:(178,2)-(191,27)+<br> -- Defined at src/StateVersions/AppState1.hs <br>instance Version AskDatastore-<br> -- Defined at src/AppStateSetBased.hs:(178,2)-(191,27)+<br> -- Defined at src/StateVersions/AppState1.hs <p>However, if you ask ghci about askDatastore, upon which you know AskDatastore is based -- because of the lowercase -- you <i>can</i> confirm that it is a query.@@ -126,8 +132,8 @@ <p>To get comfortable with macid <ul>- <li>read and understand the .hs files that define the job board state:- AppStateSetBased.hs, SerializeableUsers.hs, and SerializeableSessions.hs+ <li>read and understand the AppState1.hs file, which defines the job board state:+ <li>Play with your locally installed job board while reading along with the source code. See how queries and updates are used in the job board: when logging in, when creating or deleting jobs,
templates/mainfunction.st view
@@ -1,46 +1,70 @@ <h3>Where it all begins: the function main</h3> -<p>Have a look at <a href="/src/Main.hs">Main.hs</a> module at the core of this web application.</p>+<p>Have a look at the <a href="/src/Main.hs">Main.hs</a> module which is at the core of this web application.</p> -<p>Two bits of code that should jump out at you as being important are +<p>In particular, notice the line -<ol>- <li>startSystemState (Proxy :: Proxy AppState) -- start the HAppS state system- <li>simpleHTTP (Conf {port=p}) controller -- start serving web pages-</ol>+<p>smartserver (Conf p Nothing) "happs-tutorial" (controller allowStressTests) stateProxy -<p>We'll pospone learning about the HAppS state system (the first line) for later.</p>+<p>This is a library function, which can be looked up via the ghci info directive (or i for short): +<br>+<br>*Main> :i smartserver+<br>smartserver ::+<br> (Methods st, Component st, ToMessage a) =>+<br> Conf -> String -> [ServerPartT IO a] -> Proxy st -> IO ()+<br> -- Defined in HAppS.Server.Helpers +<p>Each of these arguments is important enough to say something brief about. ++<p>In this case, the configuration argument just specifies the port the server runs on. ++<p>The second string argument controls where serialized app state will+ be stored: in this case, under "_local/happs-tutorial". This is mainly for convenience, so the state+ directory is the same whether we are running in ghci or ghc. (HAppS out of the box just looks+ at the executable name, which in the case of ghci is something weird.)++<p>The third argument tells HAppS what to use as a controller, in the MVC sense.+ Basically, how to handle http requests.++<p>The fourth argument tells happs what data structure to use for application state.+ We'll cover about the HAppS state system in depth, but later.</p>++++ <p>To learn more about what the controller function is doing, , open this file in ghci: cd src; ghci Main.hs and have a look at these functions using ghci :info .</p> -<p>*Main> :i controller-<br>controller :: [ServerPartT IO Response]+<p>+<br>*Main> :i controller+<br>controller :: Bool -> [ServerPartT IO Response] <br> -- Defined at <a href="/src/Controller.hs">Controller.hs</a>...+<br> <br>*Main> :i ServerPartT-<br>newtype ServerPartT m a-<br> = ServerPartT {unServerPartT :: Request -> WebT m a}+<br>newtype ServerPartT m a = ServerPartT {unServerPartT :: Request -> WebT m a} <br> -- Defined in HAppS.Server.SimpleHTTP <br>instance [overlap ok] (Monad m) => Monad (ServerPartT m) <br> -- Defined in HAppS.Server.SimpleHTTP+<br> <br>*Main> :i WebT <br>newtype WebT m a = WebT {unWebT :: m (Result a)} <br> -- Defined in HAppS.Server.SimpleHTTP <br>instance [overlap ok] (Monad m) => Monad (WebT m) <br> -- Defined in HAppS.Server.SimpleHTTP+<br> <br>*Main> :i Result <br>data Result a <br> = NoHandle | Ok (Response -> Response) a | Escape Response <br> -- Defined in HAppS.Server.SimpleHTTP <br>instance [overlap ok] (Show a) => Show (Result a) <br> -- Defined in HAppS.Server.SimpleHTTP-<br> </p> -<p>The controller function is a list of ServerPartTs, which are basically handlers that-accept an HTTP request and return a response. -Well, ok... this is a bit obfuscated by the many types involved in the construction, -and if you want to be pedantic it's probably a bit more complicated than that, but you don't need to understand all+<p>The controller function is a list of ServerPartTs, which are handlers that+accept an HTTP request and return a response. (The boolean argument determines whether or not we +enable a certain handler -- "stress tests" -- which is discussed later; don't worry about it for now.)+This is a bit obfuscated by the many types involved in the construction, +and if you want to be pedantic it's actually a bit more complicated than that, but you don't need to understand all the details at this point. So, for the moment, just think about a ServerPartT as a wrapper over a function that takes an HTTP request and returns a response.
@@ -2,7 +2,7 @@ <td> $ menubarMenu $ </td>- <td width=100> $! td is for alignment only, an ugly hack, and it renders bad if you resize the window.+ <td width=50> $! td is for alignment only, an ugly hack, and it renders bad if you resize the window. how can I do this better? !$ </td> <td align=right> $ userMenu $ </td> </tr>
@@ -1,4 +1,6 @@ [("/tutorial/home","home"), ("/tutorial/consultants","happs developers"), ("/tutorial/consultantswanted","happs developers wanted"),- ("/tutorial/jobs","happs jobs")]+ ("/tutorial/jobs","happs jobs"),+ ("/tutorial/feedback","feedback")]+
templates/missinghappsdocumentation.st view
@@ -12,7 +12,7 @@ ecosystem needs most, after better documentation, is the opportunity for developers to make real money doing real work by leveraging this technology. So the demo project is a job board. It's full of dummy data at the moment, but feel free to post real jobs here if you have them on offer.-+(But cc the happs googlegroup as well! :) ) $! Somewhat to my shame, I still haven't learned how HAppS data migrations work, so every time I release a new version of the tutorial I lose all data -- however, if any real seeming jobs
templates/thanks.st view
@@ -7,3 +7,16 @@ <p> Justin Bailey contributed a patch for displaying haskell files colorized.++<p>Lemmih, who is -- I think -- the main happs core developer at the present time,+ helped me think through the macid stress test chapter, and numerous other issues.++<p>Eelco Lempsink, and Jeremy Shaw (nhepthanlabs) provided valuable assistance + via code contributed and questions answered in the happs googlegroup.++<p>Did I forget someone? Drop me a line and I'll add you to the list.++<p>Oh, thanks for everyone who encouraged me to keep working on this. + It's been a long slog, but I think it's been worth it. ++<p>Hey, that makes it sound like I'm done. But a tutorial is never done :)
templates/toc.st view
@@ -10,12 +10,14 @@ , ("/tutorial/debugging","debugging") , ("/tutorial/get-and-post","form data: get and post") , ("/tutorial/file-uploads","form data: file uploads")+ , ("/tutorial/cookies","cookies") , ("/tutorial/introductiontomacid","introduction to macid") , ("/tutorial/macid-data-safety","using macid safely") , ("/tutorial/macid-dummy-data","macid dummy data") , ("/tutorial/macid-updates-and-queries","macid updates and queries") , ("/tutorial/macid-migration","changing the data model") , ("/tutorial/macid-stress-test","macid stress test")+ , ("/tutorial/macid-limits","limitations of macid") , ("/tutorial/foreignchars","foreign characters") , ("/tutorial/start-happs-on-boot","cron jobs") , ("/tutorial/thanks","thanks")