hack-middleware-clientsession (empty) → 0.0.0

raw patch · 4 files changed

+176/−0 lines, 4 filesdep +basedep +clientsessiondep +hacksetup-changed

Dependencies added: base, clientsession, hack, old-locale, predicates, time, web-encodings

Files

• Hack/Middleware/ClientSession.hs +118/−0
• LICENSE +25/−0
• Setup.lhs +7/−0
• hack-middleware-clientsession.cabal +26/−0

@@ -0,0 +1,118 @@+module Hack.Middleware.ClientSession+    ( clientsession+    -- * Generating keys+    , Word256+    , defaultKeyFile+    , getKey+    , getDefaultKey+    ) where++import Prelude hiding (exp)+import Hack+import Web.Encodings+import Data.List (partition, intercalate)+import Data.Function.Predicate (is, isn't, equals)+import Data.Maybe (fromMaybe)+import Web.ClientSession+import Data.Time.Clock (getCurrentTime, UTCTime, addUTCTime)+import Data.Time.LocalTime () -- Show instance of UTCTime+import Data.Time.Format (formatTime) -- Read instance of UTCTime+import System.Locale (defaultTimeLocale)+import Control.Monad (guard)++-- | Automatic encrypting and decrypting of client session data.+--+-- Using the clientsession package, this middleware handles automatic+-- encryption, decryption, checking, expiration and renewal of whichever+-- cookies you ask it to. For example, if you tell it to deal with the+-- cookie \"IDENTIFIER\", it will do the following:+--+-- * When you specify an \"IDENTIFIER\" value in your 'Response', it will+-- encrypt the value, along with the session expiration date and the+-- REMOTE_HOST of the user. It will then be set as a cookie on the client.+--+-- * When there is an incoming \"IDENTIFIER\" cookie from the user, it will+-- decrypt it and check both the expiration date and the REMOTE_HOST. If+-- everything matches up, it will set the \"IDENTIFIER\" value in+-- 'hackHeaders'.+--+-- * If the client sent an \"IDENTIFIER\" and the application does not set+-- a new value, this will reset the cookie to a new expiration date. This+-- way, you do not have sessions timing out every 20 minutes.+--+-- As far as security: clientsesion itself handles hashing and encrypting+-- the data to make sure that the user can neither see not tamper with it.+clientsession :: [String] -- ^ list of cookies to intercept+              -> Word256 -- ^ encryption key+              -> Middleware+clientsession cnames key app env = do+    let initCookiesRaw :: String+        initCookiesRaw = fromMaybe "" $ lookup "Cookie" $ http env+        nonCookies :: [(String, String)]+        nonCookies = filter (fst `isn't` (== "Cookie")) $ http env+        initCookies :: [(String, String)]+        initCookies = decodeCookies initCookiesRaw+        cookies, interceptCookies :: [(String, String)]+        (interceptCookies, cookies) = partition (fst `is` (`elem` cnames))+                                      initCookies+        cookiesRaw :: String+        cookiesRaw = intercalate "; " $ map (\(k, v) -> k ++ "=" ++ v)+                     cookies+        remoteHost :: String+        remoteHost = fromMaybe "" $ lookup "REMOTE_HOST" $ http env+    now <- getCurrentTime+    let convertedCookies =+            takeJusts $+            map (decodeCookie key now remoteHost) interceptCookies+    let env' = env { http = ("Cookie", cookiesRaw)+                            : filter (fst `equals` "Cookie") (http env)+                            ++ nonCookies+                   , hackHeaders = hackHeaders env ++ convertedCookies+                   }+    res <- app env'+    let (interceptHeaders, headers') = partition (fst `is` (`elem` cnames))+                                     $ headers res+    let twentyMinutes :: Int+        twentyMinutes = 20 * 60+    let exp = fromIntegral twentyMinutes `addUTCTime` now+    let formattedExp = formatTime defaultTimeLocale "%a, %d-%b-%Y %X %Z" exp+    let oldCookies = filter (\(k, _) -> not $ k `elem` map fst interceptHeaders) convertedCookies+    let newCookies = map (setCookie key exp formattedExp remoteHost) $+                     oldCookies ++ interceptHeaders+    let res' = res { headers = newCookies ++ headers' }+    return res'++takeJusts :: [Maybe a] -> [a]+takeJusts [] = []+takeJusts (Just x:rest) = x : takeJusts rest+takeJusts (Nothing:rest) = takeJusts rest++setCookie :: Word256+          -> UTCTime -- ^ expiration time+          -> String -- ^ formatted expiration time+          -> String -- ^ remote host+          -> (String, String) -> (String, String)+setCookie key exp fexp rhost (cname, cval) =+    ("Set-Cookie", cname ++ "=" ++ val ++ "; path=/; expires=" ++ fexp)+      where+        val = encrypt key $ show $ Cookie exp rhost cval++data Cookie = Cookie UTCTime String String deriving (Show, Read)+decodeCookie :: Word256 -- ^ key+             -> UTCTime -- ^ current time+             -> String -- ^ remote host field+             -> (String, String) -- ^ cookie pair+             -> Maybe (String, String)+decodeCookie key now rhost (cname, encrypted) = do+    decrypted <- decrypt key encrypted+    (Cookie exp rhost' val) <- mread decrypted+    guard $ exp > now+    guard $ rhost' == rhost+    guard $ val /= ""+    return (cname, val)++mread :: (Monad m, Read a) => String -> m a+mread s =+    case reads s of+        [] -> fail $ "Reading of " ++ s ++ " failed"+        ((x, _):_) -> return x

@@ -0,0 +1,25 @@+The following license covers this documentation, and the source code, except+where otherwise indicated.++Copyright 2008, Michael Snoyman. All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+  list of conditions and the following disclaimer.++* 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 THE COPYRIGHT HOLDERS "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 COPYRIGHT HOLDERS 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.

@@ -0,0 +1,7 @@+#!/usr/bin/env runhaskell++> module Main where+> import Distribution.Simple++> main :: IO ()+> main = defaultMain

@@ -0,0 +1,26 @@+name:            hack-middleware-clientsession+version:         0.0.0+license:         BSD3+license-file:    LICENSE+author:          Michael Snoyman <michael@snoyman.com>+maintainer:      Michael Snoyman <michael@snoyman.com>+synopsis:        Middleware for easily keeping session data in client cookies.+description:     Uses the clientsession package for automatic encryption,+                 hashing, expiring and renewing of sessions stored in+                 cookies on the client.+category:        Web+stability:       unstable+cabal-version:   >= 1.2+build-type:      Simple+homepage:        http://github.com/snoyberg/hack-middleware-clientsession/tree/master++library+    build-depends:   base >= 4 && < 5,+                     hack,+                     clientsession,+                     old-locale,+                     time >= 1.1.3,+                     predicates,+                     web-encodings+    exposed-modules: Hack.Middleware.ClientSession+    ghc-options:     -Wall