cgi-utils (empty) → 0.0

raw patch · 4 files changed

+187/−0 lines, 4 filesdep +basedep +cgidep +containerssetup-changed

Dependencies added: base, cgi, containers, mtl, random

Files

LICENSE +29/−0
Setup.hs +2/−0
cgi-utils.cabal +18/−0
src/Network/CGI/Session.hs +138/−0

+ LICENSE view

@@ -0,0 +1,29 @@+Copyright 2010 Chris Done. 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.++THIS SOFTWARE IS PROVIDED BY CHRIS DONE ``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 CHRIS DONE 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.++The views and conclusions contained in the software and documentation+are those of the authors and should not be interpreted as representing+official policies, either expressed or implied, of Chris Done.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ cgi-utils.cabal view

@@ -0,0 +1,18 @@+Name: cgi-utils+Version: 0.0+Maintainer: Chris Done (chrisdone@gmail.com)+Author: Chris Done (chrisdone@gmail.com)+Copyright: 2010 Chris Done+License: BSD3+Category: CGI, Web+Synopsis: Simple modular utilities for CGI/FastCGI (sessions, etc.)+Description: Simple modular utilities for CGI/FastCGI that one tends to always need including sessions state.+Homepage: http://github.com/chrisdone/haskell-cgi-utils+Build-Type: Simple+Cabal-Version: >= 1.2+License-File: LICENSE++Library+  Exposed-Modules: Network.CGI.Session+  Hs-Source-Dirs: src+  Build-Depends: base >= 2 && < 4, cgi, random, containers, mtl

+ src/Network/CGI/Session.hs view

@@ -0,0 +1,138 @@+module Network.CGI.Session +    (-- * Types+     Session+    ,Sessions+    ,SessionName+    ,SessionM+     -- * Initialising and querying/updating+    ,makeSessions+    ,initSession+    ,updateSession+    -- * A simple Session monad.+    ,runSessionCGI+    ,runSession+    ,sessionIns+    ,sessionDel+    ,sessionGet+    -- * Utilities+    ,makeSession+    ,getSession)+        where++import Control.Applicative+import Control.Concurrent.MVar (MVar,modifyMVar,readMVar,modifyMVar_,newMVar)+import Control.Monad.Trans (liftIO,lift)+import Control.Monad.State (StateT,evalStateT,get,modify)+import Foreign.Marshal.Alloc (alloca)+import Foreign.Storable (peek,sizeOf)+import Data.Function+import Data.List (nub)+import Data.Map (Map)+import qualified Data.Map as M+import System.IO (openBinaryFile,IOMode(ReadMode),hGetBuf,hClose)+import System.Random (mkStdGen,StdGen,randomRs)+import qualified Network.CGI as CGI++--------------------------------------------------------------------------------+-- Section: Sessions implementation+-- Keywords: sessions+-- Description: A poor man's implementation of sessions for CGI.++-- | A simple Session monad. Recommend you define your own.+type SessionM = StateT Session (CGI.CGIT IO)++-- | Initialise a session state and start a F/CGI process. This is a+--   bit of a pattern so I've included it here for convenience.+runSessionCGI :: SessionName+              -> (CGI.CGI CGI.CGIResult -> IO ())+              -> SessionM CGI.CGIResult+              -> IO ()+runSessionCGI name run m = do+  sessions <- makeSessions+  run $ CGI.handleErrors $ do+    session <- initSession name sessions+    runSession sessions m session++-- | Simple session runner.+runSession :: Sessions -> SessionM a -> Session -> CGI.CGI a+runSession sessions = evalStateT++-- | Session value getter.+sessionGet :: Read a => String -> SessionM (Maybe a)+sessionGet k = get >>= \Session{sess_values=vs} ->+           return $ read <$> M.lookup k vs++-- | Session value inserter/updater.+sessionIns :: (Read a,Show a) => String -> a -> (a -> a -> a) -> SessionM ()+sessionIns k v f =+    -- Technically the other two accessors could be defined in terms of this+    -- but it might confuse (me).+    modify $ \s@Session{sess_values = vs} ->+         s {sess_values = M.insertWith lf k (show v) vs }+            where lf = (show .) . (f `on` read)++-- | Session value deleter.+sessionDel ::  String -> SessionM ()+sessionDel k =+    modify $ \s@Session{sess_values = vs} ->+        s {sess_values = M.delete k vs }++-- | A session consists of a unique id and a map.+data Session = Session+    { sess_id     :: Integer+    , sess_values :: Map String String+    } deriving (Eq,Show)++-- | Sessions and unique ids are stored in an MVar.+type Sessions = MVar ([Integer],Map Integer Session)++-- | The cookie prefix (e.g. MYHASKELLCOOKIE).+type SessionName = String++-- | Make the sessions state.+makeSessions :: IO Sessions+makeSessions = genIds >>= newMVar . flip (,) M.empty++-- | Generate random.+genIds :: IO [Integer]+genIds = nub . randomRs (1,1000^(20::Int)) <$> betterStdGen++-- | An OK-ish random generator.+betterStdGen :: IO StdGen+betterStdGen = alloca $ \p -> do+    h <- openBinaryFile "/dev/urandom" ReadMode+    hGetBuf h p $ sizeOf (undefined :: Int)+    hClose h+    mkStdGen <$> peek p++-- | Grab the session or create a new one.+initSession :: SessionName -> Sessions -> CGI.CGI Session+initSession sessionName var = do+  s <- getSession sessionName var+  case s of+    Just s  -> return s+    Nothing -> makeSession sessionName var++-- | Create a new session and update the Mvar.+makeSession :: SessionName -> Sessions -> CGI.CGI Session+makeSession sessionName var = do+  sess <- liftIO $ modifyMVar var $ \state@(id:ids,sessions) ->+                let session = Session id M.empty+                    newState = (ids,M.insert id session sessions)+                in return (newState,session)+  CGI.setCookie (CGI.newCookie sessionName $ show $ sess_id sess)+         { CGI.cookiePath = Just "/" }+  return sess++-- | Try to get the current session.+getSession :: SessionName -> Sessions -> CGI.CGI (Maybe Session)+getSession sessionName var = do+  sId <- CGI.readCookie sessionName+  (ids,sessions) <- liftIO $ readMVar var+  return $ sId >>= flip M.lookup sessions++-- | Update a session in the map.+updateSession :: Sessions -> Session -> CGI.CGI ()+updateSession var session@(Session id _) = do+  liftIO $ modifyMVar_ var $ \(ids,sessions) -> do+    return (ids,M.insert id session sessions)