Make session store lazy

Author: paluh

src/WebRow/Session.purs

@@ -4,7 +4,7 @@ import Prelude
 
 import Data.Argonaut (Json)
 import Data.Either (hush)
-import Data.Lazy (force) as Lazy
+import Data.Lazy (force)
 import Data.Map (Map)
 import Data.Maybe (fromMaybe)
 import Data.Validation.Semigroup (toEither)
@@ -85,11 +85,11 @@ runInStore store action = do
       -- | * Handle custom cookie attributes (expiration etc.).
       -- | * Should we raise here internalServerError when `set` returns `false`?
       -- | * Should we run testing cycle of test cookie setup?
-      void $ Cookies.set cookieName { value: store.key, attributes: Cookies.defaultAttributes }
+      void $ Cookies.set cookieName { value: force store.key, attributes: Cookies.defaultAttributes }
       store.fetch >>= next >>> pure
 
     handleSession (SaveF v next) = do
-      void $ Cookies.set cookieName { value: store.key, attributes: Cookies.defaultAttributes }
+      void $ Cookies.set cookieName { value: force store.key, attributes: Cookies.defaultAttributes }
       a ← store.save v
       pure (next a)
   Run.interpret (Run.on _session handleSession Run.send) action
@@ -104,7 +104,7 @@ runInMemoryStore ref defaultSession action = do
   -- | This laziness is a myth let's drop this all together
   lazySessionKey ← Cookies.lookup cookieName
   effSessionStore ← Run.liftEffect $
-    SessionStore.InMemory.new ref defaultSession (Lazy.force lazySessionKey)
+    SessionStore.InMemory.new ref defaultSession lazySessionKey
   runInStore (SessionStore.hoist Run.liftEffect $ effSessionStore) action
 
 -- | The whole session is stored in a cookie value so visible in the browser.
@@ -119,7 +119,7 @@ runInCookieValue dual defaultSession =
   let
     fetchFromCookie = do
       default ← defaultSession
-      map (decode default) <$> Cookies.lookupJson cookieName
+      decode default <<< force <$> Cookies.lookupJson cookieName
       where
         decode default maybeRepr =
           fromMaybe default
@@ -131,7 +131,7 @@ runInCookieValue dual defaultSession =
       pure (next true)
 
     handleSession (FetchF next) = do
-      session ← Lazy.force <$> fetchFromCookie
+      session ← fetchFromCookie
       let
         json = Pure.runSerializer dual session
       -- | TODO:
@@ -142,7 +142,6 @@ runInCookieValue dual defaultSession =
       pure $ next session
 
     handleSession (SaveF v next) = do
-      lazySession ← fetchFromCookie
       let
         json = Pure.runSerializer dual v
       void $ Cookies.setJson cookieName { json, attributes: Cookies.defaultAttributes }

src/WebRow/Session/SessionStore.purs

@@ -1,6 +1,8 @@
 module WebRow.Session.SessionStore where
 
 import Prelude
+
+import Data.Lazy (Lazy, defer, force)
 import Data.Maybe (fromMaybe)
 import Prim.Row (class Union) as Row
 import Run (Run)
@@ -10,7 +12,7 @@ import WebRow.KeyValueStore (KeyValueStore, Key)
 type SessionStore m session
   = { delete ∷ m Boolean
     , fetch ∷ m session
-    , key ∷ Key
+    , key ∷ Lazy Key
     , save ∷ session → m Boolean
     }
 
@@ -41,20 +43,20 @@ new default kv =
         pure
           { delete: kv.delete k
           , fetch: kv.get k >>= fromMaybe default >>> pure
-          , key: k
+          , key: defer \_ → k
           , save: kv.put k
           }
 
 forKey ∷
   ∀ m session.
   Monad m ⇒
   session →
-  Key →
+  Lazy Key →
   KeyValueStore m session →
   SessionStore m session
 forKey default k kv =
-  { delete: kv.delete k
-  , fetch: kv.get k >>= fromMaybe default >>> pure
+  { delete: kv.delete (force k)
+  , fetch: kv.get (force k) >>= fromMaybe default >>> pure
   , key: k
-  , save: kv.put k
+  , save: kv.put (force k)
   }

src/WebRow/Session/SessionStore/InMemory.purs

@@ -1,21 +1,24 @@
 module WebRow.Session.SessionStore.InMemory where
 
 import Prelude
+
+import Data.Lazy (Lazy)
 import Data.Map (Map)
-import Data.Maybe (Maybe(..))
+import Data.Maybe (Maybe, fromMaybe)
 import Effect (Effect)
 import Effect.Ref (Ref)
 import WebRow.KeyValueStore (Key)
 import WebRow.KeyValueStore.InMemory (forRef) as KeyValueStore.InMemory
 import WebRow.Session.SessionStore (SessionStore)
-import WebRow.Session.SessionStore (forKey, new) as SessionStore
+import WebRow.Session.SessionStore (forKey) as SessionStore
 
-new ∷ ∀ session. Ref (Map String session) → session → Maybe Key → Effect (SessionStore Effect session)
-new ref defaultSession =
+new ∷ ∀ session. Ref (Map String session) → session → Lazy (Maybe Key) → Effect (SessionStore Effect session)
+new ref defaultSession maybeKey = do
   let
     kv = KeyValueStore.InMemory.forRef ref
-  in
-    case _ of
-      Just key → pure $ SessionStore.forKey defaultSession key kv
-      Nothing → SessionStore.new defaultSession kv
+  newKey ← kv.new
+  let
+    key = fromMaybe newKey <$> maybeKey
+  pure $ SessionStore.forKey defaultSession key kv
+
 

src/WebRow/Testing/Session.purs

@@ -3,6 +3,7 @@ module WebRow.Testing.Session where
 import Prelude
 
 import Data.Argonaut (Json)
+import Data.Lazy (defer)
 import Data.Map (Map)
 import Data.Maybe (Maybe)
 import Effect (Effect)
@@ -49,7 +50,7 @@ runInMemory ∷
   Run (EffRow + eff) a
 runInMemory { default, key, ref } action = do
   let
-    ss = SessionStore.InMemory.new ref default key
+    ss = SessionStore.InMemory.new ref default (defer \_ → key)
 
     ss' = map (SessionStore.hoist Run.liftEffect) $ ss
   run ss' action