diff --git a/apiary-cookie.cabal b/apiary-cookie.cabal --- a/apiary-cookie.cabal +++ b/apiary-cookie.cabal @@ -1,8 +1,8 @@ name: apiary-cookie -version: 0.6.0.0 +version: 0.7.0.0 synopsis: Cookie support for apiary web framework. description: - example: + example: license: MIT license-file: LICENSE author: HirotomoMoriwaki @@ -18,19 +18,16 @@ library exposed-modules: Web.Apiary.Cookie - other-modules: Web.Apiary.Cookie.Internal + Web.Apiary.Cookie.Internal other-extensions: build-depends: base >=4.6 && <4.8 - , mtl >=2.1 && <2.3 - , transformers >=0.3 && <0.5 , bytestring >=0.10 && <0.11 - , apiary >=0.6 && <0.7 + , apiary >=0.7 && <0.8 , cookie >=0.4 && <0.5 - , clientsession >=0.9 && <0.10 , blaze-builder >=0.3 && <0.4 - , data-default-class >=0.0 && <0.1 , wai >=2.1 && <2.2 , tagged >=0.7 && <0.8 + , time >=1.4 && <1.5 hs-source-dirs: src ghc-options: -O2 -Wall diff --git a/src/Web/Apiary/Cookie.hs b/src/Web/Apiary/Cookie.hs --- a/src/Web/Apiary/Cookie.hs +++ b/src/Web/Apiary/Cookie.hs @@ -1,73 +1,14 @@ - --- | Cookie support for Apiary. --- --- @ --- {-# LANGUAGE QuasiQuotes #-} --- {-# LANGUAGE OverloadedStrings #-} --- {-# LANGUAGE NoMonomorphismRestriction #-} -- for implicit signature --- {-# LANGUAGE FlexibleContexts #-} -- for explicit signature --- --- 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 --- @ --- --- 'getCookie' functions, get and auto decrypt cookie. --- --- @ --- splittedAction :: (Monad m, HasCookie) => 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\bowwow. --- --- - module Web.Apiary.Cookie - ( HasCookie - , CookieConfig(..) - , withCookie + ( -- * setter - , setCookie + setCookie + , deleteCookie -- * filter , cookie -- * Reexport -- | SetCookie(..) , module Web.Cookie - -- | def - , module Data.Default.Class ) where import Web.Cookie (SetCookie(..)) -import Data.Default.Class import Web.Apiary.Cookie.Internal diff --git a/src/Web/Apiary/Cookie/Internal.hs b/src/Web/Apiary/Cookie/Internal.hs --- a/src/Web/Apiary/Cookie/Internal.hs +++ b/src/Web/Apiary/Cookie/Internal.hs @@ -9,14 +9,12 @@ module Web.Apiary.Cookie.Internal where -import Control.Monad.Trans - import Network.Wai import Web.Apiary -import Web.ClientSession import Web.Cookie import Data.Maybe import Data.Proxy +import Data.Time import Control.Monad.Apiary.Filter.Internal import Control.Monad.Apiary.Filter.Internal.Strategy @@ -24,18 +22,6 @@ import Blaze.ByteString.Builder import qualified Data.ByteString as S -newtype Cookie = Cookie - { key :: Key - } - -newtype CookieConfig = CookieConfig - { keyFile :: FilePath } - -instance Default CookieConfig where - def = CookieConfig defaultKeyFile - -type HasCookie = ?webApiaryCookieCookie :: Cookie - cond :: (a -> Bool) -> (a -> b) -> (a -> b) -> a -> b cond p t f a = if p a then t a else f a @@ -46,34 +32,32 @@ -- example: -- -- @ --- cookie "foo" pFirst pInt -- get first Int parameter from foo. --- cookie "bar" pOption pDouble -- get first Double parameter from bar, allows no cookie. --- cookie "baz" pMany (pMaybe pString) -- get zero or more baz cookies. allows cookie decrypt failure. +-- cookie "foo" (pFirst pInt) -- get first Int parameter from foo. +-- cookie "bar" (pOption pDouble) -- get first Double parameter from bar, allows no cookie. +-- cookie "baz" (pMany (pMaybe pString)) -- get zero or more baz cookies. allows cookie decrypt failure. +-- cookie "baz" (Proxy :: Proxy (LimitSome [int|100|] ByteString)) -- get raw cookies up to 100 entries. -- @ -cookie :: (Strategy w, Query a, HasCookie, Monad m) +cookie :: (Strategy w, Query a) => S.ByteString -> Proxy (w a) - -> ApiaryT (SNext w as a) m b - -> ApiaryT as m b -cookie k p = function $ \l r -> readStrategy readQuery ((k ==) . fst) p (cookie' r) l + -> Apiary (SNext w as a) b + -> Apiary as b +cookie k p = function $ \l r -> readStrategy (readQuery . Just) ((k ==) . fst) p (cookie' r) l -cookie' :: HasCookie => Request -> [(S.ByteString, Maybe S.ByteString)] +cookie' :: Request -> [(S.ByteString, S.ByteString)] cookie' = - map (\(k,b) -> (k, decrypt (key ?webApiaryCookieCookie) b)) . concatMap parseCookies . - take 100 . -- avoid hashdos mapMaybe (cond (("cookie" ==) . fst) (Just . snd) (const Nothing)) . requestHeaders --- | Give cookie encryption key. -withCookie :: CookieConfig -> (HasCookie => IO b) -> IO b -withCookie conf f = do - k <- getKey $ keyFile conf - let ?webApiaryCookieCookie = Cookie k - f -setCookie :: (MonadIO m, HasCookie) => SetCookie -> ActionT m () -setCookie sc = do - v' <- liftIO $ encryptIO (key ?webApiaryCookieCookie) (setCookieValue sc) - let s = toByteString . renderSetCookie $ sc { setCookieValue = v' } - addHeader "set-cookie" s +-- | delete cookie. since 0.6.1.0. +deleteCookie :: S.ByteString -> Action () +deleteCookie k = setCookie def { setCookieName = k + , setCookieExpires = Just $ UTCTime (ModifiedJulianDay 0) 0 + , setCookieMaxAge = Just 0 + } +-- | set raw cookie header. +setCookie :: SetCookie -> Action () +setCookie = + addHeader "set-cookie" . toByteString . renderSetCookie