Commit 38061569 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[MERGE] session-persistence.

parents 8ae2ec0e bb01b8ea
-- | A module for authenticating to create sessions and handling them -- | A module for authenticating to create sessions and handling them
module Gargantext.Sessions where module Gargantext.Sessions where
import Prelude (class Eq, class Show, Unit, const, otherwise, pure, show, unit, ($), (*>), (<*), (<$>), (<>), (==), (/=), (>>=), (<<<), bind) import Prelude (class Eq, class Show, Unit, const, otherwise, pure, show, unit, ($), (*>), (<*), (<$>), (<>), (==), (/=), (>>=), (>=>), (<<<), bind)
import Data.Argonaut ( class DecodeJson, decodeJson, class EncodeJson, encodeJson, (:=), (~>), jsonEmptyObject, (.:), Json, fromArray) import Control.Monad.Except (runExcept)
import Data.Argonaut ( class DecodeJson, decodeJson, class EncodeJson, encodeJson, (:=), (~>), (.:), Json)
import Data.Argonaut.Core (Json, fromArray, jsonEmptyObject, stringify)
import Data.Argonaut.Parser (jsonParser)
import Data.Array as A import Data.Array as A
import Data.Traversable (traverse) import Data.Traversable (traverse)
import DOM.Simple.Console (log2) import DOM.Simple.Console (log2)
...@@ -17,7 +20,7 @@ import Effect.Aff (Aff) ...@@ -17,7 +20,7 @@ import Effect.Aff (Aff)
import Reactix as R import Reactix as R
import Web.HTML (window) import Web.HTML (window)
import Web.HTML.Window (localStorage) import Web.HTML.Window (localStorage)
import Web.Storage.Storage (removeItem) -- (getItem, setItem, removeItem) import Web.Storage.Storage (Storage, getItem, setItem, removeItem)
import Gargantext.Components.Login.Types import Gargantext.Components.Login.Types
(AuthRequest(..), AuthResponse(..), AuthInvalid(..), AuthData(..)) (AuthRequest(..), AuthResponse(..), AuthInvalid(..), AuthData(..))
import Gargantext.Config.REST as REST import Gargantext.Config.REST as REST
...@@ -152,7 +155,6 @@ act old@(Sessions ss) (Logout s) = ...@@ -152,7 +155,6 @@ act old@(Sessions ss) (Logout s) =
Right new -> pure $ new Right new -> pure $ new
_ -> pure old <* log2 "Logged out of stale session:" (sessionId s) _ -> pure old <* log2 "Logged out of stale session:" (sessionId s)
-- Key we will store the data under -- Key we will store the data under
localStorageKey :: String localStorageKey :: String
localStorageKey = "garg-sessions" localStorageKey = "garg-sessions"
...@@ -164,24 +166,32 @@ empty = Sessions Seq.empty ...@@ -164,24 +166,32 @@ empty = Sessions Seq.empty
null :: Sessions -> Boolean null :: Sessions -> Boolean
null (Sessions seq) = Seq.null seq null (Sessions seq) = Seq.null seq
-- | Will attempt to load saved sessions from localstorage. should log if decoding fails
-- | Will attempt to load saved sessions from localstorage. should log
-- | if decoding fails
loadSessions :: Effect Sessions loadSessions :: Effect Sessions
loadSessions = pure empty loadSessions = getls >>= getItem localStorageKey >>= handleMaybe where
{- -- a localstorage lookup can find nothing
loadSessions = window >>= localStorage >>= getItem "auths" >>= traverse decode handleMaybe (Just val) = handleEither (parse val >>= decode)
where handleMaybe Nothing = pure empty
decode :: String -> Effect (Maybe Sessions) -- either parsing or decoding could fail, hence two errors
decode = ret <<< runExcept <<< decodeJson handleEither (Left err) = err *> pure empty
ret (Right v) = pure $ Just v handleEither (Right ss) = pure ss
ret (Left e) = log2 "Error reading serialised sessions:" e *> pure (Malformed e) parse s = mapLeft (log2 "Error parsing serialised sessions:") (jsonParser s)
-} decode j = mapLeft (log2 "Error decoding serialised sessions:") (decodeJson j)
mapLeft :: forall l m r. (l -> m) -> Either l r -> Either m r
mapLeft f (Left l) = Left (f l)
mapLeft _ (Right r) = Right r
saveSessions :: Sessions -> Effect Sessions saveSessions :: Sessions -> Effect Sessions
saveSessions sessions = effect *> pure sessions saveSessions sessions = effect *> pure sessions where
where remove = getls >>= removeItem localStorageKey
set v = getls >>= setItem localStorageKey v
effect effect
| null sessions = window >>= localStorage >>= removeItem localStorageKey | null sessions = remove
| otherwise = pure unit | otherwise = set (stringify $ encodeJson sessions)
-- | otherwise = window >>= localStorage >>= setItem localStorageKey (encodeJSON sessions)
postAuthRequest :: Backend -> AuthRequest -> Aff (Either String Session) postAuthRequest :: Backend -> AuthRequest -> Aff (Either String Session)
postAuthRequest backend ar@(AuthRequest {username}) = postAuthRequest backend ar@(AuthRequest {username}) =
...@@ -212,3 +222,6 @@ post session@(Session {token}) p = REST.post (Just token) (toUrl session p) ...@@ -212,3 +222,6 @@ post session@(Session {token}) p = REST.post (Just token) (toUrl session p)
postWwwUrlencoded :: forall b p. DecodeJson b => ToUrl Session p => Session -> p -> String -> Aff b postWwwUrlencoded :: forall b p. DecodeJson b => ToUrl Session p => Session -> p -> String -> Aff b
postWwwUrlencoded session@(Session {token}) p = REST.postWwwUrlencoded (Just token) (toUrl session p) postWwwUrlencoded session@(Session {token}) p = REST.postWwwUrlencoded (Just token) (toUrl session p)
getls :: Effect Storage
getls = window >>= localStorage
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment