apiary-clientsession 0.13.1 → 0.13.2

raw patch · 4 files changed

+59/−6 lines, 4 filesdep +directorydep +template-haskellPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: directory, template-haskell

API changes (from Hackage documentation)

Files

• apiary-clientsession.cabal +5/−1
• src/Web/Apiary/ClientSession.hs +2/−1
• src/Web/Apiary/ClientSession/Explicit.hs +2/−1
• src/Web/Apiary/ClientSession/Internal.hs +50/−3

@@ -1,5 +1,5 @@ name:                apiary-clientsession-version:             0.13.1+version:             0.13.2 synopsis:            clientsession support for apiary web framework. description:   examples:@@ -7,6 +7,8 @@     <https://github.com/philopon/apiary/blob/master/examples/csrf.hs>     .     <https://github.com/philopon/apiary/blob/master/examples/auth.hs>+    .+    <https://github.com/philopon/apiary/blob/master/examples/embed_key.hs> license:             MIT license-file:        LICENSE author:              HirotomoMoriwaki<philopon.dependence@gmail.com>@@ -26,6 +28,8 @@   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.15                      , apiary-cookie      >=0.13  && <0.14

@@ -4,8 +4,9 @@  module Web.Apiary.ClientSession     ( HasSession-    , I.SessionConfig(..)+    , I.SessionConfig(..), I.KeySource(..)     , withSession+    , I.embedKeyConfig, I.embedDefaultKeyConfig     -- * setter     , setSession     , csrfToken

@@ -1,7 +1,8 @@ module Web.Apiary.ClientSession.Explicit     (-      Session, SessionConfig(..)+      Session, SessionConfig(..), KeySource(..)     , withSession+    , embedKeyConfig, embedDefaultKeyConfig     -- * actions     , setSession     , csrfToken

@@ -1,4 +1,5 @@ {-# LANGUAGE Rank2Types #-}+{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-}@@ -9,6 +10,10 @@  module Web.Apiary.ClientSession.Internal where +import Language.Haskell.TH++import System.Directory+ import "crypto-random" Crypto.Random import Crypto.Random.AESCtr @@ -25,6 +30,7 @@ import Web.ClientSession  import qualified Network.HTTP.Types as HTTP +import Data.String import Data.Maybe import Data.Monoid import Data.Time@@ -36,6 +42,7 @@ import Text.Blaze.Html import qualified Data.ByteString.Base64 as Base64 import qualified Data.ByteString as S+import qualified Data.ByteString.Char8 as SC import qualified Data.ByteString.Lazy as L  data Session = Session@@ -44,8 +51,46 @@     , config    :: SessionConfig     } +data KeySource+    = KeyFile       FilePath+    | KeyByteString S.ByteString++instance IsString KeySource where+    fromString = KeyByteString . fromString++-- | 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.+-- +-- @+-- withSession $embedDefaultKeyConfig { csrfTokenCookieName = \"foo\" } $ run 3000 . runApiary def $ do+--     route define ...+-- @+embedKeyConfig :: FilePath -> ExpQ+embedKeyConfig keyfile = do+    bs <- runIO $ do+        exists <- doesFileExist keyfile+        if exists+            then do +                b <- S.readFile keyfile+                case initKey b of+                    Left  _ -> newKey+                    Right _ -> return b+        else newKey+    let s = stringE $ SC.unpack bs+    [| def { sessionKey = KeyByteString $s } |]+  where+    newKey = do+        (bs, _) <- randomKey+        S.writeFile keyfile bs+        return bs++embedDefaultKeyConfig :: ExpQ+embedDefaultKeyConfig = embedKeyConfig defaultKeyFile+ data SessionConfig = SessionConfig-    { sessionKeyFile        :: FilePath+    { sessionKey            :: KeySource     , sessionMaxAge         :: DiffTime     , sessionPath           :: Maybe S.ByteString     , sessionDomain         :: Maybe S.ByteString@@ -61,12 +106,14 @@  instance Default SessionConfig where     def = SessionConfig-        defaultKeyFile (24 * 60 * 60) Nothing Nothing True True+        (KeyFile defaultKeyFile) (24 * 60 * 60) Nothing Nothing True True         Nothing "_token" (Right "_token") 40  withSession :: MonadIO m => SessionConfig -> (Session -> m b) -> m b withSession cfg@SessionConfig{..} m = do-    k <- liftIO $ getKey sessionKeyFile+    k <- liftIO $ case sessionKey of+        KeyFile       f -> getKey f+        KeyByteString s -> either fail return $ initKey s     p <- liftIO $ makeSystem >>= newIORef     let sess = Session k p cfg     m sess