apiary-clientsession (empty) → 0.7.0.0
raw patch · 5 files changed
+185/−0 lines, 5 filesdep +apiarydep +apiary-cookiedep +basesetup-changed
Dependencies added: apiary, apiary-cookie, base, bytestring, clientsession, data-default-class, mtl, tagged, time
Files
- LICENSE +20/−0
- Setup.hs +2/−0
- apiary-clientsession.cabal +39/−0
- src/Web/Apiary/ClientSession.hs +19/−0
- src/Web/Apiary/ClientSession/Internal.hs +105/−0
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2014 Hirotomo Moriwaki++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ apiary-clientsession.cabal view
@@ -0,0 +1,39 @@+name: apiary-clientsession+version: 0.7.0.0+synopsis: clientsession support for apiary web framework.+description:+ example: <https://github.com/philopon/apiary/blob/master/examples/auth.hs>+license: MIT+license-file: LICENSE+author: HirotomoMoriwaki<philopon.dependence@gmail.com>+maintainer: HirotomoMoriwaki<philopon.dependence@gmail.com>+Homepage: https://github.com/philopon/apiary+Bug-reports: https://github.com/philopon/apiary/issues+copyright: (c) 2014 Hirotomo Moriwaki+category: Web+build-type: Simple+stability: experimental+-- extra-source-files: +cabal-version: >=1.10++library+ exposed-modules: Web.Apiary.ClientSession+ other-modules: Web.Apiary.ClientSession.Internal+ other-extensions: + build-depends: base >=4.6 && <4.8+ , mtl >=2.1 && <2.3+ , bytestring >=0.10 && <0.11+ , apiary >=0.7 && <0.8+ , apiary-cookie >=0.7 && <0.8+ , clientsession >=0.9 && <0.10+ , tagged >=0.7 && <0.8+ , time >=1.4 && <1.5+ , data-default-class >=0.0 && <0.1++ hs-source-dirs: src+ ghc-options: -O2 -Wall+ default-language: Haskell2010++source-repository head+ type: git+ location: git://github.com/philopon/apiary.git
+ src/Web/Apiary/ClientSession.hs view
@@ -0,0 +1,19 @@+module Web.Apiary.ClientSession+ ( HasSession+ , SessionConfig(..)+ , withSession+ -- * setter+ , setSession+ , setSessionWith+ , setRawSession+ -- * filter+ , session+ -- * Reexport+ -- | def+ , module Data.Default.Class+ , module Web.Apiary.Cookie+ ) where++import Data.Default.Class+import Web.Apiary.ClientSession.Internal+import Web.Apiary.Cookie
+ src/Web/Apiary/ClientSession/Internal.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ImplicitParams #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE RecordWildCards #-}++module Web.Apiary.ClientSession.Internal where++import Control.Monad.Trans++import Web.Apiary hiding (Default(..))+import Web.Apiary.Cookie+import Web.Apiary.Cookie.Internal+import Web.ClientSession +import Data.Proxy+import Data.Time+import Data.Default.Class++import Control.Monad.Apiary.Filter.Internal+import Control.Monad.Apiary.Filter.Internal.Strategy++import qualified Data.ByteString as S++data Session = Session+ { key :: Key+ , maxAge' :: Maybe DiffTime+ , path' :: Maybe S.ByteString+ , domain' :: Maybe S.ByteString+ , httpOnly' :: Bool+ , secure' :: Bool+ }++data SessionConfig = SessionConfig+ { keyFile :: FilePath+ , maxAge :: Maybe DiffTime+ , path :: Maybe S.ByteString+ , domain :: Maybe S.ByteString+ , httpOnly :: Bool+ , secure :: Bool+ }++instance Default SessionConfig where+ def = SessionConfig+ defaultKeyFile (Just (24 * 60 * 60)) Nothing Nothing True True++type HasSession = ?webApiaryClientSessionSession :: Session++cond :: (a -> Bool) -> (a -> b) -> (a -> b) -> a -> b+cond p t f a = if p a then t a else f a++withSession :: MonadIO m => SessionConfig -> (HasSession => m b) -> m b+withSession SessionConfig{..} m = do+ k <- liftIO $ getKey keyFile+ let ?webApiaryClientSessionSession = Session+ k maxAge path domain httpOnly secure+ m++setMaxAge :: SetCookie -> Maybe DiffTime -> IO SetCookie+setMaxAge s (Just a) = do+ t <- getCurrentTime+ return s { setCookieExpires = Just $ addUTCTime (realToFrac a) t+ , setCookieMaxAge = Just a+ }+setMaxAge s Nothing = return s++encryptValue :: HasSession => SetCookie -> IO SetCookie+encryptValue s = do+ v' <- encryptIO (key ?webApiaryClientSessionSession) (setCookieValue s)+ return $ s { setCookieValue = v' }+ +setRawSession :: HasSession => Maybe DiffTime -> SetCookie -> Action ()+setRawSession age s = do+ s' <- liftIO $ encryptValue =<< setMaxAge s age+ setCookie s'++setSessionWith :: HasSession+ => (SetCookie -> SetCookie) -- ^ postprocess+ -> S.ByteString -- ^ key+ -> S.ByteString -- ^ value+ -> Action ()+setSessionWith f k v = do+ let Session{..} = ?webApiaryClientSessionSession+ setRawSession maxAge' $ f def+ { setCookieName = k + , setCookieValue = v+ , setCookiePath = path'+ , setCookieDomain = domain'+ , setCookieHttpOnly = httpOnly'+ , setCookieSecure = secure'+ }++setSession :: HasSession+ => S.ByteString -- ^ key+ -> S.ByteString -- ^ value+ -> Action ()+setSession = setSessionWith id++session :: (Strategy w, Query a, HasSession)+ => S.ByteString -> Proxy (w a) -> Apiary (SNext w as a) b -> Apiary as b+session ky p = function $ \l r -> readStrategy readQuery ((ky ==) . fst) p+ (map (\(k,b) -> (k, decrypt (key ?webApiaryClientSessionSession) b)) $ cookie' r) l