initial commit
This commit is contained in:
@@ -0,0 +1,3 @@
|
||||
*.cgi
|
||||
*.hi
|
||||
*.o
|
||||
@@ -0,0 +1,19 @@
|
||||
module App.Error (
|
||||
PageNotFound(..)
|
||||
) where
|
||||
|
||||
import Network.FastCGI
|
||||
import Network.URI
|
||||
import Template
|
||||
|
||||
import Request
|
||||
|
||||
data PageNotFound = PageNotFound
|
||||
|
||||
instance RequestHandler PageNotFound where
|
||||
handle handler = do
|
||||
uri <- requestURI
|
||||
let path = uriPath uri
|
||||
res <- render "error404" [ ("pagetitle", "Seite nicht gefunden")
|
||||
, ("path", path)]
|
||||
output res
|
||||
+16
@@ -0,0 +1,16 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module App.Info (
|
||||
Info(..)
|
||||
) where
|
||||
|
||||
import Request
|
||||
import Template
|
||||
import Network.FastCGI
|
||||
|
||||
data Info = Info
|
||||
|
||||
instance RequestHandler Info where
|
||||
handle handler = do
|
||||
result <- render "info" [("pagetitle", "Info")]
|
||||
output result
|
||||
@@ -0,0 +1,84 @@
|
||||
module App.Login (
|
||||
Login(..)
|
||||
) where
|
||||
|
||||
import Control.Monad.State (gets)
|
||||
|
||||
import Request
|
||||
import Template
|
||||
import Network.FastCGI
|
||||
import AppMonad (numVisited, App)
|
||||
import Database
|
||||
import Shared
|
||||
|
||||
data Login = Login
|
||||
| Register
|
||||
|
||||
instance RequestHandler Login where
|
||||
handle Login = do
|
||||
loginStatus <- isLoggedIn
|
||||
if loginStatus then alreadyLoggedIn else login
|
||||
handle Register = do
|
||||
loginStatus <- isLoggedIn
|
||||
if loginStatus then alreadyLoggedIn else register
|
||||
|
||||
loginSucceeded :: App CGIResult
|
||||
loginSucceeded = do
|
||||
mayFrom <- getInput "from"
|
||||
case mayFrom of
|
||||
Just from -> redirect from
|
||||
Nothing ->
|
||||
render "logged_in" [ ("pagetitle", "Angemeldet")
|
||||
, ("kind", "jetzt") ] >>= output
|
||||
|
||||
loginFailed :: App CGIResult
|
||||
loginFailed = do
|
||||
result <- render "login" [("pagetitle", "Anmelden"),
|
||||
("errormsg", "Ungültige Anmeldedaten")]
|
||||
output result
|
||||
|
||||
alreadyLoggedIn :: App CGIResult
|
||||
alreadyLoggedIn = do
|
||||
result <- render "logged_in" [ ("pagetitle", "Angemeldet")
|
||||
, ("kind", "bereits") ]
|
||||
output result
|
||||
|
||||
login :: App CGIResult
|
||||
login = do
|
||||
mayLogin <- sequence <$> sequence [getInput "username", getInput "password"]
|
||||
case mayLogin of
|
||||
Just [username, password] ->
|
||||
validate username password <: loginSucceeded <-> loginFailed
|
||||
Nothing -> do
|
||||
result <- render "login" [ ("pagetitle", "Anmelden")
|
||||
, ("errormsg", "") ]
|
||||
output result
|
||||
|
||||
register :: App CGIResult
|
||||
register = do
|
||||
mayRegister <- sequence <$> sequence [ getInput "username"
|
||||
, getInput "password"
|
||||
, getInput "confirm_password" ]
|
||||
case mayRegister of
|
||||
Just [username, password, password_confirm]
|
||||
| password /= password_confirm ->
|
||||
registerFailed "Passwörter stimmen nicht überein!"
|
||||
| otherwise -> isAvailable username <:
|
||||
goRegister username password <->
|
||||
registerFailed "Benutername wird schon verwendet!"
|
||||
Nothing -> do
|
||||
res <- render "register" [ ("pagetitle", "Registrierung")
|
||||
, ("errormsg", "") ]
|
||||
output res
|
||||
|
||||
goRegister :: Username -> Password -> App CGIResult
|
||||
goRegister username password = do
|
||||
addUser username password
|
||||
res <- render "registered" [("pagetitle", "Registrierung abgeschlossen")]
|
||||
output res
|
||||
|
||||
registerFailed :: String -> App CGIResult
|
||||
registerFailed reason = do
|
||||
res <- render "register" [ ("pagetitle", "Registrierung")
|
||||
, ("errormsg", reason ) ]
|
||||
output res
|
||||
@@ -0,0 +1,32 @@
|
||||
module App.Logout (
|
||||
Logout(..)
|
||||
) where
|
||||
|
||||
import Network.FastCGI
|
||||
|
||||
import Request
|
||||
import Database
|
||||
import AppMonad
|
||||
import Template
|
||||
|
||||
data Logout = Logout
|
||||
|
||||
instance RequestHandler Logout where
|
||||
handle handler = do
|
||||
loginStatus <- isLoggedIn
|
||||
if loginStatus then confirmLogout else redirect "/login"
|
||||
|
||||
confirmLogout :: App CGIResult
|
||||
confirmLogout = do
|
||||
method <- requestMethod
|
||||
case method of
|
||||
"POST" -> logout
|
||||
_ -> render "confirm_logout" [ ("pagetitle", "Abmelden") ] >>= output
|
||||
|
||||
logout :: App CGIResult
|
||||
logout = do
|
||||
deleteCookie $ newCookie "username" ""
|
||||
deleteCookie $ newCookie "login_string" ""
|
||||
res <- render "logged_out" [ ("pagetitle", "Abgemeldet")
|
||||
, ("kind", "jetzt")]
|
||||
output res
|
||||
@@ -0,0 +1,19 @@
|
||||
module App.Private (
|
||||
Private(..)
|
||||
) where
|
||||
|
||||
import Control.Monad.State (gets)
|
||||
|
||||
import Request
|
||||
import Template
|
||||
import Network.FastCGI
|
||||
import AppMonad (numVisited, App)
|
||||
import Database
|
||||
|
||||
data Private = Private
|
||||
|
||||
instance RequestHandler Private where
|
||||
requireLogin _ = True
|
||||
handle handler = do
|
||||
res <- render "private" [ ("pagetitle", "Geheimes Zeug") ]
|
||||
output res
|
||||
@@ -0,0 +1,22 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module App.Startpage (
|
||||
Startpage(..)
|
||||
) where
|
||||
|
||||
import Text.XHtml
|
||||
import Control.Monad.State (gets)
|
||||
|
||||
import Request
|
||||
import Template
|
||||
import Network.FastCGI
|
||||
import AppMonad (numVisited)
|
||||
|
||||
data Startpage = Startpage
|
||||
|
||||
instance RequestHandler Startpage where
|
||||
handle handler = do
|
||||
n <- gets numVisited
|
||||
result <- render "startpage" [("pagetitle", "Startseite"),
|
||||
("visited", show n)]
|
||||
output result
|
||||
+48
@@ -0,0 +1,48 @@
|
||||
{-# LANGUAGE FlexibleInstances,
|
||||
GeneralizedNewtypeDeriving #-}
|
||||
|
||||
module AppMonad (
|
||||
AppState(..), App, runApp, setHeistState, setNumVisited
|
||||
) where
|
||||
|
||||
import Control.Monad.State
|
||||
import Control.Monad.Catch
|
||||
|
||||
import Network.FastCGI
|
||||
import Network.CGI.Monad
|
||||
import Heist
|
||||
|
||||
import DatabaseData
|
||||
|
||||
data AppState = AppState { heist :: Maybe (HeistState App),
|
||||
numVisited :: Int,
|
||||
connection :: Connection }
|
||||
|
||||
setHeistState :: HeistState App -> AppState -> AppState
|
||||
setHeistState hs as = as { heist = Just hs }
|
||||
|
||||
setNumVisited :: Int -> AppState -> AppState
|
||||
setNumVisited n as = as { numVisited = n }
|
||||
|
||||
newtype AppT m a = App { getState :: StateT AppState (CGIT m) a }
|
||||
deriving (Monad, MonadIO, MonadState AppState,
|
||||
Applicative, Functor)
|
||||
|
||||
type App = AppT IO
|
||||
|
||||
instance MonadCGI (AppT IO) where
|
||||
cgiAddHeader n v = App . lift $ cgiAddHeader n v
|
||||
cgiGet x = App . lift $ cgiGet x
|
||||
|
||||
instance MonadThrow (AppT IO) where
|
||||
throwM e = App . lift $ throwM e
|
||||
|
||||
instance MonadCatch (AppT IO) where
|
||||
{-catch :: AppT IO a -> (e -> AppT IO a) -> AppT IO a-}
|
||||
catch (App x) f = App $ catch x (getState . f)
|
||||
|
||||
runApp :: AppState -> App CGIResult -> IO ()
|
||||
runApp as x = do
|
||||
let (App handled) = handleErrors x
|
||||
y = evalStateT handled as
|
||||
runFastCGIorCGI y
|
||||
+41
@@ -0,0 +1,41 @@
|
||||
{-# OPTIONS -Wall #-}
|
||||
|
||||
module Database (
|
||||
connect, addUser, validate, Connection, isLoggedIn, isAvailable,
|
||||
Username, Password
|
||||
) where
|
||||
|
||||
import Control.Monad.State
|
||||
|
||||
import Network.CGI
|
||||
|
||||
import AppMonad
|
||||
import DatabaseData
|
||||
import Shared
|
||||
|
||||
validate :: Username -> Password -> App Bool
|
||||
validate username password = do
|
||||
c <- gets connection
|
||||
isValid <- liftIO $ validateC c username password
|
||||
when isValid $ do
|
||||
setCookie $ newCookie "username" username
|
||||
(Just str) <- liftIO $ getLoginStringC c username
|
||||
setCookie $ newCookie "login_string" str
|
||||
return isValid
|
||||
|
||||
isLoggedIn :: App Bool
|
||||
isLoggedIn = defRunMaybeT False $ do
|
||||
c <- gets connection
|
||||
name <- MaybeT $ getCookie "username"
|
||||
loginString <- MaybeT $ getCookie "login_string"
|
||||
liftIO $ isLoggedInC c name loginString
|
||||
|
||||
isAvailable :: Username -> App Bool
|
||||
isAvailable username = do
|
||||
c <- gets connection
|
||||
liftIO $ isAvailableC c username
|
||||
|
||||
addUser :: Username -> Password -> App ()
|
||||
addUser username password = do
|
||||
c <- gets connection
|
||||
liftIO $ addUserC c username password
|
||||
@@ -0,0 +1,65 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# OPTIONS -Wall #-}
|
||||
|
||||
module DatabaseData (
|
||||
connect, addUserC, validateC, Connection, Username, Password,
|
||||
isLoggedInC, getLoginStringC, isAvailableC
|
||||
) where
|
||||
|
||||
import System.Random (newStdGen, randomRs)
|
||||
import Control.Monad.Trans (liftIO)
|
||||
|
||||
import qualified Crypto.Hash as C (SHA3_512, Digest, hash)
|
||||
import Data.ByteString.Char8 (ByteString, pack)
|
||||
|
||||
import Database.HDBC
|
||||
import Database.HDBC.PostgreSQL
|
||||
|
||||
import Shared
|
||||
|
||||
type Username = String
|
||||
type Password = String
|
||||
type Salt = String
|
||||
|
||||
connect :: IO Connection
|
||||
connect = connectPostgreSQL "user=christian dbname=haskweb"
|
||||
|
||||
addUserC :: Connection -> Username -> Password -> IO ()
|
||||
addUserC conn username password = do
|
||||
gen <- newStdGen
|
||||
let salt = take 32 $ randomRs ('a', 'z') gen
|
||||
hashed = hash (password ++ salt)
|
||||
_ <- run conn
|
||||
"INSERT INTO webuser (name, password, salt) VALUES (?, ?, ?)"
|
||||
[toSql username, toSql hashed, toSql salt]
|
||||
commit conn
|
||||
|
||||
getLoginC :: Connection -> Username -> MaybeT IO (Password, Salt)
|
||||
getLoginC conn username = do
|
||||
[[pwd, salt]] <- liftIO $ quickQuery' conn
|
||||
"SELECT password, salt FROM webuser WHERE name=?"
|
||||
[toSql username]
|
||||
return (fromSql pwd, fromSql salt)
|
||||
|
||||
validateC :: Connection -> Username -> Password -> IO Bool
|
||||
validateC conn username password = defRunMaybeT False (do
|
||||
(pwd, salt) <- getLoginC conn username
|
||||
return $ pwd == hash (password ++ salt) )
|
||||
|
||||
isLoggedInC :: Connection -> Username -> String -> IO Bool
|
||||
isLoggedInC conn username loginString = defRunMaybeT False (do
|
||||
(pwd, _) <- getLoginC conn username
|
||||
return $ hash (pwd ++ username) == loginString)
|
||||
|
||||
getLoginStringC :: Connection -> Username -> IO (Maybe String)
|
||||
getLoginStringC conn username = runMaybeT $ do
|
||||
(pwd, _) <- getLoginC conn username
|
||||
return $ hash (pwd ++ username)
|
||||
|
||||
isAvailableC :: Connection -> Username -> IO Bool
|
||||
isAvailableC conn username = do
|
||||
res <- quickQuery' conn "SELECT 1 FROM webuser WHERE name=?" [toSql username]
|
||||
return $ length res == 0
|
||||
|
||||
hash :: String -> String
|
||||
hash = show . (C.hash :: ByteString -> C.Digest C.SHA3_512) . pack
|
||||
@@ -0,0 +1,44 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# OPTIONS -Wall #-}
|
||||
|
||||
import System.Random
|
||||
import Control.Monad.Trans.Maybe
|
||||
import Control.Monad (guard)
|
||||
import Control.Monad.Trans
|
||||
import Data.Maybe
|
||||
|
||||
import qualified Crypto.Hash as C (SHA3_512, Digest, hash)
|
||||
import Data.ByteString.Char8 (ByteString, pack)
|
||||
|
||||
import Database.HDBC
|
||||
import Database.HDBC.PostgreSQL
|
||||
|
||||
type Username = String
|
||||
type Password = String
|
||||
|
||||
connect :: IO Connection
|
||||
connect = connectPostgreSQL "user=christian dbname=haskweb"
|
||||
|
||||
addUser :: Connection -> Username -> Password -> IO ()
|
||||
addUser conn username password = do
|
||||
gen <- newStdGen
|
||||
let salt = take 32 $ randomRs ('a', 'z') gen
|
||||
hashed = hash (password ++ salt)
|
||||
_ <- run conn
|
||||
"INSERT INTO webuser (name, password, salt) VALUES (?, ?, ?)"
|
||||
[toSql username, toSql hashed, toSql salt]
|
||||
commit conn
|
||||
|
||||
validate :: Connection -> Username -> Password -> IO Bool
|
||||
validate conn username password = fromMaybe False <$> runMaybeT (do
|
||||
res <- liftIO $ quickQuery' conn
|
||||
"SELECT password, salt FROM webuser WHERE name=?"
|
||||
[toSql username]
|
||||
guard $ length res == 1
|
||||
guard $ length (head res) == 2
|
||||
let [pwd, salt] = head res
|
||||
guard $ fromSql pwd == hash (password ++ fromSql salt)
|
||||
return True)
|
||||
|
||||
hash :: String -> String
|
||||
hash = show . (C.hash :: ByteString -> C.Digest C.SHA3_512) . pack
|
||||
@@ -0,0 +1,27 @@
|
||||
import Data.Maybe
|
||||
import Control.Monad.State (modify, gets)
|
||||
|
||||
import Network.FastCGI
|
||||
import Network.URI
|
||||
import Network.CGI
|
||||
|
||||
import Routing
|
||||
import AppMonad
|
||||
import Template
|
||||
import Database
|
||||
import Shared
|
||||
import Text.XHtml
|
||||
|
||||
cgiMain :: App CGIResult
|
||||
cgiMain = do
|
||||
initTemplates
|
||||
(fromMaybe 0) <$> read <$$> getCookie "visited" >>= modify . setNumVisited
|
||||
newCookie "visited" . show . (+1) <$> gets numVisited >>= setCookie
|
||||
uri <- requestURI
|
||||
routeRequest uri
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
conn <- connect
|
||||
let as = AppState Nothing 0 conn
|
||||
runApp as cgiMain
|
||||
+35
@@ -0,0 +1,35 @@
|
||||
{-# LANGUAGE ExistentialQuantification #-}
|
||||
|
||||
module Request (
|
||||
RequestHandler(..), handlePath
|
||||
) where
|
||||
|
||||
import Network.URI
|
||||
import Network.FastCGI
|
||||
import Text.Regex.PCRE
|
||||
import Database
|
||||
|
||||
import AppMonad
|
||||
|
||||
class RequestHandler a where
|
||||
handle :: a -> App CGIResult
|
||||
requireLogin :: a -> Bool
|
||||
requireLogin _ = False
|
||||
handleRequest :: a -> App CGIResult
|
||||
handleRequest x = do
|
||||
status <- isLoggedIn
|
||||
path <- uriPath <$> requestURI
|
||||
if not status && requireLogin x
|
||||
then redirect $ "/login?from=" ++ path
|
||||
else handle x
|
||||
|
||||
data RH = forall h. RequestHandler h => RH h
|
||||
|
||||
instance RequestHandler RH where
|
||||
requireLogin (RH x) = requireLogin x
|
||||
handle (RH x) = handle x
|
||||
|
||||
handlePath :: RequestHandler a => String -> String -> a -> Maybe RH
|
||||
handlePath path pattern handler
|
||||
| path =~ pattern = Just (RH handler)
|
||||
| otherwise = Nothing
|
||||
+31
@@ -0,0 +1,31 @@
|
||||
module Routing (
|
||||
routeRequest
|
||||
) where
|
||||
|
||||
import Control.Applicative ((<|>))
|
||||
|
||||
import Network.URI
|
||||
import Network.FastCGI
|
||||
|
||||
import App.Startpage
|
||||
import App.Info
|
||||
import App.Login
|
||||
import App.Logout
|
||||
import App.Error
|
||||
import App.Private
|
||||
|
||||
import Request
|
||||
import AppMonad
|
||||
|
||||
routeRequest :: URI -> App CGIResult
|
||||
routeRequest uri = do
|
||||
let path = uriPath uri
|
||||
mayHandler = handlePath path "^/info" Info
|
||||
<|> handlePath path "^/login" Login
|
||||
<|> handlePath path "^/logout" Logout
|
||||
<|> handlePath path "^/register" Register
|
||||
<|> handlePath path "^/private" Private
|
||||
<|> handlePath path "^/$" Startpage
|
||||
case mayHandler of
|
||||
Just handler -> handleRequest handler
|
||||
Nothing -> handleRequest PageNotFound
|
||||
@@ -0,0 +1,27 @@
|
||||
module Shared (
|
||||
defRunMaybeT, (<$$>), MaybeT(..), ifF, ifM, (<:), (<->)
|
||||
) where
|
||||
|
||||
import Data.Maybe
|
||||
import Control.Monad.Trans.Maybe
|
||||
|
||||
defRunMaybeT :: Monad m => a -> MaybeT m a -> m a
|
||||
defRunMaybeT defValue m = fromMaybe defValue <$> runMaybeT m
|
||||
|
||||
(<$$>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)
|
||||
(<$$>) = fmap . fmap
|
||||
|
||||
ifF :: Bool -> a -> a -> a
|
||||
ifF cond x y = if cond then x else y
|
||||
|
||||
ifF' :: a -> a -> Bool -> a
|
||||
ifF' x y cond = if cond then x else y
|
||||
|
||||
ifM :: Monad m => m Bool -> m a -> m a -> m a
|
||||
ifM cond m1 m2 = cond >>= ifF' m1 m2
|
||||
|
||||
(<:) :: Monad m => m Bool -> m a -> m a -> m a
|
||||
(<:) = ifM
|
||||
|
||||
(<->) :: (a -> b) -> a -> b
|
||||
(<->) = ($)
|
||||
+54
@@ -0,0 +1,54 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# OPTIONS -Wall #-}
|
||||
|
||||
module Template (
|
||||
initTemplates, render, Context
|
||||
) where
|
||||
|
||||
import Control.Monad.State
|
||||
import Data.ByteString.Char8 (pack)
|
||||
import Data.Binary.Builder
|
||||
import Control.Lens (set)
|
||||
import Data.ByteString.Lazy (toStrict)
|
||||
import qualified Data.Text as T (pack, unpack)
|
||||
import Data.Text.Encoding
|
||||
|
||||
import Heist
|
||||
import Heist.Interpreted
|
||||
|
||||
import AppMonad
|
||||
import Database
|
||||
|
||||
type TemplateName = String
|
||||
|
||||
type Context = [(String, String)]
|
||||
|
||||
basePath :: FilePath
|
||||
basePath = "/home/christian/work/haskell/haskweb/"
|
||||
|
||||
heistConfig :: HeistConfig App
|
||||
heistConfig =
|
||||
(set hcNamespace "") $
|
||||
(set hcLoadTimeSplices defaultLoadTimeSplices) $
|
||||
(set hcTemplateLocations [loadTemplates $ basePath ++ "templates"]) $
|
||||
emptyHeistConfig
|
||||
|
||||
initTemplates :: App ()
|
||||
initTemplates = do
|
||||
heistState <- liftIO $ either (error . concat) id
|
||||
<$> initHeist heistConfig
|
||||
modify $ setHeistState heistState
|
||||
|
||||
render :: TemplateName -> Context -> App String
|
||||
render tpl oldContext = do
|
||||
hs <- maybe (error "Template engine not initialized!") id <$> gets heist
|
||||
loginStatus <- isLoggedIn
|
||||
let context = ("login_path", if loginStatus then "/logout" else "/login") :
|
||||
("login_name", if loginStatus then "Abmelden" else "Anmelden") :
|
||||
oldContext
|
||||
hs' = foldr (\(k, v) h -> bindString (T.pack k) (T.pack v) h) hs context
|
||||
mayBuilder <- renderTemplate hs' (pack tpl)
|
||||
case mayBuilder of
|
||||
Just (builder, _) ->
|
||||
return . T.unpack . decodeUtf8 . toStrict . toLazyByteString $ builder
|
||||
Nothing -> return $ "Could not load template!"
|
||||
@@ -0,0 +1,23 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
import qualified Data.ByteString as B
|
||||
import Blaze.ByteString.Builder (toByteStringIO)
|
||||
import Control.Applicative
|
||||
import Control.Monad.Trans.Either (runEitherT)
|
||||
import Heist
|
||||
import Heist.Compiled (renderTemplate)
|
||||
import Control.Lens
|
||||
|
||||
heistConfig =
|
||||
(set hcNamespace "") $
|
||||
-- (set hcInterpretedSplices defaultInterpretedSplices) $
|
||||
(set hcLoadTimeSplices defaultLoadTimeSplices) $
|
||||
(set hcTemplateLocations [loadTemplates "."]) $
|
||||
emptyHeistConfig
|
||||
|
||||
main = do
|
||||
heistState <- either (error "oops") id <$>
|
||||
(runEitherT $ initHeist heistConfig)
|
||||
builder <- maybe (error "oops") fst $
|
||||
renderTemplate heistState "billy"
|
||||
toByteStringIO B.putStr builder
|
||||
@@ -0,0 +1,36 @@
|
||||
# configuration of the server
|
||||
server {
|
||||
# the port your site will be served on
|
||||
listen 80;
|
||||
# the domain name it will serve for
|
||||
server_name .example.com; # substitute your machine's IP address or FQDN
|
||||
charset utf-8;
|
||||
|
||||
# max upload size
|
||||
client_max_body_size 75M; # adjust to taste
|
||||
|
||||
location /css {
|
||||
alias /home/christian/work/haskell/haskweb/templates/css;
|
||||
}
|
||||
|
||||
# Finally, send all non-media requests to the Django server.
|
||||
location / {
|
||||
#include /home/christian/work/repos/areion_web/uwsgi_params;
|
||||
fastcgi_pass 127.0.0.1:9000;
|
||||
fastcgi_param QUERY_STRING $query_string;
|
||||
fastcgi_param REQUEST_METHOD $request_method;
|
||||
fastcgi_param CONTENT_TYPE $content_type;
|
||||
fastcgi_param CONTENT_LENGTH $content_length;
|
||||
fastcgi_param SCRIPT_FILENAME $document_root$fastcgi_script_name;
|
||||
fastcgi_param SCRIPT_NAME $fastcgi_script_name;
|
||||
fastcgi_param REQUEST_URI $request_uri;
|
||||
fastcgi_param DOCUMENT_URI $document_uri;
|
||||
fastcgi_param DOCUMENT_ROOT $document_root;
|
||||
fastcgi_param SERVER_PROTOCOL $server_protocol;
|
||||
fastcgi_param REMOTE_ADDR $remote_addr;
|
||||
fastcgi_param REMOTE_PORT $remote_port;
|
||||
fastcgi_param SERVER_ADDR $server_addr;
|
||||
fastcgi_param SERVER_PORT $server_port;
|
||||
fastcgi_param SERVER_NAME $server_name;
|
||||
}
|
||||
}
|
||||
@@ -0,0 +1,4 @@
|
||||
#!/bin/bash
|
||||
ghc --make -o Main.cgi Main.hs
|
||||
|
||||
sudo service haskweb restart
|
||||
@@ -0,0 +1,30 @@
|
||||
<html>
|
||||
<head>
|
||||
<title> <pagetitle/> </title>
|
||||
<link href="/css/base.css" rel="stylesheet" type="text/css">
|
||||
<meta charset="utf8">
|
||||
</head>
|
||||
|
||||
<body>
|
||||
<!-- START OF MAIN -->
|
||||
<div id="main">
|
||||
<!-- HEADER -->
|
||||
<div id="header">
|
||||
<apply template="header"/>
|
||||
</div>
|
||||
|
||||
<div id="content">
|
||||
<apply-content />
|
||||
</div>
|
||||
|
||||
</div>
|
||||
<!-- END OF MAIN -->
|
||||
|
||||
<!-- FOOTER -->
|
||||
<div id="footer">
|
||||
<apply template="footer"/>
|
||||
</div>
|
||||
|
||||
</body>
|
||||
|
||||
</html>
|
||||
@@ -0,0 +1,12 @@
|
||||
<apply template="base">
|
||||
<div class="singlecolumn">
|
||||
<h2>Logout</h2>
|
||||
|
||||
<p>Willst du dich wirklich abmelden?</p>
|
||||
|
||||
<form method="post">
|
||||
<input type="submit" value="Abmelden">
|
||||
</form>
|
||||
</div>
|
||||
|
||||
</apply>
|
||||
@@ -0,0 +1,211 @@
|
||||
body,html{
|
||||
font-size: 16px;
|
||||
font-family: "Georgia", serif;
|
||||
line-height: 29px;
|
||||
color:#0c1a30;
|
||||
padding:0;
|
||||
height: 100%;
|
||||
margin: 0 0 1px;
|
||||
}
|
||||
|
||||
#main{
|
||||
background:#fff scroll repeat-x 0px -100px;
|
||||
margin: 0;
|
||||
padding: 0;
|
||||
width:100%;
|
||||
min-height: 100%;
|
||||
/*background: #FFFFFF;*/
|
||||
}
|
||||
|
||||
#content {
|
||||
width: 960px;
|
||||
margin: 0 auto;
|
||||
overflow:hidden;
|
||||
position: relative;
|
||||
}
|
||||
|
||||
h1 {
|
||||
font-size: 22px;
|
||||
}
|
||||
|
||||
h2{
|
||||
font-size: 22px;
|
||||
}
|
||||
|
||||
h3 a:link, h3 a:visited, h2 a:link, h2 a:visited {
|
||||
color: #2C558A;
|
||||
}
|
||||
|
||||
h3 {
|
||||
font-size: 19px;
|
||||
}
|
||||
|
||||
h4 {
|
||||
font-size: 17px;
|
||||
}
|
||||
|
||||
h1,h2,h3,h4{
|
||||
color: #2c558a;
|
||||
font-weight: normal;
|
||||
text-shadow: #fff 0px 1px 1px;
|
||||
letter-spacing:0.1em;
|
||||
font-family: "Gill Sans", "PT Sans", "Arial", sans-serif;
|
||||
text-transform: uppercase;
|
||||
}
|
||||
|
||||
ul {
|
||||
list-style: none;
|
||||
margin: 0 0 29px 10px;
|
||||
padding-left: 10px;
|
||||
text-indent: -13px;
|
||||
}
|
||||
|
||||
p.error {
|
||||
color: #EE3333;
|
||||
}
|
||||
|
||||
a:link,a:visited{
|
||||
color: #2B7EA1;
|
||||
text-decoration: none;
|
||||
}
|
||||
|
||||
#footer {
|
||||
color: green;
|
||||
}
|
||||
|
||||
#header {
|
||||
background-color: white;
|
||||
}
|
||||
|
||||
#heading {
|
||||
width: 100%;
|
||||
background: #132742 url(nav-back.png) scroll repeat-x bottom left;
|
||||
color: #C4E7FF;
|
||||
padding: 25px 0 0 0;
|
||||
margin:0;
|
||||
height: 60px;
|
||||
overflow:hidden;
|
||||
}
|
||||
|
||||
#heading .inner{
|
||||
width: 960px;
|
||||
margin:0 auto;
|
||||
overflow:hidden;
|
||||
line-height: 1em;
|
||||
vertical-align: top;
|
||||
height: 100px;
|
||||
padding: 0;
|
||||
position: relative;
|
||||
/*height: 4em;*/
|
||||
}
|
||||
|
||||
#heading h1 {
|
||||
margin:0;
|
||||
padding: 0;
|
||||
margin: 0 auto;
|
||||
position: absolute;
|
||||
top: 10px;
|
||||
left: 50px;
|
||||
vertical-align: top;
|
||||
}
|
||||
|
||||
#heading img {
|
||||
width: 32px;
|
||||
margin:0;
|
||||
padding: 0;
|
||||
margin: 0 auto;
|
||||
position: absolute;
|
||||
top: 0px;
|
||||
left: 0px;
|
||||
vertical-align: top;
|
||||
}
|
||||
|
||||
#title a {
|
||||
color: fff;
|
||||
}
|
||||
|
||||
#nav {
|
||||
overflow: hidden;
|
||||
color: #C4E7FF;
|
||||
height: 36px;
|
||||
padding: 4px 0 0 0; margin: 0;
|
||||
float: right;
|
||||
}
|
||||
|
||||
#nav ul {
|
||||
padding: 0;
|
||||
margin: 0;
|
||||
height: 100%;
|
||||
display: inline;
|
||||
}
|
||||
|
||||
#nav li {
|
||||
vertical-align: top;
|
||||
padding: 15 0 10px 0;
|
||||
height: 30px;
|
||||
display: block;
|
||||
list-style-type: none;
|
||||
float: left;
|
||||
letter-spacing: -0.01em;
|
||||
margin: 0 20px;
|
||||
font-family: "Droid Sans", sans-serif;
|
||||
text-shadow: 1px 1px #142845;
|
||||
}
|
||||
|
||||
#nav a:link, #nav a:visited {
|
||||
color: inherit;
|
||||
vertical-align: top;
|
||||
height: 100%;
|
||||
display: block;
|
||||
}
|
||||
|
||||
#nav a:hover, #nav a:active {
|
||||
color: #fff;
|
||||
vertical-align: top;
|
||||
height: 100%;
|
||||
display: block;
|
||||
}
|
||||
|
||||
a.nolink:link, a.nolink:visited {
|
||||
text-decoration: none;
|
||||
color: #FF3333;
|
||||
}
|
||||
|
||||
a.nolink:hover {
|
||||
text-decoration: underline;
|
||||
}
|
||||
|
||||
.singlecolumn h2 {
|
||||
line-height: 44px;
|
||||
border-bottom: 1px solid #C2D1E1;
|
||||
margin-bottom: 13px;
|
||||
padding: 0px;
|
||||
}
|
||||
|
||||
#footer {
|
||||
position: relative;
|
||||
top: 0;
|
||||
left: 0;
|
||||
width: 100%;
|
||||
clear: both;
|
||||
border-top: 1px solid #C2D1E1;
|
||||
color: #a0acba;
|
||||
padding: 4px 0px;
|
||||
height: 31px;
|
||||
font-family: "PT Sans", sans-serif;
|
||||
font-size: 0.75em;
|
||||
text-align: right;
|
||||
background: #f5f9ff;
|
||||
vertical-align: middle;
|
||||
line-height: 31px;
|
||||
overflow: hidden;
|
||||
}
|
||||
|
||||
#footer p {
|
||||
padding: 0 20px;
|
||||
margin: 0;
|
||||
}
|
||||
|
||||
#footer p.left {
|
||||
float: left;
|
||||
}
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 5.0 KiB |
File diff suppressed because it is too large
Load Diff
|
After Width: | Height: | Size: 63 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 423 B |
@@ -0,0 +1,13 @@
|
||||
<apply template="base">
|
||||
<div class="singlecolumn">
|
||||
<h2>Seite nicht gefunden</h2>
|
||||
<p>
|
||||
Die seite <path/> existiert nicht. Vielleicht war der Link veraltet.
|
||||
<a href="/">Hier</a> kommst du wieder zur Startseite.
|
||||
</p>
|
||||
|
||||
<p>
|
||||
Bei weiteren Problemene kannst du dich an den Systemadministrator wenden.
|
||||
</p>
|
||||
</div>
|
||||
</apply>
|
||||
@@ -0,0 +1,2 @@
|
||||
<p class="left">Powered by Haskell und FastCGI</p>
|
||||
<p>Copyright (C) Christian Merten 2017</p>
|
||||
@@ -0,0 +1,15 @@
|
||||
<div id="heading">
|
||||
<div class="inner">
|
||||
<img src="/css/logo.png">
|
||||
<h1 id="title"><a href="/">Haskweb</a></h1>
|
||||
|
||||
<div id="nav">
|
||||
|
||||
<ul id="navlist">
|
||||
<li><a href="/">Home</a></li>
|
||||
<li><a href="/info">About</a></li>
|
||||
<li><a href="${login_path}"><login_name/></a></li>
|
||||
</ul>
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
@@ -0,0 +1,3 @@
|
||||
<apply template="base">
|
||||
<p>Hier gibts tolle Infos!</p>
|
||||
</apply>
|
||||
@@ -0,0 +1,7 @@
|
||||
<apply template="base">
|
||||
<div class="singlecolumn">
|
||||
<h2>Login</h2>
|
||||
<p>Du bist <kind/> angemeldet!</p>
|
||||
<p><a href="/logout">Hier</a> kannst du dich abmelden.</p>
|
||||
</div>
|
||||
</apply>
|
||||
@@ -0,0 +1,8 @@
|
||||
<apply template="base">
|
||||
<div class="singlecolumn">
|
||||
<h2>Login</h2>
|
||||
<p>Du bist <kind/> abgemeldet!</p>
|
||||
<p><a href="/login">Hier</a> kannst du dich anmelden.</p>
|
||||
</div>
|
||||
|
||||
</apply>
|
||||
@@ -0,0 +1,20 @@
|
||||
<apply template="base">
|
||||
<div class="singlecolumn">
|
||||
<h2>Login</h2>
|
||||
|
||||
<p>
|
||||
Hier kannst du dich anmelden, um auf geschützte Bereiche zuzugreifen.<br>
|
||||
Du hast noch keine Account? Dann kann du dich <a href="/register">hier</a> registrieren.<br>
|
||||
</p>
|
||||
|
||||
<p class="error"><errormsg/>
|
||||
<form method="post">
|
||||
Benutzername:<br>
|
||||
<input type="text" name="username"><br>
|
||||
Passwort:<br>
|
||||
<input type="password" name="password"><br><br>
|
||||
<input type="submit" value="Anmelden">
|
||||
</form>
|
||||
</div>
|
||||
|
||||
</apply>
|
||||
@@ -0,0 +1,9 @@
|
||||
<apply template="base">
|
||||
<div class="singlecolumn">
|
||||
<h2>Geheimes Zeug</h2>
|
||||
<p>
|
||||
Jetzt kannst du die spannenden Sachen sehen, für die
|
||||
man angemeldet sein muss!
|
||||
</p>
|
||||
</div>
|
||||
</apply>
|
||||
@@ -0,0 +1,21 @@
|
||||
<apply template="base">
|
||||
<div class="singlecolumn">
|
||||
<h2>Registrierung</h2>
|
||||
<p>
|
||||
Hier kannst du dich registrieren.<br>
|
||||
Du hast schon einen Account? Dann melde dich <a href="/login">hier</a> an.<br>
|
||||
</p>
|
||||
|
||||
<p class="error"><errormsg/>
|
||||
<form method="post">
|
||||
Benutzername:<br>
|
||||
<input type="text" name="username"><br>
|
||||
Passwort:<br>
|
||||
<input type="password" name="password"><br>
|
||||
Passwort bestätigen:<br>
|
||||
<input type="password" name="confirm_password"><br><br>
|
||||
<input type="submit" value="Anmelden">
|
||||
</form>
|
||||
</div>
|
||||
|
||||
</apply>
|
||||
@@ -0,0 +1,10 @@
|
||||
<apply template="base">
|
||||
<div class="singlecolumn">
|
||||
<h2>Registrierung abgeschlossen</h2>
|
||||
<p>
|
||||
Du hast dich erfolgreich registriert.<br>
|
||||
<a href="/login">Hier</a> gehts zur Anmeldung.
|
||||
</p>
|
||||
</div>
|
||||
|
||||
</apply>
|
||||
@@ -0,0 +1,25 @@
|
||||
<apply template="base">
|
||||
<div class="singlecolumn">
|
||||
<h2>Startseite</h2>
|
||||
|
||||
<p>
|
||||
Das ist die Startseite der tollen Webseite!
|
||||
Du wart hier heute schon <b><visited/></b> mal!<br>
|
||||
Schau dich hier ruhig um, es gibt total viel tolles zu sehen! Jede
|
||||
Menge sinnloser Text! Vielleicht wird es hier in Zukunft auch
|
||||
die ein oder andere Dokumentation zu sehen geben.
|
||||
</p>
|
||||
|
||||
<h3>Neuigkeiten</h3>
|
||||
<p>
|
||||
Hier werden tolle Informationen veröffentlicht! Aktuell gibt es aber
|
||||
nichts neues! Vielleicht ja später mal! Es lohnt sich definitiv
|
||||
hier nicht regelmäßig vorbei zu schauen, da sich hier eh nichts
|
||||
ändert!
|
||||
</p>
|
||||
|
||||
<h3>Lala</h3>
|
||||
<p>Ab und zu steht hier auch mal sinnvolles Zeug, meistens aber nur Müll!</p>
|
||||
|
||||
</div>
|
||||
</apply>
|
||||
Reference in New Issue
Block a user