wai-cryptocookie 0.1 → 0.2
raw patch · 5 files changed
+123/−39 lines, 5 filesdep +random
Dependencies added: random
Files
- CHANGELOG.md +19/−0
- lib/Wai/CryptoCookie.hs +3/−1
- lib/Wai/CryptoCookie/Middleware.hs +39/−13
- test/Main.hs +60/−24
- wai-cryptocookie.cabal +2/−1
CHANGELOG.md view
@@ -1,8 +1,27 @@+# Version 0.2++* BREAKING CHANGE: The type of `set` changed so that `set cc Nothing` is+ now `delete cc` (new function), and `set cc (Just a)` is now+ `set cc a`.++* Added a function `keep` to keep the cookie as is on the client side,+ without sending any `Set-Cookie` header on the reply.++* The `CryptoCookie` won't be decrypted and decoded until `get` is used.+ This makes requests that don't need to interact with the+ `CryptoCookie` more efficient.++* Documentation improvements.++* Test improvements.++ # 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
lib/Wai/CryptoCookie.hs view
@@ -8,7 +8,7 @@ -- @ -- -- Use 'middleware' to obtain a function to allow an 'Wai.Application' to--- interact with a 'CryptoCookie' using 'get' or 'set'.+-- interact with a 'CryptoCookie' using 'get', 'set', 'delete' and 'keep'. -- -- == Do I store session data on the client or on the server? --@@ -49,6 +49,8 @@ CryptoCookie , get , set+ , delete+ , keep -- * Middleware , middleware
lib/Wai/CryptoCookie/Middleware.hs view
@@ -6,6 +6,8 @@ , CryptoCookie , get , set+ , delete+ , keep , middleware ) where @@ -75,31 +77,55 @@ -- | Read-write access to the "Wai.CryptoCookie" data. ----- See 'get' and 'set'.-data CryptoCookie a = CryptoCookie (Maybe a) (TVar (Maybe (Maybe a)))+-- See 'get', 'set', 'delete', 'keep'.+data CryptoCookie a = CryptoCookie ~(Maybe a) (TVar (Maybe (Maybe a))) -- | The data that came through the 'Wai.Request' cookie, if any. get :: CryptoCookie a -> Maybe a get (CryptoCookie x _) = x -- | Cause the eventual 'Wai.Response' corresponding to the current--- 'Wai.Request' to set the cookie to the specified value if 'Just', or expire--- (/delete/) the cookie if 'Nothing'.+-- 'Wai.Request' to __set the cookie to the specified value__. ----- Overrides previous uses of 'set'.-set :: CryptoCookie a -> Maybe a -> STM ()-set (CryptoCookie _ x) = writeTVar x . Just+-- Overrides previous uses of 'set', 'delete', and 'keep'.+set :: CryptoCookie a -> a -> STM ()+set (CryptoCookie _ x) = writeTVar x . Just . Just +-- | Cause the eventual 'Wai.Response' corresponding to the current+-- 'Wai.Request' to __delete the cookie__ by setting its expiration to+-- a date in the past.+--+-- Overrides previous uses of 'set', 'delete', and 'keep'.+delete :: CryptoCookie a -> STM ()+delete (CryptoCookie _ x) = writeTVar x $ Just Nothing++-- | Cause the eventual 'Wai.Response' corresponding to the current+-- 'Wai.Request' to __keep the cookie as it is in the client__.+--+-- This is different than 'set'ting the cookie value to the value that came+-- with the incoming 'Wai.Request', because doing that could potentially+-- re-write a cookie that was deleted by the client after they sent the+-- 'Wai.Request' but before we send the 'Wai.Response'.+--+-- Doing nothing with a 'CryptoCookie' in your 'Wai.Application' is analogous+-- to using 'keep' just before returning the 'Wai.Response'.+--+-- Overrides previous uses of 'set', 'delete', and 'keep'.+keep :: CryptoCookie a -> STM ()+keep (CryptoCookie _ x) = writeTVar x Nothing+ -- | 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 a same 'Key', as well as 'middleware', as well as the+-- function returned by 'middleware', even concurrently. The library takes care+-- of randomly and atomically 'initial'izing or 'advance'ing 'Encrypt'ion+-- contexts as necessary. ----- * 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.+-- If you plan to use 'middleware' more than once, which you would do if you+-- want to have two independently `CryptoCookies`, just make sure each `Config`+-- uses a different `setCookieName`. middleware :: forall a m . (MonadIO m)@@ -112,7 +138,7 @@ middleware c = liftIO do env <- newEnv c pure \fapp -> \req respond -> do- tv <- newTVarIO Nothing+ tv <- newTVarIO (Nothing :: Maybe (Maybe a)) fapp (CryptoCookie (getRequestCookieData env req) tv) req \res -> do yya1 <- readTVarIO tv let f = case yya1 of
test/Main.hs view
@@ -13,6 +13,7 @@ import System.Directory import System.FilePath import System.IO.Error (isAlreadyExistsError)+import System.Random qualified as R import Wai.CryptoCookie qualified as WCC import Wai.CryptoCookie.Encryption qualified as WCC@@ -76,63 +77,98 @@ pure c{WCC.key = k} fmw1 <- WCC.middleware c1 - WT.withSession (fmw1 $ app id) do+ -- keeping cookies untouched+ WT.withSession (fmw1 $ app \_ -> Nothing) do+ WT.assertNoClientCookieExists "t0-a" "SESSION" sres1 <- WT.request WT.defaultRequest WT.assertBody "Nothing" sres1- WT.assertNoClientCookieExists "t1-a" "SESSION"-+ WT.assertNoClientCookieExists "t0-b" "SESSION" sres1 <- WT.request WT.defaultRequest WT.assertBody "Nothing" sres1- WT.assertNoClientCookieExists "t1-b" "SESSION"+ WT.assertNoClientCookieExists "t0-c" "SESSION" - ck0 <- WT.withSession (fmw1 $ app \_ -> Just 900) do+ -- explicitly deleting cookie+ WT.withSession (fmw1 $ app \_ -> Just Nothing) do+ WT.assertNoClientCookieExists "t1-a" "SESSION" sres1 <- WT.request WT.defaultRequest WT.assertBody "Nothing" sres1- WT.assertClientCookieExists "t2-a" "SESSION"+ WT.assertClientCookieExists "t1-b" "SESSION"+ sres1 <- WT.request WT.defaultRequest+ WT.assertBody "Nothing" sres1+ WT.assertClientCookieExists "t1-c" "SESSION" + -- explicitely setting cookie+ ck0 <- WT.withSession (fmw1 $ app \_ -> Just (Just 900)) do+ WT.assertNoClientCookieExists "t2-a" "SESSION"+ sres1 <- WT.request WT.defaultRequest+ WT.assertBody "Nothing" sres1+ WT.assertClientCookieExists "t2-b" "SESSION" sres2 <- WT.request WT.defaultRequest WT.assertBody "Just 900" sres2- WT.assertClientCookieExists "t2-b" "SESSION"-+ WT.assertClientCookieExists "t2-c" "SESSION" WT.getClientCookies - WT.withSession (fmw1 $ app \_ -> Nothing) do+ -- modify and explicitly delete+ WT.withSession (fmw1 $ app \_ -> Just Nothing) do+ WT.assertNoClientCookieExists "t3-a" "SESSION" WT.modifyClientCookies \_ -> ck0-+ WT.assertClientCookieExists "t3-b" "SESSION" sres1 <- WT.request WT.defaultRequest WT.assertBody "Just 900" sres1- WT.assertClientCookieExists "t3-a" "SESSION"-+ WT.assertClientCookieExists "t3-c" "SESSION" sres2 <- WT.request WT.defaultRequest WT.assertBody "Nothing" sres2- WT.assertClientCookieExists "t3-b" "SESSION"- WT.assertClientCookieValue "t3-c" "SESSION" ""+ WT.assertClientCookieExists "t3-d" "SESSION"+ WT.assertClientCookieValue "t3-e" "SESSION" "" - WT.withSession (fmw1 $ app (fmap (+ 1))) do+ -- set/modify+ WT.withSession (fmw1 $ app (Just . fmap (+ 1))) do+ WT.assertNoClientCookieExists "t4-a" "SESSION" sres1 <- WT.request WT.defaultRequest WT.assertBody "Nothing" sres1- WT.assertNoClientCookieExists "t4-a" "SESSION"-+ WT.assertClientCookieExists "t4-b" "SESSION" WT.modifyClientCookies \_ -> ck0-+ WT.assertClientCookieExists "t4-c" "SESSION" sres2 <- WT.request WT.defaultRequest WT.assertBody "Just 900" sres2- WT.assertClientCookieExists "t4-b" "SESSION"-+ WT.assertClientCookieExists "t4-d" "SESSION" sres2 <- WT.request WT.defaultRequest WT.assertBody "Just 901" sres2 WT.assertClientCookieExists "t4-c" "SESSION" + -- We make sure that no matter how many interactions with+ -- cc we have, we always keep the last. See app2.+ WT.withSession (fmw1 app2) do+ WT.assertNoClientCookieExists "t5-a" "SESSION"+ sres1 <- WT.request WT.defaultRequest+ WT.assertBody "Nothing" sres1+ replicateM_ 1000 do+ WT.assertClientCookieExists "t5-b" "SESSION"+ sres1 <- WT.request WT.defaultRequest+ WT.assertBody "Just 2" sres1+ app- :: (Maybe Word -> Maybe Word)+ :: (Maybe Word -> Maybe (Maybe Word)) -> WCC.CryptoCookie Word -> W.Application app g cc = \req res -> do let yold = WCC.get cc- ynew = g yold- when (ynew /= yold) do- atomically $ WCC.set cc ynew+ case g yold of+ Nothing -> pure ()+ Just Nothing -> atomically $ WCC.delete cc+ Just (Just new) -> atomically $ WCC.set cc new res $ W.responseLBS HT.status200 [] $ fromString $ show yold++app2 :: WCC.CryptoCookie Word -> W.Application+app2 cc = \req res -> do+ n <- R.randomRIO (0, 10)+ xs <- replicateM n $ R.randomRIO ('a', 'c')+ forM_ xs \case+ 'a' -> atomically $ WCC.set cc 1+ 'b' -> atomically $ WCC.delete cc+ _ -> atomically $ WCC.keep cc+ atomically $ WCC.set cc 2+ res $ W.responseLBS HT.status200 [] $ fromString $ show $ WCC.get cc withTmpDir :: (FilePath -> IO a) -> IO a withTmpDir f = do
wai-cryptocookie.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: wai-cryptocookie-version: 0.1+version: 0.2 license: Apache-2.0 license-file: LICENSE extra-source-files: README.md CHANGELOG.md@@ -70,5 +70,6 @@ wai, wai-cryptocookie, wai-extra,+ random, stm,