Wheb 0.3.0.0 → 0.3.1.0

raw patch · 8 files changed

+96/−19 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Wheb.cabal +7/−2
• src/Web/Wheb.hs +13/−5
• src/Web/Wheb/Cookie.hs +9/−5
• src/Web/Wheb/Internal.hs +1/−1
• src/Web/Wheb/Plugins/Auth.hs +0/−1
• src/Web/Wheb/Plugins/Security.hs +57/−0
• src/Web/Wheb/Plugins/Session.hs +2/−4
• src/Web/Wheb/Utils.hs +7/−1

@@ -1,5 +1,5 @@ name:                Wheb-version:             0.3.0.0+version:             0.3.1.0 synopsis:            The frictionless WAI Framework license:             BSD3 license-file:        LICENSE@@ -22,6 +22,8 @@   .   * Easy to use for REST APIs   .+  * CSRF Protection+  .   * WebSockets   .   * Fully database and template agnostic@@ -118,7 +120,10 @@  library   default-language: Haskell2010-  exposed-modules:     Web.Wheb, Web.Wheb.Cookie, Web.Wheb.InitM, Web.Wheb.Internal, Web.Wheb.Routes, Web.Wheb.Types, Web.Wheb.Utils, Web.Wheb.WhebT, Web.Wheb.Plugins.Auth, Web.Wheb.Plugins.Session, Web.Wheb.Plugins.Cache, Web.Wheb.Plugins.Debug.MemoryBackend+  exposed-modules:     Web.Wheb, Web.Wheb.Cookie, Web.Wheb.InitM, Web.Wheb.Internal, +                       Web.Wheb.Routes, Web.Wheb.Types, Web.Wheb.Utils, Web.Wheb.WhebT, +                       Web.Wheb.Plugins.Auth, Web.Wheb.Plugins.Session, Web.Wheb.Plugins.Cache, +                       Web.Wheb.Plugins.Debug.MemoryBackend, Web.Wheb.Plugins.Security      build-depends:       base >= 4.7 && < 4.8,                         text >= 1.0 && < 1.2, 

@@ -40,6 +40,13 @@   , setHeader   , setRawHeader   +  -- * Cookies+  , setCookie+  , setCookie'+  , getCookie+  , getCookies+  , removeCookie+   -- * Settings   , getSetting   , getSetting'@@ -115,8 +122,9 @@   import Control.Monad.IO.Class (MonadIO(..))-import Web.Wheb.InitM (addCleanupHook, addDELETE, addGET, addPOST, addPUT, addRoute, addRoutes, addWhebSocket, addSetting, addSetting', addSettings, addSite, addWAIMiddleware, addWhebMiddleware, catchAll, generateOptions, genMinOpts, readSettingsFile)-import Web.Wheb.Routes ((</>), compilePat, grabInt, grabText, pS, pT, rootPat)-import Web.Wheb.Types (ChunkType(..), CSettings, WhebSocket, EResponse, HandlerData(..), HandlerResponse(..), InitM(..), InitOptions(..), InternalState(..), MethodMatch, MinHandler, MinOpts, MinWheb, PackedSite(..), ParsedChunk(..), Route(..), RouteParamList, SettingsValue(..), UrlBuildError(..), UrlParser(..), UrlPat(..), WhebContent(..), WhebError(..), WhebFile(..), WhebHandler, WhebHandlerT, WhebMiddleware, WhebOptions(..), WhebT(..))-import Web.Wheb.Utils (spack)-import Web.Wheb.WhebT (builder, runRawHandler, runRawHandlerT, file, redirect, throwRedirect, getApp, getHandlerState, getPOSTParam, getPOSTParams, getQueryParams, getRawPOST, getRequest, getRequestHeader, getRoute, getRoute', getRouteParam, getRouteParams, getSetting, getSetting', getSetting'', getSettings, getWithApp, getWithRequest, html, modifyHandlerState, modifyHandlerState', putHandlerState, runWhebServer, runWhebServerT, setHeader, setRawHeader, text)+import Web.Wheb.InitM +import Web.Wheb.Routes+import Web.Wheb.Types +import Web.Wheb.Utils+import Web.Wheb.WhebT +import Web.Wheb.Cookie

