Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
P
purescript-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
140
Issues
140
List
Board
Labels
Milestones
Merge Requests
2
Merge Requests
2
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
purescript-gargantext
Commits
38061569
Commit
38061569
authored
Oct 15, 2019
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Plain Diff
[MERGE] session-persistence.
parents
8ae2ec0e
bb01b8ea
Changes
1
Show whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
33 additions
and
20 deletions
+33
-20
Sessions.purs
src/Gargantext/Sessions.purs
+33
-20
No files found.
src/Gargantext/Sessions.purs
View file @
38061569
-- | 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
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment