apiary-clientsession 0.13.2.1 → 0.16.0

raw patch · 4 files changed

+95/−79 lines, 4 filesdep −reflectiondep ~apiarydep ~apiary-cookiePVP ok

version bump matches the API change (PVP)

Dependencies removed: reflection

Dependency ranges changed: apiary, apiary-cookie

API changes (from Hackage documentation)

Files

• apiary-clientsession.cabal +10/−11
• src/Web/Apiary/ClientSession.hs +51/−21
• src/Web/Apiary/ClientSession/Explicit.hs +0/−21
• src/Web/Apiary/ClientSession/Internal.hs +34/−26

@@ -1,5 +1,5 @@ name:                apiary-clientsession-version:             0.13.2.1+version:             0.16.0 synopsis:            clientsession support for apiary web framework. description:   examples:@@ -24,23 +24,22 @@  library   exposed-modules:     Web.Apiary.ClientSession-                       Web.Apiary.ClientSession.Explicit   other-modules:       Web.Apiary.ClientSession.Internal-  other-extensions:       build-depends:       base               >=4.6   && <4.8                      , template-haskell-                     , directory          >=1.2   && <1.3-                     , bytestring         >=0.10  && <0.11-                     , apiary             >=0.13  && <0.16-                     , apiary-cookie      >=0.13  && <0.14                      , clientsession      >=0.9   && <0.10-                     , time               >=1.4   && <1.5-                     , data-default-class >=0.0   && <0.1-                     , reflection         >=1.4   && <1.6-                     , binary             >=0.7   && <0.8+                     , apiary             >=0.16  && <0.17+                     , apiary-cookie      >=0.16  && <0.17++                     , directory          >=1.2   && <1.3                      , crypto-random      >=0.0   && <0.1                      , cprng-aes          >=0.5   && <0.6++                     , binary             >=0.7   && <0.8+                     , bytestring         >=0.10  && <0.11                      , base64-bytestring  >=1.0   && <1.1+                     , time               >=1.4   && <1.5+                     , data-default-class >=0.0   && <0.1                      , http-types         >=0.8   && <0.9                      , blaze-html         >=0.7   && <0.8 