@@ -18,7 +18,7 @@ import Data.Time.Clock (secondsToDiffTime, UTCTime(UTCTime)) import Web.Cookie (CookiesText, def, renderSetCookie, SetCookie(..)) import Web.Wheb.Types-import Web.Wheb.WhebT (setRawHeader)+import Web.Wheb.WhebT (setRawHeader, getSetting'')  getDefaultCookie :: Monad m => WhebT g s m SetCookie getDefaultCookie = return def -- Populate with settings...@@ -26,14 +26,18 @@ setCookie :: Monad m => Text -> Text -> WhebT g s m () setCookie k v = getDefaultCookie >>= (setCookie' k v) +-- | Set a cookie. Looks up setting "enable-secure-cookies" to control turning+--  HTTPS only cookies on. This should be enabled on production environments. setCookie' :: Monad m => Text -> Text -> SetCookie -> WhebT g s m () setCookie' k v sc = do+  secureCookie <- getSetting'' "enable-secure-cookies" False+  let cookie = sc { setCookieName = TS.encodeUtf8 k+                  , setCookieValue = TS.encodeUtf8 v+                  , setCookieSecure = secureCookie+                  }+      cookieText = B.toByteString $ renderSetCookie cookie   setRawHeader ("Set-Cookie", cookieText)   WhebT $ modify (\a -> a {curCookies = [(k,v)] ++ (curCookies a)})-  where cookie = sc { setCookieName = TS.encodeUtf8 k-                    , setCookieValue = TS.encodeUtf8 v-                    }-        cookieText = B.toByteString $ renderSetCookie cookie          getCookies :: Monad m => WhebT g s m CookiesText getCookies = WhebT $ liftM (curCookies) get

@@ -60,7 +60,7 @@             finished <- either handleError return res             respond' finished         baseData   = HandlerData startingCtx r ([], []) [] opts-        parsedCookies = parseCookiesText $ (fromMaybe B.empty) $ (lookup $ CI.mk $ B.pack "Cookies") $ requestHeaders r+        parsedCookies = parseCookiesText $ (fromMaybe B.empty) $ (lookup $ CI.mk $ B.pack "Cookie") $ requestHeaders r         initOpts = opts {startingState = startingState {curCookies = parsedCookies}}         pathChunks = pathInfo r         stdMthd    = either (\_-> GET) id $ parseMethod $ requestMethod r

@@ -93,7 +93,6 @@     authSetUser cur     return Nothing - type UserKey = Text type Password = Text type PwHash = Text

@@ -0,0 +1,57 @@+{- | Provides middleware and view protection against CSRF attacks.+     To ensure maximum protection, turn on the setting "enable-secure-cookies".+-}++{-# LANGUAGE OverloadedStrings #-}++module Web.Wheb.Plugins.Security where++import Control.Monad+import Network.Wai+import Web.Wheb+import Web.Wheb.Utils+import Web.Wheb.Plugins.Session+import Data.Text as T+import Network.HTTP.Types++-- | A middleware to protect ALL incoming POST requests aginst CSRF, +--   throwing the handler upon failure+csrfMiddleware :: (MonadIO m) => WhebHandlerT g s m -> WhebMiddleware g s m+csrfMiddleware fail = do+    checkedOut <- csrfPassed+    if checkedOut then return Nothing else liftM Just fail++-- | Takes a handler to throw when CSRF fails and a handler to run when it succeeds+csrfProtect :: (MonadIO m) => WhebHandlerT g s m -> WhebHandlerT g s m -> WhebHandlerT g s m +csrfProtect fail pass = do+    checkedOut <- csrfPassed+    if checkedOut then pass else fail++-- | CSRF reads a cookie value ("csrf_token") and compares it to either +--   submitted post data (param "csrf_token") or request header ("X-CSRF-TOKEN")+csrfPassed :: (MonadIO m) => WhebT a b m Bool+csrfPassed = do+    method <- getWithRequest requestMethod+    case method == methodPost of+        False -> return True+        True -> do+            real_token <- getCSRFToken+            mPostTok <- getPOSTParam "csrf-token"+            case mPostTok of+                Just postTok -> return $ real_token == postTok+                Nothing -> do+                    mReqTok <- getRequestHeader "X-CSRF-TOKEN"+                    case mReqTok of+                        Just reqTok -> return $ real_token == reqTok+                        Nothing -> return $ False++-- | This will get or generate and set a new CSRF Token in the Cookies+getCSRFToken :: (MonadIO m) => WhebT a b m T.Text+getCSRFToken = do+    tok <- getCookie "csrf-token"+    case tok of+        Just t -> return t+        Nothing -> do+            newTok <- makeUUID+            setCookie "csrf-token" newTok+            return newTok

@@ -20,11 +20,9 @@ import Control.Monad.IO.Class (MonadIO(..)) import Data.Maybe (fromMaybe) import Data.Text (pack, Text)-import Data.Text.Encoding as T (decodeUtf8)-import Data.UUID (toASCIIBytes)-import Data.UUID.V4 (nextRandom) import Web.Wheb (getWithApp, WhebT) import Web.Wheb.Cookie (getCookie, setCookie)+import Web.Wheb.Utils (makeUUID)  -- | Initial pass on abstract plugin for Sessions. --   Possibly add support for Typable to ease typecasting.@@ -71,7 +69,7 @@      generateSessionKey :: (SessionApp a, MonadIO m) => WhebT a b m Text generateSessionKey = do-  newKey <- liftM (T.decodeUtf8 . toASCIIBytes) (liftIO nextRandom)+  newKey <- makeUUID   setCookie session_cookie_key newKey   return newKey 

@@ -2,6 +2,8 @@  module Web.Wheb.Utils where +import Control.Monad (liftM)+import Control.Monad.IO.Class (MonadIO(..)) import Blaze.ByteString.Builder (Builder, fromLazyByteString, toLazyByteString, toByteString) import Data.IORef (atomicModifyIORef, newIORef, readIORef) import Data.Monoid ((<>), Monoid(mappend, mempty))@@ -11,7 +13,9 @@ import qualified Data.Text.Lazy.Encoding as T (decodeUtf8, encodeUtf8) import Network.HTTP.Types.Status (status500) import Network.Wai (Response, responseBuilder, responseFile, responseLBS, responseToStream)-import Web.Wheb.Types (HandlerResponse(..), WhebContent(..), WhebError(..), WhebFile(..), WhebHandlerT)+import Web.Wheb.Types (HandlerResponse(..), WhebContent(..), WhebError(..), WhebFile(..), WhebHandlerT, WhebT)+import Data.UUID (toASCIIBytes)+import Data.UUID.V4 (nextRandom)  lazyTextToSBS = TS.encodeUtf8 . T.toStrict sbsToLazyText = T.fromStrict . TS.decodeUtf8@@ -39,6 +43,8 @@     streamingBody add flush     fmap (T.decodeUtf8 . toLazyByteString) $ readIORef builderRef +makeUUID :: (MonadIO m) => WhebT g s m TS.Text+makeUUID = liftM (TS.decodeUtf8 . toASCIIBytes) (liftIO nextRandom) ----------------------- Instances ------------------------ instance WhebContent Builder where   toResponse = responseBuilder