wai-cryptocookie 0.0.1 → 0.1

raw patch · 6 files changed

+66/−77 lines, 6 filesdep −vaultPVP ok

version bump matches the API change (PVP)

Dependencies removed: vault

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• lib/Wai/CryptoCookie.hs +2/−16
• lib/Wai/CryptoCookie/Encryption.hs +4/−3
• lib/Wai/CryptoCookie/Middleware.hs +23/−19
• test/Main.hs +30/−37
• wai-cryptocookie.cabal +1/−2

@@ -1,3 +1,9 @@+# Version 0.1++* Changed the type of `middleware` so that the previous *lookup*+  function is not used anymore. Instead, a `CryptoCookie` is+  provided directly to an `Application`-construction function.+ # Version 0.0.1  * Initial version.

@@ -7,22 +7,8 @@ -- import qualified "Wai.CryptoCookie" -- @ ----- One example of how to obtain a new "Network.Wai".'Network.Wai.Middleware',------ @--- do (__middleware__, __lookup__) <- do---       key <- "Wai.CryptoCookie".'autoKeyFileBase16' \"\/run\/my-cookie-encryption-key\"---       "Wai.CryptoCookie".'middleware' ("Wai.CryptoCookie".'defaultConfig' key)--- @------ The obtained @__middleware__@ shall be applied to your--- "Network.Wai".'Wai.Application'.------ The obtained @__lookup__@ function can be used to obtain the 'CryptoCookie'--- associated with each 'Wai.Request'. It returns 'Nothing' if this particular--- @__middleware__@ was not used on the given 'Wai.Request'.------ Finally, interact with the 'CryptoCookie' data using 'get' or 'set'.+-- Use 'middleware' to obtain a function to allow an 'Wai.Application' to+-- interact with a 'CryptoCookie'  using 'get' or 'set'. -- -- == Do I store session data on the client or on the server? --

@@ -58,9 +58,10 @@     -- | Generate initial 'Encrypt'ion and 'Decrypt'ion context for a 'Key'.    ---   -- The 'Encrypt'ion context could carry for example the next nonce to use-   -- for 'encrypt'ion, the 'Key' itself or its derivative used during the-   -- actual 'encrypt'ion process, or a deterministic random number generator.+   -- The 'Encrypt'ion context could carry for example the next+   -- __randomly generated nonce__ to use for 'encrypt'ion, the 'Key'+   -- itself or its derivative used during the actual 'encrypt'ion+   -- process, or a deterministic random number generator.    --    -- The 'Decrypt'ion context could carry for example the 'Key' itself or its    -- derivative used during the 'decrypt'ion process.