@@ -1,56 +1,86 @@ {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DataKinds #-}  module Web.Apiary.ClientSession-    ( HasSession+    ( I.Session+    -- * config     , I.SessionConfig(..), I.KeySource(..)-    , withSession     , I.embedKeyConfig, I.embedDefaultKeyConfig+    -- * initializer+    , initSession+    -- * getter+    , getSessionConfig     -- * setter     , setSession     , csrfToken+    -- ** with sessionConfig+    , setSessionWith     -- * filter     , session     , checkToken     -- * Reexport-    , module Data.Default.Class     -- | deleteCookie     , module Web.Apiary.Cookie     ) where  import Web.Apiary -import Data.Default.Class+import Data.Apiary.Extension+import Data.Apiary.Proxy+ import qualified Web.Apiary.ClientSession.Internal as I import Web.Apiary.Cookie (deleteCookie)-import Data.Reflection import qualified Data.ByteString as S import Control.Monad.Apiary.Filter.Internal.Strategy -type HasSession = Given I.Session+initSession :: MonadIO m => I.SessionConfig -> Initializer' m I.Session+initSession c = initializer $ I.withSession c return -withSession :: MonadIO m => I.SessionConfig -> (HasSession => m b) -> m b-withSession c m = I.withSession c (\s -> give s m)+setSession :: (Has I.Session exts, MonadIO m)+           => S.ByteString -> S.ByteString+           -> ActionT exts m ()+setSession k v = do+    sess <- getExt (Proxy :: Proxy I.Session)+    I.setSession sess k v -setSession :: (MonadIO m, HasSession)-           => S.ByteString -> S.ByteString -> ActionT m ()-setSession = I.setSession given+getSessionConfig :: (Has I.Session exts, Monad m)+                 => ActionT exts m I.SessionConfig+getSessionConfig = do+    sess <- getExt (Proxy :: Proxy I.Session)+    return $ I.sessionConfig sess +setSessionWith :: (Has I.Session exts, MonadIO m)+               => I.SessionConfig+               -> S.ByteString -> S.ByteString+               -> ActionT exts m ()+setSessionWith cfg k v = do+    sess <- getExt (Proxy :: Proxy I.Session)+    I.setSession sess { I.sessionConfig = cfg } k v++session :: (Has I.Session exts, Query a, Strategy w, MonadIO actM)+        => S.ByteString -> w a+        -> ApiaryT exts (SNext w prms a) actM m ()+        -> ApiaryT exts prms actM m ()+session k w m = do+    sess <- apiaryExt (Proxy :: Proxy I.Session)+    I.session sess k w m+ -- | create crypto random (generate random by AES CTR(cprng-aes package) and encode by base64), -- -- set it client session cookie, set XSRF-TOKEN header(when Just angularXsrfCookieName), -- -- and return value. since 0.9.0.0.-csrfToken :: (MonadIO m, HasSession) => ActionT m S.ByteString-csrfToken = I.csrfToken given--session :: (Functor n, MonadIO n, Strategy w, Query a, HasSession)-        => S.ByteString -> proxy (w a)-        -> ApiaryT (SNext w as a) n m b -> ApiaryT as n m b-session = I.session given+csrfToken :: (Has I.Session exts, MonadIO m) => ActionT exts m S.ByteString+csrfToken = getExt (Proxy :: Proxy I.Session) >>= I.csrfToken  -- | check csrf token. since 0.9.0.0.-checkToken :: (Functor n, MonadIO n, HasSession)-           => ApiaryT c n m a -> ApiaryT c n m a-checkToken = I.checkToken given+checkToken :: (Has I.Session exts, MonadIO actM)+           => ApiaryT exts prms actM m () -> ApiaryT exts prms actM m ()+checkToken m = do+    sess <- apiaryExt (Proxy :: Proxy I.Session)+    I.checkToken sess m+

@@ -1,21 +0,0 @@-module Web.Apiary.ClientSession.Explicit-    (-      Session, SessionConfig(..), KeySource(..)-    , withSession-    , embedKeyConfig, embedDefaultKeyConfig-    -- * actions-    , setSession-    , csrfToken-    -- * filters-    , session, checkToken-    -- * lowlevels-    , mkSessionCookie, getSessionValue-    -- * reexports-    , module Data.Default.Class-    -- | deleteCookie-    , module Web.Apiary.Cookie-    ) where--import Web.Apiary.ClientSession.Internal-import Data.Default.Class-import Web.Apiary.Cookie(deleteCookie)

@@ -24,9 +24,8 @@ import Control.Monad.Apiary.Filter.Internal.Strategy  import Web.Apiary.Wai-import Web.Apiary hiding (Default(..))+import Web.Apiary import Web.Apiary.Cookie-import Web.Apiary.Cookie.Internal import Web.ClientSession  import qualified Network.HTTP.Types as HTTP @@ -46,9 +45,9 @@ import qualified Data.ByteString.Lazy as L  data Session = Session-    { key       :: Key-    , tokenGen  :: IORef AESRNG-    , config    :: SessionConfig+    { key           :: Key+    , tokenGen      :: IORef AESRNG+    , sessionConfig :: SessionConfig     }  data KeySource@@ -60,12 +59,13 @@  -- | generate and embed key at compile time. since 0.13.2. ----- This function embed as SessionConfig with default config. so you can configure it.--- but don't configure sessionKey.+-- This function embed as SessionsessionConfig with default sessionConfig. so you can sessionConfigure it.+-- but DON'T sessionConfigure sessionKey.+--+-- this function is convenient when create heroku project. --  -- @--- withSession $embedDefaultKeyConfig { csrfTokenCookieName = \"foo\" } $ run 3000 . runApiary def $ do---     route define ...+-- embedsessionConfig = $embedDefaultKeysessionConfig { csrfTokenCookieName = \"foo\" } -- @ embedKeyConfig :: FilePath -> ExpQ embedKeyConfig keyfile = do@@ -97,6 +97,8 @@     , sessionHttpOnly       :: Bool     , sessionSecure         :: Bool +    , sessionTimeoutAction  :: forall e m. MonadIO m => ActionT e m ()+     , angularXsrfCookieName :: Maybe S.ByteString     , csrfTokenCookieName   :: S.ByteString @@ -104,10 +106,17 @@     , csrfTokenLength       :: Int     } +defaultCheckTokenFailAction :: Monad actM => ActionT exts actM ()+defaultCheckTokenFailAction = do+    reset+    status status401+    bytes "session timeout\n"+    stop+ instance Default SessionConfig where     def = SessionConfig         (KeyFile defaultKeyFile) (24 * 60 * 60) Nothing Nothing True True-        Nothing "_token" (Right "_token") 40+        defaultCheckTokenFailAction Nothing "_token" (Right "_token") 40  withSession :: MonadIO m => SessionConfig -> (Session -> m b) -> m b withSession cfg@SessionConfig{..} m = do@@ -151,9 +160,9 @@         Right (_, _, (BinUTCTime t, v)) -> if c < t then Just v else Nothing         _ -> Nothing -setSession :: MonadIO m => Session -> S.ByteString -> S.ByteString -> ActionT m ()+setSession :: MonadIO m => Session -> S.ByteString -> S.ByteString -> ActionT exts m () setSession sess k v = do-    s <- liftIO $ mkSessionCookie (config sess) (key sess) k v+    s <- liftIO $ mkSessionCookie (sessionConfig sess) (key sess) k v     setCookie s  newToken :: Int -> IORef AESRNG -> IO S.ByteString@@ -162,12 +171,12 @@   where      swap (a,b) = (b,a) -csrfToken :: MonadIO m => Session -> ActionT m S.ByteString+csrfToken :: MonadIO m => Session -> ActionT exts m S.ByteString csrfToken Session{..} = do-    tok <- liftIO $ newToken (csrfTokenLength config) tokenGen -    sc <- liftIO $ mkSessionCookie config key (csrfTokenCookieName config) tok+    tok <- liftIO $ newToken (csrfTokenLength sessionConfig) tokenGen +    sc <- liftIO $ mkSessionCookie sessionConfig key (csrfTokenCookieName sessionConfig) tok     setCookie sc-    maybe (return ()) (setCookie . ngCookie sc tok) (angularXsrfCookieName config)+    maybe (return ()) (setCookie . ngCookie sc tok) (angularXsrfCookieName sessionConfig)     return tok   where     ngCookie sc tok k = sc { setCookieName     = k@@ -175,32 +184,31 @@                            , setCookieHttpOnly = False                            } -session :: (Functor n, MonadIO n, Strategy w, Query a) => Session-        -> S.ByteString -> proxy (w a) -> ApiaryT (SNext w as a) n m b -> ApiaryT as n m b+session :: (MonadIO actM, Strategy w, Query a) => Session+        -> S.ByteString -> w a -> ApiaryT exts (SNext w prms a) actM m () -> ApiaryT exts prms actM m () session sess k p = focus (DocPrecondition $ toHtml (show k) <> " session cookie required") $ \l -> do     r   <- getRequest     t   <- liftIO getCurrentTime     let mbr = readStrategy readQuery ((k ==) . fst) p             (map (second $ getSessionValue sess t) $ cookie' r) l-    maybe empty return mbr+    maybe mzero return mbr -checkToken :: (Functor n, MonadIO n)+checkToken :: MonadIO actM            => Session-           -> ApiaryT c n m a-           -> ApiaryT c n m a+           -> ApiaryT exts prms actM m ()+           -> ApiaryT exts prms actM m () checkToken sess@Session{..} = focus (DocPrecondition "CSRF token required") $ \l -> do     r <- getRequest     p <- getReqParams      t <- liftIO getCurrentTime     let stok = getSessionValue sess t =<< -               lookup (csrfTokenCookieName config) (cookie' r)+               lookup (csrfTokenCookieName sessionConfig) (cookie' r)     guard (isJust stok)     -    qtok <- return . join $ case csrfTokenCheckingName config of+    qtok <- return . join $ case csrfTokenCheckingName sessionConfig of         Right name -> lookup name $ reqParams pByteString r p []         Left name  -> lookup name $ map (\(k,v) -> (k, Just v)) $ requestHeaders r     guard (isJust qtok) -    if qtok == stok then return l else empty-+    if qtok == stok then return l else sessionTimeoutAction sessionConfig >> mzero