apiary-cookie (empty) → 0.3.1.0

raw patch · 5 files changed

+200/−0 lines, 5 filesdep +apiarydep +basedep +blaze-buildersetup-changed

Dependencies added: apiary, base, blaze-builder, bytestring, clientsession, cookie, data-default-class, mtl, reflection, transformers

Files

LICENSE +20/−0
Setup.hs +2/−0
apiary-cookie.cabal +40/−0
src/Web/Apiary/Cookie.hs +76/−0
src/Web/Apiary/Cookie/Internal.hs +62/−0

+ LICENSE view

@@ -0,0 +1,20 @@+Copyright (c) 2014 philopon++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

@@ -0,0 +1,40 @@+name:                apiary-cookie+version:             0.3.1.0+x-revision:          1+synopsis:            Cookie 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.Cookie+  other-modules:       Web.Apiary.Cookie.Internal+  other-extensions:    +  build-depends:       base               >=4.7   && <4.8+                     , mtl                >=2.1   && <2.3+                     , transformers       >=0.3   && <0.5+                     , bytestring         >=0.10 && <0.11+                     , apiary             >=0.3.1 && <0.4+                     , cookie             >=0.4   && <0.5+                     , clientsession      >=0.9   && <0.10+                     , reflection         >=1.4   && <1.5+                     , blaze-builder      >=0.3   && <0.4+                     , 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

@@ -0,0 +1,76 @@++-- | Cookie support for Apiary.+--+-- @+-- {-# LANGUAGE QuasiQuotes #-}+-- {-# LANGUAGE FlexibleContexts #-} -- for reflection+-- {-# LANGUAGE OverloadedStrings #-}+--+-- import Web.Apiary+-- import Web.Apiary.Cookie+-- import Network.Wai.Handler.Warp+-- import qualified Data.ByteString.Lazy.Char8 as L+-- import qualified Data.ByteString.Char8      as S+-- @+-- +-- 'withCookie' function give 'Cookie' data type for encrypt cookie.+--+-- 'setCookie' function set cookie. cookie value is automatically encrypted.+--+-- @+-- main :: IO ()+-- main = 'withCookie' def $ run 3000 . runApiary def $ do+-- +--     [capture|/:String|] . action $ \s -> do+--         'setCookie' (def { setCookieName = "param", setCookieValue = S.pack s })+--         'setCookie' (def { setCookieName = "dog", setCookieValue = "bowwow" })+--         contentType "text/plain"+--         lbs "lucky cookie."+-- +--     root $ action_ splittedAction+-- @+--+-- In splitted action, you must add sigunature+-- with 'Given' 'Cookie' ristriction.+--+-- 'getCookie' functions, get and auto decrypt cookie.+--+-- @+-- splittedAction :: (Monad m, Given Cookie) => ActionT m ()+-- splittedAction = do+--     s <- 'getCookie'' "param"+--     p <- 'getCookie'' "dog"+--     contentType "text/plain"+--     lbs $ L.unlines [L.fromStrict s, L.fromStrict p]+-- +-- @+--+-- * first, access localhost:3000, 404 page not found shown.+--+-- 'getCookie'' function pass next handler when cookie key is not found,+-- and next handler is not exists. so 404.+--+-- * next, you access localhost:3000/hoge, set param=hoge, dog=bowwow to cookie.+--+-- * then access localhost:3000, show hoge\<CR\>bowwow.+--+--++module Web.Apiary.Cookie +    ( Cookie+    , CookieConfig(..)+    , withCookie+    -- * setter+    , setCookie+    -- * getter+    , getCookies, getCookies'+    , getCookie, getCookie'+    -- * Reexport+    , def+    , SetCookie(..)+    , Given+    ) where++import Web.Cookie+import Web.Apiary.Cookie.Internal+import Data.Reflection

@@ -0,0 +1,62 @@+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE LambdaCase #-}++module Web.Apiary.Cookie.Internal where++import Control.Monad+import Control.Monad.Trans+import Control.Monad.Trans.Maybe++import Web.Apiary+import Web.ClientSession+import Web.Cookie++import Blaze.ByteString.Builder+import qualified Data.ByteString as S+import Data.Default.Class+import Data.Reflection++newtype Cookie = Cookie+    { key :: Key+    }++newtype CookieConfig = CookieConfig+    { keyFile :: FilePath }++instance Default CookieConfig where+    def = CookieConfig defaultKeyFile++-- | Give cookie encryption key.+withCookie :: CookieConfig -> (Given Cookie => IO b) -> IO b+withCookie conf f = do+    k <- getKey $ keyFile conf+    give (Cookie k) f++setCookie :: (MonadIO m, Given Cookie) => SetCookie -> ActionT m ()+setCookie sc = do+    v' <- liftIO $ encryptIO (key given) (setCookieValue sc) +    let s = toByteString . renderSetCookie $ sc { setCookieValue = v' }+    addHeader "set-cookie" s++-- | get cookies. first Maybe indicate cookie header exists or not, +-- second Maybe indicate decryption status.+getCookies :: (Monad m, Given Cookie) => ActionT m (Maybe [(S.ByteString, Maybe S.ByteString)])+getCookies = runMaybeT $ do+    raw <- MaybeT $ getRequestHeader "cookie"+    return $ map (\(k,v) -> (k, decrypt (key given) v)) $ parseCookies raw++-- | like 'getCookies', but when cookie header isn't exists, pass next handler.+getCookies' :: (Monad m, Given Cookie) => ActionT m [(S.ByteString, Maybe S.ByteString)]+getCookies' = getCookies >>= maybe mzero return++-- | get cookie of specific key.+getCookie :: (Monad m, Given Cookie) => S.ByteString -> ActionT m (Maybe S.ByteString)+getCookie k = getCookies >>= return . maybe Nothing (join . lookup k)++getCookie' :: (Monad m, Given Cookie) => S.ByteString -> ActionT m S.ByteString+getCookie' k = getCookie k >>= maybe mzero return+