@@ -18,7 +18,6 @@ import Data.Kind (Type) import Data.List (find) import Data.Time.Clock.POSIX qualified as Time-import Data.Vault.Lazy qualified as V import Network.Wai qualified as Wai import Web.Cookie    ( SetCookie (..)@@ -91,31 +90,36 @@ set :: CryptoCookie a -> Maybe a -> STM () set (CryptoCookie _ x) = writeTVar x . Just --- | Construct a new 'Middleware', and function that can be used to look-up the--- 'CryptoCookie' on each incoming 'Wai.Request'. Said function returns--- 'Nothing' if the 'Middleware' was not used on the 'Wai.Request'.+-- | Obtain a new 'Wai.Application'-transforming function (more or less a+-- 'Wai.Middleware') wherein the 'Wai.Application' being transformed can interact+-- with a 'CryptoCookie'.+--+-- * 'middleware' can be called multiple times as long as the 'setCookieName'+-- for the 'SetCookie' specified in 'Config' is different each time.+--+-- * It is safe to reuse the same 'Key' for multiple 'middleware' calls.  Each+-- time the 'Key' will have a different randomly 'initial'ized 'Encrypt'ion+-- context. middleware    :: forall a m     . (MonadIO m)    => Config a    -- ^ Consider using 'Wai.CryptoCookie.defaultConfig'.-   -> m (Wai.Middleware, Wai.Request -> Maybe (CryptoCookie a))+   -> m ((CryptoCookie a -> Wai.Application) -> Wai.Application)+   -- ^ Remember that 'Wai.Middleware' is a type-synonym for+   -- @'Wai.Application' -> 'Wai.Application'@.  This type is not too different+   -- from that. middleware c = liftIO do    env <- newEnv c-   vk :: V.Key (CryptoCookie a) <- V.newKey-   pure-      ( \app req respond -> do-         tv <- newTVarIO Nothing-         let ck = CryptoCookie (getRequestCookieData env req) tv-         app (req{Wai.vault = V.insert vk ck (Wai.vault req)}) \res -> do-            yya1 <- readTVarIO tv-            let f = case yya1 of-                  Nothing -> pure-                  Just Nothing -> expireResponseCookieData env-                  Just (Just a1) -> setResponseCookieData env a1-            respond =<< f res-      , \req -> V.lookup vk (Wai.vault req)-      )+   pure \fapp -> \req respond -> do+      tv <- newTVarIO Nothing+      fapp (CryptoCookie (getRequestCookieData env req) tv) req \res -> do+         yya1 <- readTVarIO tv+         let f = case yya1 of+               Nothing -> pure+               Just Nothing -> expireResponseCookieData env+               Just (Just a1) -> setResponseCookieData env a1+         respond =<< f res  -- | Find, decrypt and decode the cookie value from the 'Wai.Request'. --

@@ -74,72 +74,65 @@    c1 <- do       c <- fmap WCC.defaultConfig WCC.genKey       pure c{WCC.key = k}-   (mw1, look1) <- WCC.middleware c1+   fmw1 <- WCC.middleware c1 -   WT.withSession (app look1 id) do+   WT.withSession (fmw1 $ app id) do       sres1 <- WT.request WT.defaultRequest       WT.assertBody "Nothing" sres1       WT.assertNoClientCookieExists "t1-a" "SESSION" -   WT.withSession (mw1 $ app look1 id) do       sres1 <- WT.request WT.defaultRequest-      WT.assertBody "Just Nothing" sres1-      WT.assertNoClientCookieExists "t2-a" "SESSION"--      sres1 <- WT.request WT.defaultRequest-      WT.assertBody "Just Nothing" sres1-      WT.assertNoClientCookieExists "t2-b" "SESSION"+      WT.assertBody "Nothing" sres1+      WT.assertNoClientCookieExists "t1-b" "SESSION" -   ck0 <- WT.withSession (mw1 $ app look1 (\_ -> Just 900)) do+   ck0 <- WT.withSession (fmw1 $ app \_ -> Just 900) do       sres1 <- WT.request WT.defaultRequest-      WT.assertBody "Just Nothing" sres1-      WT.assertClientCookieExists "t3-a" "SESSION"+      WT.assertBody "Nothing" sres1+      WT.assertClientCookieExists "t2-a" "SESSION"        sres2 <- WT.request WT.defaultRequest-      WT.assertBody "Just (Just 900)" sres2-      WT.assertClientCookieExists "t3-b" "SESSION"+      WT.assertBody "Just 900" sres2+      WT.assertClientCookieExists "t2-b" "SESSION"        WT.getClientCookies -   WT.withSession (mw1 $ app look1 (\_ -> Nothing)) do+   WT.withSession (fmw1 $ app \_ -> Nothing) do       WT.modifyClientCookies \_ -> ck0        sres1 <- WT.request WT.defaultRequest-      WT.assertBody "Just (Just 900)" sres1-      WT.assertClientCookieExists "t4-a" "SESSION"+      WT.assertBody "Just 900" sres1+      WT.assertClientCookieExists "t3-a" "SESSION"        sres2 <- WT.request WT.defaultRequest-      WT.assertBody "Just Nothing" sres2-      WT.assertClientCookieExists "t4-b" "SESSION"-      WT.assertClientCookieValue "t4-c" "SESSION" ""+      WT.assertBody "Nothing" sres2+      WT.assertClientCookieExists "t3-b" "SESSION"+      WT.assertClientCookieValue "t3-c" "SESSION" "" -   WT.withSession (mw1 $ app look1 (fmap (+ 1))) do+   WT.withSession (fmw1 $ app (fmap (+ 1))) do       sres1 <- WT.request WT.defaultRequest-      WT.assertBody "Just Nothing" sres1-      WT.assertNoClientCookieExists "t5-a" "SESSION"+      WT.assertBody "Nothing" sres1+      WT.assertNoClientCookieExists "t4-a" "SESSION"        WT.modifyClientCookies \_ -> ck0        sres2 <- WT.request WT.defaultRequest-      WT.assertBody "Just (Just 900)" sres2-      WT.assertClientCookieExists "t5-b" "SESSION"+      WT.assertBody "Just 900" sres2+      WT.assertClientCookieExists "t4-b" "SESSION"        sres2 <- WT.request WT.defaultRequest-      WT.assertBody "Just (Just 901)" sres2-      WT.assertClientCookieExists "t5-c" "SESSION"+      WT.assertBody "Just 901" sres2+      WT.assertClientCookieExists "t4-c" "SESSION"  app-   :: (W.Request -> Maybe (WCC.CryptoCookie Word))-   -> (Maybe Word -> Maybe Word)+   :: (Maybe Word -> Maybe Word)+   -> WCC.CryptoCookie Word    -> W.Application-app look g = \req res -> do-   yyold <- forM (look req) \cc -> do-      let yold = WCC.get cc-          ynew = g yold-      when (ynew /= yold) do-         atomically $ WCC.set cc ynew-      pure yold-   res $ W.responseLBS HT.status200 [] $ fromString $ show yyold+app g cc = \req res -> do+   let yold = WCC.get cc+       ynew = g yold+   when (ynew /= yold) do+      atomically $ WCC.set cc ynew+   res $ W.responseLBS HT.status200 [] $ fromString $ show yold  withTmpDir :: (FilePath -> IO a) -> IO a withTmpDir f = do

@@ -1,6 +1,6 @@ cabal-version: 2.4 name: wai-cryptocookie-version: 0.0.1+version: 0.1 license: Apache-2.0 license-file: LICENSE extra-source-files: README.md CHANGELOG.md@@ -53,7 +53,6 @@     stm,     text,     time,-    vault,     wai,  test-suite test