packages feed

apiary-session (empty) → 1.2.0

raw patch · 5 files changed

+164/−0 lines, 5 filesdep +apiarydep +basedep +waisetup-changed

Dependencies added: apiary, base, wai

Files

+ 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-session.cabal view
@@ -0,0 +1,31 @@+name:                apiary-session+version:             1.2.0+synopsis:            session support for apiary web framework.+description:+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.Session+                       Web.Apiary.Session.Internal+  other-modules:       +  build-depends:       base               >=4.6   && <4.8+                     , apiary             >=1.2   && <1.3+                     , wai                >=3.0   && <3.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/Session.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE DataKinds #-}++module Web.Apiary.Session+    ( Session+    , getSession, setSession, deleteSession+    , session, session'+    , Proxy(Proxy)+    ) where++import Control.Monad(mzero)++import Control.Monad.Apiary(ApiaryT)+import Control.Monad.Apiary.Action(ActionT, getParams)+import Control.Monad.Apiary.Filter(focus, Doc(DocPrecondition))++import Web.Apiary.Session.Internal+    (Session(Session), backendGet, backendSet, backendDelete)++import Data.Apiary.Extension(Has, getExt)+import Data.Apiary.Compat(Proxy(Proxy), KnownSymbol)+import qualified Data.Apiary.Dict as Dict++-- | get session provided type.+getSession :: (Has (Session sess m) exts, Monad m) => proxy sess -> ActionT exts prms m (Maybe sess)+getSession _ = do+    Session b <- getExt Proxy+    backendGet b++-- | set session provided type.+setSession :: (Has (Session sess m) exts, Monad m) => proxy sess -> sess -> ActionT exts prms m ()+setSession _ v = do+    Session b <- getExt Proxy+    backendSet b v++-- | delete session provided type.+deleteSession :: forall proxy exts prms m sess. (Has (Session sess m) exts, Monad m)+              => proxy sess -> ActionT exts prms m ()+deleteSession _ = do+    Session b <- getExt (Proxy :: Proxy (Session sess m))+    backendDelete b++-- | filter by has session or not.+session' :: (Has (Session sess actM) exts, KnownSymbol key, Monad actM, Dict.NotMember key kvs)+         => kProxy key -> sProxy sess+         -> ApiaryT exts (key Dict.:= sess ': kvs) actM m ()+         -> ApiaryT exts kvs actM m ()+session' ky p = focus (DocPrecondition "session cookie required.") $ do+    dict <- getParams+    getSession p >>= \case+        Nothing -> mzero+        Just s  -> return $ Dict.insert ky s dict++-- | filter by has session or not. use \"session\" dict key.+--+-- @+-- session = session' (Proxy :: Proxy "session")+-- @+session :: (Has (Session sess actM) exts, Monad actM, Dict.NotMember "session" kvs)+        => proxy sess+        -> ApiaryT exts ("session" Dict.:= sess ': kvs) actM m ()+        -> ApiaryT exts kvs actM m ()+session = session' (Proxy :: Proxy "session")
+ src/Web/Apiary/Session/Internal.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE Rank2Types #-}++module Web.Apiary.Session.Internal+    ( Session(..)+    , SessionBackend(..)+    ) where++import Control.Monad.Apiary.Action(ActionT)+import qualified Network.Wai as Wai+import Data.Apiary.Extension+    (Extension(extMiddleware, extMiddleware'), Middleware')++data Session sess m = forall backend. SessionBackend backend sess m => Session+    { sessionBackend :: backend }++instance Extension (Session sess m) where+    extMiddleware  (Session back) = backendMiddleware  back+    extMiddleware' (Session back) = backendMiddleware' back++class Monad m => SessionBackend backend sess m | backend -> sess, backend -> m where+    backendMiddleware :: backend -> Wai.Middleware+    backendMiddleware _ = id+    {-# INLINE backendMiddleware #-}++    backendMiddleware' :: backend -> Middleware'+    backendMiddleware' _ = id+    {-# INLINE backendMiddleware' #-}++    genBackendModify  :: backend+                      -> (Maybe sess -> ActionT exts prms m (Maybe sess, a))+                      -> ActionT exts prms m a++    backendGet :: backend -> ActionT exts prms m (Maybe sess)+    backendGet b = genBackendModify b (\s -> return (s, s))++    backendSet :: backend -> sess -> ActionT exts prms m ()+    backendSet b s = genBackendModify b (\_ -> return (Just s, ()))++    backendDelete :: backend -> ActionT exts prms m ()+    backendDelete b = genBackendModify b (\_ -> return (Nothing, ()))