salvia-demo (empty) → 1.0.0
raw patch · 15 files changed
+449/−0 lines, 15 filesdep +basedep +c10kdep +fclabelssetup-changed
Dependencies added: base, c10k, fclabels, filestore, monads-fd, network, salvia, salvia-extras, salvia-protocol, salvia-sessions, salvia-websocket, stm, threadmanager, transformers
Files
- LICENSE +28/−0
- Setup.lhs +6/−0
- salvia-demo.cabal +83/−0
- src/CgiDemo.hs +8/−0
- src/Demo.hs +110/−0
- src/DirectoryHandling.hs +21/−0
- src/HelloWorld.hs +22/−0
- src/QueryParams.hs +18/−0
- src/ServeDemo.hs +28/−0
- www/data/users.db +2/−0
- www/demo.cgi +16/−0
- www/index.ccss +3/−0
- www/index.html +65/−0
- www/login.html +19/−0
- www/signup.html +20/−0
+ LICENSE view
@@ -0,0 +1,28 @@+Copyright (c) Sebastiaan Visser 2008++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.+
+ Setup.lhs view
@@ -0,0 +1,6 @@+#! /usr/bin/env runhaskell++>import Distribution.Simple++>main = defaultMain+
+ salvia-demo.cabal view
@@ -0,0 +1,83 @@+Name: salvia-demo+Version: 1.0.0+Synopsis: Demo Salvia servers.+Description:+ This package contains six simple example programs that show how to use the+ Salvia web application framework. The first demo, /salvia-demo/, contains a+ bigger example showing off some of the more advanced features and handler+ running on the default Salvia server implementation. The second demo,+ /salvia-cgi/ show how to switch the Salvia back-end and run a Salvia handler+ in CGI mode. The third example, /salvia-serve/, is a simple file server that+ uses the /c10k-server/ back-end and the /send-file/ package to server static+ files and directories. The other demos illustrate how to use some simple+ aspects of the web framework.++Category: Network, Web+License: BSD3+License-file: LICENSE+Author: Sebastiaan Visser+Maintainer: sfvisser@cs.uu.nl+Cabal-version: >= 1.6+Build-Type: Simple++Data-Files: www/data/users.db+ www/demo.cgi+ www/index.ccss+ www/index.html+ www/login.html+ www/signup.html++Library+ GHC-Options: -Wall+ HS-Source-Dirs: src++ Build-Depends: base ==4.*,+ transformers ==0.1.*,+ monads-fd ==0.0.*,+ threadmanager ==0.1.*,+ stm ==2.1.*,+ c10k ==0.2.0,+ filestore ==0.3.*,+ fclabels ==0.4.*,+ network >= 2.2.1.7 && < 2.3,+ salvia ==1.0.*,+ salvia-protocol ==1.0.*,+ salvia-extras ==1.0.*,+ salvia-sessions ==1.0.*,+ salvia-websocket ==1.0.*++Executable salvia-demo+ Executable: salvia-demo+ Main-is: Demo.hs+ GHC-Options: -threaded -Wall -fno-warn-orphans+ HS-Source-Dirs: src ++Executable salvia-serve+ Executable: salvia-serve+ Main-is: ServeDemo.hs+ GHC-Options: -threaded -Wall -fno-warn-orphans+ HS-Source-Dirs: src ++Executable salvia.cgi+ Executable: salvia.cgi+ Main-is: CgiDemo.hs+ GHC-Options: -threaded -Wall -fno-warn-orphans+ HS-Source-Dirs: src ++Executable salvia-helloworld+ Executable: salvia-helloworld+ Main-is: HelloWorld.hs+ GHC-Options: -threaded -Wall -fno-warn-orphans+ HS-Source-Dirs: src++Executable salvia-query+ Executable: salvia-query+ Main-is: QueryParams.hs+ GHC-Options: -threaded -Wall -fno-warn-orphans+ HS-Source-Dirs: src++Executable salvia-directories+ Executable: salvia-directories+ Main-is: DirectoryHandling.hs+ GHC-Options: -threaded -Wall -fno-warn-orphans+ HS-Source-Dirs: src
+ src/CgiDemo.hs view
@@ -0,0 +1,8 @@+module Main where++import Network.Salvia.Impl.Cgi+import Network.Salvia.Handler.ExtendedFileSystem++main :: IO ()+main = start "/code/salvia-extras" (hCgiEnv (hExtendedFileSystem ".")) ()+
+ src/Demo.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE FlexibleContexts, NoMonomorphismRestriction #-}+module Main where++import Control.Applicative+import Control.Concurrent+import Control.Concurrent.STM+import Data.FileStore+import Data.Maybe+import Data.Record.Label+import Network.Protocol.Http+import Network.Salvia+import Network.Salvia.Handler.ColorLog+import Network.Salvia.Handler.ExtendedFileSystem+import Network.Salvia.Handler.FileStore+import Network.Salvia.Handler.StringTemplate+import Network.Salvia.Handler.WebSocket+import Network.Salvia.Handler.Login+import Network.Salvia.Handler.Session+import Network.Socket hiding (Socket, send)+import Prelude hiding (read)+import System.IO+import qualified Control.Concurrent.ThreadManager as Tm+import qualified Control.Monad.State as S+import Paths_salvia_demo+-- At the bottom to prevent warnings (?)+import Control.Monad+import Control.Monad.Trans++main :: IO ()+main =+ do -- Index HTML template.+ let template tmpl =+ do s <- show . isJust . get sPayload <$> getSession+ u <- maybe "anonymous" (get username) <$> hGetUser+ c <- show . (+1) . unCounter <$> payload S.get+ hStringTemplate tmpl+ [ ("loggedin", s)+ , ("username", u)+ , ("counter", c)+ ]++ -- Handler environment to run handler in.+ let myHandlerEnv handler =+ do prolongSession (60 * 60) -- Expire after one hour of inactivity.+ hPortRouter+ [ ( 8080+ , hVirtualHosting+ [ ("localhost", hRedirect "http://127.0.0.1:8080/")+ ] handler)+ ] (hCustomError Forbidden "Public service running on port 8080.")+ hColorLogWithCounter stdout++ -- Data directories packed in Cabal package.+ www <- getDataFileName "www"+ db <- getDataFileName "www/data/users.db"+ cgi <- getDataFileName "www/demo.cgi"+ idx <- getDataFileName "www/index.html"++ tm <- Tm.make+ counter <- atomically (newTVar (Counter 0))+ ping <- atomically (newTMVar (0 :: Integer))+ sessions <- atomically (newTVar mkSessions) :: IO (TVar (Sessions (UserPayload Bool)))+ userDB <- read (fileBackend db) >>= atomically . newTVar+ addr <- inet_addr "0.0.0.0"++ let filestore repo = hFileStore (gitFileStore repo) (Author "sebas" "sfvisser@cs.uu.nl") repo++ let ws = lift (forker tm (hSendTMVar 100 ping show))+ >> hOnMessageUpdateTMVar 100 (const (+1)) ping++ let myHandler =+ (hDefaultEnv . myHandlerEnv)+ . hPrefixRouter+ [ ("/code", hExtendedFileSystem "src")+ , ("/store", filestore ".")+ ]+ . hPathRouter+ [ ("/", template idx)+ , ("/لغة عربية", hCustomError OK "arabic")+ , ("/Ελληνική", hCustomError OK "greek")+ , ("/Русский", hCustomError OK "russian")+ , ("/עִבְרִית", hCustomError OK "hebrew")+ , ("/ping", hWebSocket "myproto" (lift (hColorLogWithCounter stdout) >> ws))+ , ("/favicon.ico", hError BadRequest)+ , ("/loginfo", loginfo)+ , ("/logout", logout >> hRedirect "/")+ , ("/login", login unauth (const $ hRedirect "/"))+ , ("/signup", whenWriteAccess (signup ["read-udb"] unauth (const $ hRedirect "/")))+ , ("/users.db", whenReadAccess (hFileResource db))+ , ("/sources", hCGI cgi)+ ]+ $ (hExtendedFileSystem www)+ where+ unauth = hCustomError Unauthorized "unauthorized, please login"+ whenReadAccess = authorized (Just "read-udb") unauth . const+ whenWriteAccess = authorized (Just "write-udb") unauth . const++ let myPayload = userDB & counter & sessions++ let myConfig = defaultConfig+ { listenOn =+ [ SockAddrInet 8080 addr+ , SockAddrInet 9090 addr+ ] }++ start myConfig myHandler myPayload++forker :: (ForkM IO m, MonadIO m) => Tm.ThreadManager -> m () -> m ThreadId+forker tm = forkM >=> liftIO . Tm.fork tm+
+ src/DirectoryHandling.hs view
@@ -0,0 +1,21 @@+module Main where++import Network.Salvia.Handler.ColorLog+import Network.Salvia.Handlers+import Network.Salvia.Impl.Server+import Network.Salvia.Impl.Config+import Network.Salvia.Interface+import Network.Protocol.Http+import System.IO++main :: IO ()+main = + start + defaultConfig+ -- hPathRouter takes a list of paths and a default handler (in our case, a 404)+ (hDefaultEnv (do hPathRouter [ ("/erik", send "hi erik" )+ , ("/sebas", send "hi sebas")+ ]+ (hError NotFound)+ hColorLog stdout))+ ()
+ src/HelloWorld.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE FlexibleContexts #-}+module Main where++import Data.Record.Label+import Network.Protocol.Http+import Network.Salvia+import Network.Salvia.Handler.ColorLog+import System.IO++main :: IO ()+main = start + defaultConfig -- server configuration+ (hDefaultEnv (helloWorld >> hColorLog stdout)) -- handler in default environment+ () -- no server payload++-- Set the response content-type and send our HTML snippet.++helloWorld :: (SendM m, HttpM Response m) => m ()+helloWorld =+ do response (contentType =: Just ("text/html", Just "utf-8"))+ send "hello, <b>world</b>"+
+ src/QueryParams.hs view
@@ -0,0 +1,18 @@+module Main where++import Network.Salvia.Handler.ColorLog+import Network.Salvia.Handlers+import Network.Salvia.Impl.Server+import Network.Salvia.Impl.Config+import Network.Salvia.Interface+import System.IO++main :: IO ()+main = + start + defaultConfig+ -- This echoes the (parsed) query paramaters.+ (hDefaultEnv (do r <- hQueryParameters+ send (show r)+ hColorLog stdout))+ ()
+ src/ServeDemo.hs view
@@ -0,0 +1,28 @@+module Main where++import Network.C10kServer+import Network.Salvia.Handler.ColorLog+import Network.Salvia.Handler.ExtendedFileSystem+import Network.Salvia.Handlers+import Network.Salvia.Impl.C10k+import System.IO++main :: IO ()+main = + start "127.0.0.1" "root@localhost"+ C10kConfig+ { initHook = return ()+ , exitHook = \s -> putStrLn ("C10kServer error:" ++ s)+ , parentStartedHook = return ()+ , startedHook = return ()+ , sleepTimer = 10+ , preforkProcessNumber = 200+ , threadNumberPerProcess = 200+ , portName = "8080"+ , pidFile = "pid"+ , user = "sebas"+ , group = "wheel"+ }+ (hDefaultEnv (hExtendedFileSystem "." >> hColorLog stdout))+ ()+
+ www/data/users.db view
@@ -0,0 +1,2 @@+# user admin has password `a' and write access to this db.+admin root@admin.local 0cc175b9c0f1b6a831c399e269772661 read-udb write-udb
+ www/demo.cgi view
@@ -0,0 +1,16 @@+#!/bin/bash+echo -en "Content-Type: text/html; charset=utf-8\r\n"+echo -en "\r\n"++echo "CGI demo"+echo "<hr>"++echo "<pre>"+export+echo "</pre>"+echo "<hr>"++echo "<pre>"+cat `find src -name "*.hs"`+echo "</pre>"+
+ www/index.ccss view
@@ -0,0 +1,3 @@+body:+ background: #eee+
+ www/index.html view
@@ -0,0 +1,65 @@+<!doctype html>+<!-- html5! -->+<title>Salvia demo.</title>+<meta http-equiv=Content-Type content="text/html; charset=utf-8">+<meta charset=utf-8>+<link rel=stylesheet href=index.css type=text/css>++<header>+ <h1>Demo</h1>+ <p id=banner></p>+</header>++<ul>+ <li>Request counter: <span id=counter>$counter$</span></li>+ <li>+ Web Socket, ping counter: <span id=ping>$ping$</span>+ <a href="javascript:sendPing()"><strong>ping</strong></a>+ </li>+ <li><a href=/index.css>css file</a> (<a href=/index.ccss>CleverCSS source</a>)</li>+ <li><a href=/loginfo>session and login information</a></li>+ <li><a href=/signup.html>signup form</a></li>+ <li><a href=/login.html>login form</a></li>+ <li><a href=/logout>logout</a></li>+ <li><a href=/users.db>user database</a></li>+ <li>unicode urls:<br>+ <a href="/لغة عربية">arabic</a><br>+ <a href="/Ελληνική">greek</a><br>+ <a href="/Русский">russian</a><br>+ <a href="/עִבְרִית">hebrew</a>+ </li>+</ul>++<p>The following examples only works when this demo is run in the root directory of the salvia-demo package.<p>++<ul>+ <li><a href=/code/>source directory</a></li>+ <li><a href=/code/Demo.hs>this demo</a></li>+ <li><a href=/sources>CGI demo</a></li>+ <li>+ <a href=/store>filestore of this demo</a><br>+ <a href=/store/src/Demo.hs?history>history of this demo</a><br>+ <a href=/store/src/Demo.hs?9813f75>first version of this demo</a><br>+ </li>+</ul>++<script>+ if ("$username$") document.getElementById("banner").innerHTML = "Welcome: $username$!";++ var ws, open = false;++ function wsOpen ()+ {+ if (open) return;+ ws = new WebSocket("ws://127.0.0.1:8080/ping");+ ws.onmessage = function (a) { document.getElementById("ping").innerHTML = a.data; };+ ws.onopen = function (a) { open = true; document.getElementById("ping").innerHTML += " (waiting for initial data)"; };+ ws.onclose = function (a) { open = false; document.getElementById("ping").innerHTML = " (connection closed)"; };+ }++ wsOpen();+ setInterval(wsOpen, 100);++ function sendPing () { ws.send("ping!"); }+</script>+
+ www/login.html view
@@ -0,0 +1,19 @@+<!DOCTYPE html>+<!-- html5! -->+<title>Salvia login demo.</title>+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">+<meta charset="utf-8">++<header>+ <h1>Login</h1>+</header>++<form id="login" method="post" action="/login">+<fieldset>+ <legend>Fill in username and password to login.</legend>+ <p><label>Username: <input type="text" name="username" placeholder="username"></label></p>+ <p><label>Password: <input type="password" name="password" placeholder="password"></label></p>+ <input type="submit" value="login">+</fieldset>+</form>+
+ www/signup.html view
@@ -0,0 +1,20 @@+<!DOCTYPE html>+<!-- html5! -->+<title>Salvia signup demo.</title>+<meta http-equiv="Content-Type" content="text/html; charset=utf-8">+<meta charset="utf-8">++<header>+ <h1>Signup</h1>+</header>++<form id="signup" method="post" action="/signup">+<fieldset>+ <legend>Fill in username, password and email to signup.</legend>+ <p><label>Username: <input type="text" name="username" placeholder="username"></label></p>+ <p><label>Password: <input type="password" name="password" placeholder="password"></label></p>+ <p><label>Email: <input type="text" name="email" placeholder="email"></label></p>+ <input type="submit" value="signup">+</fieldset>+</form>+