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
142
Issues
142
List
Board
Labels
Milestones
Merge Requests
4
Merge Requests
4
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
aba97048
Commit
aba97048
authored
Oct 26, 2020
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[sessions] store cache state in local storage
parent
9c4f2849
Changes
9
Hide whitespace changes
Inline
Side-by-side
Showing
9 changed files
with
155 additions
and
84 deletions
+155
-84
App.purs
src/Gargantext/Components/App.purs
+29
-29
Forest.purs
src/Gargantext/Components/Forest.purs
+15
-11
Login.purs
src/Gargantext/Components/Login.purs
+4
-4
Contacts.purs
src/Gargantext/Components/Nodes/Annuaire/User/Contacts.purs
+1
-0
Lists.purs
src/Gargantext/Components/Nodes/Lists.purs
+13
-6
Types.purs
src/Gargantext/Components/Nodes/Lists/Types.purs
+14
-0
Texts.purs
src/Gargantext/Components/Nodes/Texts.purs
+24
-11
Table.purs
src/Gargantext/Components/Table.purs
+6
-4
Sessions.purs
src/Gargantext/Sessions.purs
+49
-19
No files found.
src/Gargantext/Components/App.purs
View file @
aba97048
...
...
@@ -36,6 +36,7 @@ import Gargantext.Sessions as Sessions
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
thisModule :: String
thisModule = "Gargantext.Components.App"
-- TODO (what does this mean?)
...
...
@@ -71,67 +72,66 @@ appCpt = R.hooksComponentWithModule thisModule "app" cpt where
, showLogin: snd showLogin
, backend
}
let defaultView _ = forested $ homeLayout { backend
, lang: LL_EN
, publicBackend
, sessions
, visible: showLogin
}
let mCurrentRoute = fst route
let withSession sid f = maybe' ( const $ forested
$ homeLayout { lang: LL_EN
, backend
, publicBackend
, sessions
, visible:showLogin
}
)
(ff f)
(Sessions.lookup sid (fst sessions))
let withSession sid f = maybe' defaultView (ff f) (Sessions.lookup sid (fst sessions))
let sessionUpdate s = snd sessions $ Sessions.Update s
pure $ case fst showLogin of
true -> forested $ login { backend, backends, sessions, visible: showLogin }
false ->
case fst route of
Home -> forested $ homeLayout {lang:LL_EN, backend, publicBackend, sessions, visible:showLogin}
Login -> login { backends, sessions, visible: showLogin, backend}
Folder sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
FolderPrivate sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
FolderPublic sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
FolderShared sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
Team sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
RouteFrameWrite sid nodeId -> withSession sid $ \session -> forested $ frameLayout { nodeId, session }
RouteFrameCalc sid nodeId -> withSession sid $ \session -> forested $ frameLayout { nodeId, session }
RouteFile sid nodeId -> withSession sid $ \session -> forested $ fileLayout { nodeId, session }
Corpus sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
Texts sid nodeId -> withSession sid $ \session -> forested $ textsLayout { nodeId, session, frontends }
Lists sid nodeId -> withSession sid $ \session -> forested $ listsLayout { nodeId, session }
Dashboard sid nodeId -> withSession sid $ \session -> forested $ dashboardLayout { nodeId, session }
Annuaire sid nodeId -> withSession sid $ \session -> forested $ annuaireLayout { frontends, nodeId, session }
UserPage sid nodeId -> withSession sid $ \session -> forested $ userLayout { frontends, nodeId, session }
ContactPage sid aId nodeId -> withSession sid $ \session -> forested $ annuaireUserLayout { annuaireId: aId, frontends, nodeId, session }
Corpus sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
CorpusDocument sid corpusId listId nodeId -> withSession sid $ \session -> forested $ documentLayout { nodeId, listId, session, corpusId: Just corpusId }
Dashboard sid nodeId -> withSession sid $ \session -> forested $ dashboardLayout { nodeId, session }
Document sid listId nodeId ->
withSession sid $
\session -> forested $ documentLayout { nodeId, listId, session, corpusId: Nothing }
Folder sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
FolderPrivate sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
FolderPublic sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
FolderShared sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
Home -> forested $ homeLayout { backend, lang:LL_EN, publicBackend, sessions, visible: showLogin }
Lists sid nodeId -> withSession sid $ \session -> forested $ listsLayout { nodeId, session, sessionUpdate }
Login -> login { backend, backends, sessions, visible: showLogin }
PGraphExplorer sid graphId ->
withSession sid $
\session ->
simpleLayout handed $
explorerLayout { frontends
explorerLayout { backend
, frontends
, graphId
, handed: fst handed
, mCurrentRoute
, session
, sessions: (fst sessions)
, showLogin
, backend
--, treeReload
}
RouteFile sid nodeId -> withSession sid $ \session -> forested $ fileLayout { nodeId, session }
RouteFrameCalc sid nodeId -> withSession sid $ \session -> forested $ frameLayout { nodeId, session }
RouteFrameWrite sid nodeId -> withSession sid $ \session -> forested $ frameLayout { nodeId, session }
Team sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
Texts sid nodeId -> withSession sid $ \session -> forested $ textsLayout { frontends, nodeId, session, sessionUpdate }
UserPage sid nodeId -> withSession sid $ \session -> forested $ userLayout { frontends, nodeId, session }
type ForestLayoutProps =
( child :: R.Element
( backend :: R.State (Maybe Backend)
, child :: R.Element
, frontends :: Frontends
, handed :: R.State GT.Handed
, reload :: R.State Int
, route :: AppRoute
, sessions :: Sessions
, showLogin :: R.Setter Boolean
, backend :: R.State (Maybe Backend)
)
forestLayout :: Record ForestLayoutProps -> R.Element
...
...
src/Gargantext/Components/Forest.purs
View file @
aba97048
...
...
@@ -6,6 +6,9 @@ import Data.Maybe (Maybe(..))
import Data.Set as Set
import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\))
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest.Tree (treeView)
import Gargantext.Ends (Frontends, Backend(..))
...
...
@@ -14,19 +17,18 @@ import Gargantext.Routes (AppRoute)
import Gargantext.Sessions (Session(..), Sessions, OpenNodes, unSessions)
import Gargantext.Types (Reload, Handed(..))
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
thisModule :: String
thisModule = "Gargantext.Components.Forest"
type Props =
( frontends :: Frontends
( backend :: R.State (Maybe Backend)
, frontends :: Frontends
, handed :: Handed
, reload :: R.State Int
, route :: AppRoute
, sessions :: Sessions
, showLogin :: R.Setter Boolean
, backend :: R.State (Maybe Backend)
)
forest :: Record Props -> R.Element
...
...
@@ -55,21 +57,18 @@ forestCpt = R.hooksComponentWithModule thisModule "forest" cpt where
where
trees = tree <$> unSessions sessions
tree s@(Session {treeId}) =
treeView { root: treeId
, asyncTasks
treeView { asyncTasks
, frontends
, handed
, mCurrentRoute: Just route
, openNodes
, reload
, root: treeId
, session: s
}
plus :: Handed -> R.Setter Boolean -> R.State (Maybe Backend) -> R.Element
plus handed showLogin backend = H.div {className: if handed == RightHanded
then "flex-start" -- TODO we should use lefthanded SASS class here
else "flex-end"
} [
plus handed showLogin backend = H.div { className: handedClass } [
H.button { title: "Add or remove connections to the server(s)."
, on: {click}
, className: "btn btn-default"
...
...
@@ -81,9 +80,14 @@ plus handed showLogin backend = H.div {className: if handed == RightHanded
--, H.div { "type": "", className: "fa fa-plus-circle fa-lg"} []
--, H.div { "type": "", className: "fa fa-minus-circle fa-lg"} []
]
]
]
-- TODO same as the one in the Login Modal (same CSS)
-- [ H.i { className: "material-icons md-36"} [] ]
where
handedClass = if handed == RightHanded then
"flex-start" -- TODO we should use lefthanded SASS class here
else
"flex-end"
click _ = (snd backend) (const Nothing)
*> showLogin (const true)
src/Gargantext/Components/Login.purs
View file @
aba97048
...
...
@@ -38,10 +38,10 @@ thisModule = "Gargantext.Components.Login"
-- if not logged user can not save his work
type LoginProps =
( backends :: Array Backend
( backend :: R.State (Maybe Backend)
, backends :: Array Backend
, sessions :: R2.Reductor Sessions Sessions.Action
, visible :: R.State Boolean
, backend :: R.State (Maybe Backend)
)
login :: Record LoginProps -> R.Element
...
...
@@ -104,7 +104,7 @@ chooser props = R.createElement chooserCpt props []
chooserCpt :: R.Component LoginProps
chooserCpt = R.staticComponent "G.C.Login.chooser" cpt where
cpt :: Record LoginProps -> Array R.Element -> R.Element
cpt {
backend, backends, sessions
} _ =
cpt {
backend, backends, sessions
} _ =
R.fragment $ title <> active <> new <> search
where
title = [H.h2 { className: "center modal-title" } [H.text "Instances manager"]]
...
...
@@ -152,7 +152,7 @@ renderSessions sessions = R.fragment (renderSession sessions <$> unSessions (fst
GHL.clearCache unit
NTL.clearCache unit
liftEffect $ log "[renderSessions] cache cleared"
logOutClick _ =
(snd sessions') (Sessions.Logout session)
logOutClick _ =
snd sessions' $ Sessions.Logout session
renderBackend :: R.State (Maybe Backend) -> Backend -> R.Element
renderBackend state backend@(Backend {name}) =
...
...
src/Gargantext/Components/Nodes/Annuaire/User/Contacts.purs
View file @
aba97048
...
...
@@ -27,6 +27,7 @@ import Gargantext.Sessions (Session, get, put, sessionId)
import Gargantext.Types (NodeType(..))
import Gargantext.Utils.Reactix as R2
thisModule :: String
thisModule = "Gargantext.Components.Nodes.Annuaire.User.Contacts"
display :: String -> Array R.Element -> R.Element
...
...
src/Gargantext/Components/Nodes/Lists.purs
View file @
aba97048
module Gargantext.Components.Nodes.Lists where
import Effect (Effect)
import Effect.Aff (launchAff_)
import Reactix as R
------------------------------------------------------------------------
...
...
@@ -12,9 +13,10 @@ import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Components.Table as Table
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude
import Gargantext.Sessions (Session, sessionId)
import Gargantext.Sessions (Session, sessionId
, getCacheState, setCacheState
)
import Gargantext.Utils.Reactix as R2
thisModule :: String
thisModule = "Gargantext.Components.Nodes.Lists"
------------------------------------------------------------------------
------------------------------------------------------------------------
...
...
@@ -22,6 +24,7 @@ thisModule = "Gargantext.Components.Nodes.Lists"
type Props = (
nodeId :: Int
, session :: Session
, sessionUpdate :: Session -> Effect Unit
)
listsLayout :: Record Props -> R.Element
...
...
@@ -30,10 +33,10 @@ listsLayout props = R.createElement listsLayoutCpt props []
listsLayoutCpt :: R.Component Props
listsLayoutCpt = R.hooksComponentWithModule thisModule "listsLayout" cpt
where
cpt path@{ nodeId, session } _ = do
cpt path@{ nodeId, session
, sessionUpdate
} _ = do
let sid = sessionId session
pure $ listsLayoutWithKey { key: show sid <> "-" <> show nodeId, nodeId, session }
pure $ listsLayoutWithKey { key: show sid <> "-" <> show nodeId, nodeId, session
, sessionUpdate
}
type KeyProps = (
key :: String
...
...
@@ -46,10 +49,10 @@ listsLayoutWithKey props = R.createElement listsLayoutWithKeyCpt props []
listsLayoutWithKeyCpt :: R.Component KeyProps
listsLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "listsLayoutWithKey" cpt
where
cpt { nodeId, session } _ = do
cpt { nodeId, session
, sessionUpdate
} _ = do
let path = { nodeId, session }
cacheState <- R.useState'
NT.CacheOn
cacheState <- R.useState'
$ getCacheState NT.CacheOn session nodeId
useLoader path loadCorpusWithChild $
\corpusData@{ corpusId, corpusNode: NodePoly poly, defaultListId } ->
...
...
@@ -58,7 +61,7 @@ listsLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "listsLayoutWithKe
in
R.fragment [
Table.tableHeaderLayout {
afterCacheStateChange
: \_ -> launchAff_ $ clearCache unit
afterCacheStateChange
, cacheState
, date
, desc
...
...
@@ -71,4 +74,8 @@ listsLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "listsLayoutWithKe
, corpusId
, session }
]
where
afterCacheStateChange cacheState = do
launchAff_ $ clearCache unit
sessionUpdate $ setCacheState session nodeId cacheState
------------------------------------------------------------------------
src/Gargantext/Components/Nodes/Lists/Types.purs
View file @
aba97048
module Gargantext.Components.Nodes.Lists.Types where
import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson, (~>), (:=))
import Data.Argonaut.Decode.Error (JsonDecodeError(..))
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Gargantext.Prelude
thisModule :: String
thisModule = "Gargantext.Components.Nodes.Lists.Types"
data CacheState = CacheOn | CacheOff
...
...
@@ -12,3 +16,13 @@ data CacheState = CacheOn | CacheOff
derive instance genericCacheState :: Generic CacheState _
instance eqCacheState :: Eq CacheState where
eq = genericEq
instance decodeJsonCacheState :: DecodeJson CacheState where
decodeJson json = do
obj <- decodeJson json
case obj of
"CacheOn" -> pure CacheOn
"CacheOff" -> pure CacheOff
s -> Left $ AtKey s $ TypeMismatch $ "Unknown cache value"
instance encodeJsonCacheState :: EncodeJson CacheState where
encodeJson CacheOn = encodeJson "CacheOn"
encodeJson CacheOff = encodeJson "CacheOff"
src/Gargantext/Components/Nodes/Texts.purs
View file @
aba97048
...
...
@@ -5,6 +5,7 @@ import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (launchAff_)
import Reactix as R
import Reactix.DOM.HTML as H
...
...
@@ -20,7 +21,7 @@ import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Components.Tab as Tab
import Gargantext.Components.Table as Table
import Gargantext.Ends (Frontends)
import Gargantext.Sessions (Session,
sessionId
)
import Gargantext.Sessions (Session,
Sessions, sessionId, getCacheState, setCacheState
)
import Gargantext.Types (CTabNgramType(..), TabSubType(..), TabType(..))
import Gargantext.Utils.Reactix as R2
...
...
@@ -31,6 +32,7 @@ type Props = (
frontends :: Frontends
, nodeId :: Int
, session :: Session
, sessionUpdate :: Session -> Effect Unit
)
textsLayout :: Record Props -> R.Element
...
...
@@ -39,10 +41,14 @@ textsLayout props = R.createElement textsLayoutCpt props []
------------------------------------------------------------------------
textsLayoutCpt :: R.Component Props
textsLayoutCpt = R.hooksComponentWithModule thisModule "textsLayout" cpt where
cpt { frontends, nodeId, session } _ = do
cpt { frontends, nodeId, session
, sessionUpdate
} _ = do
let sid = sessionId session
pure $ textsLayoutWithKey { frontends, key: show sid <> "-" <> show nodeId, nodeId, session }
pure $ textsLayoutWithKey { frontends
, key: show sid <> "-" <> show nodeId
, nodeId
, session
, sessionUpdate }
type KeyProps = (
key :: String
...
...
@@ -55,10 +61,10 @@ textsLayoutWithKey props = R.createElement textsLayoutWithKeyCpt props []
textsLayoutWithKeyCpt :: R.Component KeyProps
textsLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "textsLayoutWithKey" cpt
where
cpt { frontends, nodeId, session } _ = do
cacheState <- R.useState'
NT.CacheOn
cpt { frontends, nodeId, session
, sessionUpdate
} _ = do
cacheState <- R.useState'
$ getCacheState NT.CacheOn session nodeId
pure $ loader {
session, nodeId
} loadCorpusWithChild $
pure $ loader {
nodeId, session
} loadCorpusWithChild $
\corpusData@{ corpusId, corpusNode, defaultListId } -> do
let NodePoly { name, date, hyperdata: Hyperdata h } = corpusNode
CorpusInfo { authors, desc, query } = getCorpusInfo h.fields
...
...
@@ -66,7 +72,7 @@ textsLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "textsLayoutWithKe
title = "Corpus " <> name
R.fragment [
Table.tableHeaderLayout { afterCacheStateChange
: \_ -> launchAff_ $ clearCache unit
Table.tableHeaderLayout { afterCacheStateChange
, cacheState
, date
, desc
...
...
@@ -75,6 +81,10 @@ textsLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "textsLayoutWithKe
, user: authors }
, tabs'
]
where
afterCacheStateChange cacheState = do
launchAff_ $ clearCache unit
sessionUpdate $ setCacheState session nodeId cacheState
data Mode = MoreLikeFav | MoreLikeTrash
...
...
@@ -89,7 +99,10 @@ modeTabType :: Mode -> CTabNgramType
modeTabType MoreLikeFav = CTabAuthors -- TODO
modeTabType MoreLikeTrash = CTabSources -- TODO
type TabsProps = ( frontends :: Frontends, session :: Session, corpusId :: Int, corpusData :: CorpusData )
type TabsProps = ( corpusData :: CorpusData
, corpusId :: Int
, frontends :: Frontends
, session :: Session )
tabs :: Record TabsProps -> R.Element
tabs props = R.createElement tabsCpt props []
...
...
@@ -113,10 +126,10 @@ tabsCpt = R.hooksComponentWithModule thisModule "tabs" cpt
trash = docView' TabTrash
type DocViewProps a =
( frontends :: Frontends
, session :: Session
( corpusData :: CorpusData
, corpusId :: Int
, corpusData :: CorpusData
, frontends :: Frontends
, session :: Session
, tabType :: TabSubType a )
docView :: forall a. Record (DocViewProps a) -> R.Element
...
...
src/Gargantext/Components/Table.purs
View file @
aba97048
...
...
@@ -90,7 +90,7 @@ stateParams {pageSize, page, orderBy, searchType} = {offset, limit, orderBy, sea
offset = limit * (page - 1)
type TableHeaderLayoutProps =
( afterCacheStateChange ::
Unit
-> Effect Unit
( afterCacheStateChange ::
NT.CacheState
-> Effect Unit
, cacheState :: R.State NT.CacheState
, date :: String
, desc :: String
...
...
@@ -153,9 +153,11 @@ tableHeaderLayoutCpt = R.hooksComponentWithModule thisModule "tableHeaderLayout"
cacheText (NT.CacheOn /\ _) = "Cache On"
cacheText (NT.CacheOff /\ _) = "Cache Off"
cacheClick (_ /\ setCacheState) after _ = do
setCacheState cacheStateToggle
after unit
cacheClick (cacheState /\ setCacheState) after _ = do
setCacheState $ const newCacheState
after newCacheState
where
newCacheState = cacheStateToggle cacheState
cacheStateToggle NT.CacheOn = NT.CacheOff
cacheStateToggle NT.CacheOff = NT.CacheOn
...
...
src/Gargantext/Sessions.purs
View file @
aba97048
-- | A module for authenticating to create sessions and handling them
module Gargantext.Sessions where
import DOM.Simple.Console (log2)
import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson, (:=), (~>), (.:))
import Data.Argonaut.Core (Json, fromArray, jsonEmptyObject, stringify)
import Data.Argonaut.Decode.Error (JsonDecodeError(..))
...
...
@@ -10,32 +9,38 @@ import Data.Array as A
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Maybe (Maybe(..))
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Sequence (Seq)
import Data.Sequence as Seq
import Data.Set (Set)
import Data.Traversable (traverse)
import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect.Aff (Aff)
import Prelude (class Eq, class Show, Unit, const, otherwise, pure, show, unit, ($), (*>), (<*), (<$>), (<>), (==), (/=), (>>=), (<<<), bind)
import Reactix as R
import Web.Storage.Storage (getItem, removeItem, setItem)
import Gargantext.Components.Login.Types (AuthData(..), AuthInvalid(..), AuthRequest(..), AuthResponse(..), TreeId)
import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Config.REST as REST
import Gargantext.Ends (class ToUrl, Backend(..), backendUrl, sessionPath, toUrl)
import Gargantext.Routes (SessionRoute)
import Gargantext.Types (NodePath, SessionId(..), nodePath)
import Gargantext.Utils.Reactix (getls)
import Gargantext.Utils.Reactix as R2
import Prelude (class Eq, class Show, Unit, const, otherwise, pure, show, unit, ($), (*>), (<*), (<$>), (<>), (==), (/=), (>>=), (<<<), bind)
import Reactix as R
import Web.Storage.Storage (getItem, removeItem, setItem)
-- | A Session represents an authenticated session for a user at a
-- | backend. It contains a token and root tree id.
newtype Session = Session
{ backend :: Backend
,
username :: String
,
caches :: Map Int NT.CacheState -- whether cache is turned on for node id
, token :: String
, treeId :: TreeId
, username :: String
}
------------------------------------------------------------------------
...
...
@@ -64,21 +69,23 @@ sessionId = SessionId <<< show
--------------------
-- | JSON instances
instance encodeJsonSession :: EncodeJson Session where
encodeJson (Session {
backend, username, token, treeId
})
=
"backend" := encodeJson backend
~> "
username" := username
~> "token" :=
token
encodeJson (Session {
backend, caches, username, token, treeId
})
= "backend" := encodeJson backend
~> "
caches" := encodeJson caches
~> "token" := token
~> "treeId" := treeId
~> "username" := username
~> jsonEmptyObject
instance decodeJsonSession :: DecodeJson Session where
decodeJson json = do
obj <- decodeJson json
backend <- obj .: "backend"
username <- obj .: "username
"
caches <- obj .: "caches
"
token <- obj .: "token"
treeId <- obj .: "treeId"
pure $ Session { backend, username, token, treeId}
username <- obj .: "username"
pure $ Session { backend, caches, token, treeId, username }
------------------------------------------------------------------------
...
...
@@ -124,10 +131,18 @@ cons :: Session -> Sessions -> Sessions
cons s (Sessions {sessions:ss}) = Sessions {sessions:(Seq.cons s ss)}
tryCons :: Session -> Sessions -> Either Unit Sessions
tryCons s ss = try (lookup sid ss) where
sid = sessionId s
try Nothing = Right (cons s ss)
try _ = Left unit
tryCons s ss = try $ lookup sid ss
where
sid = sessionId s
try Nothing = Right (cons s ss)
try _ = Left unit
update :: Session -> Sessions -> Sessions
update s ss = up $ lookup sid ss
where
sid = sessionId s
up Nothing = cons s ss
up _ = cons s $ remove sid ss
remove :: SessionId -> Sessions -> Sessions
remove sid (Sessions {sessions:ss}) = Sessions {sessions: Seq.filter f ss} where
...
...
@@ -157,6 +172,7 @@ instance toUrlSessionString :: ToUrl Session String where
data Action
= Login Session
| Logout Session
| Update Session
act :: Sessions -> Action -> Effect Sessions
act ss (Login s) =
...
...
@@ -167,18 +183,26 @@ act old@(Sessions ss) (Logout s) =
case tryRemove (sessionId s) old of
Right new -> pure $ new
_ -> pure old <* log2 "Logged out of stale session:" (sessionId s)
act ss (Update s) = saveSessions $ update s ss
-- Key we will store the data under
localStorageKey :: String
localStorageKey = "garg-sessions"
empty :: Sessions
empty = Sessions {
sessions:Seq.empty
}
empty = Sessions {
sessions: Seq.empty
}
-- True if there are no sessions stored
null :: Sessions -> Boolean
null (Sessions {
sessions:seq
}) = Seq.null seq
null (Sessions {
sessions: seq
}) = Seq.null seq
getCacheState :: NT.CacheState -> Session -> Int -> NT.CacheState
getCacheState defaultCacheState (Session { caches }) nodeId =
fromMaybe defaultCacheState $ Map.lookup nodeId caches
setCacheState :: Session -> Int -> NT.CacheState -> Session
setCacheState (Session session@{ caches }) nodeId cacheState =
Session $ session { caches = Map.insert nodeId cacheState caches }
-- | Will attempt to load saved sessions from localstorage. should log
-- | if decoding fails
...
...
@@ -208,6 +232,12 @@ saveSessions sessions = effect *> pure sessions where
| null sessions = rem
| otherwise = set (stringify $ encodeJson sessions)
updateSession :: Session -> Effect Unit
updateSession s = do
ss <- loadSessions
_ <- saveSessions $ update s ss
pure unit
postAuthRequest :: Backend -> AuthRequest -> Aff (Either String Session)
postAuthRequest backend ar@(AuthRequest {username}) =
decode <$> REST.post Nothing (toUrl backend "auth") ar
...
...
@@ -215,7 +245,7 @@ postAuthRequest backend ar@(AuthRequest {username}) =
decode (AuthResponse ar2)
| {inval: Just (AuthInvalid {message})} <- ar2 = Left message
| {valid: Just (AuthData {token, tree_id})} <- ar2 =
Right $ Session { backend,
username, token, treeId: tree_id
}
Right $ Session { backend,
caches: Map.empty, token, treeId: tree_id, username
}
| otherwise = Left "Invalid response from server"
get :: forall a p. DecodeJson a => ToUrl Session p => Session -> p -> Aff a
...
...
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