Sessions.purs 5.84 KB
Newer Older
1
-- | A module for authenticating to create sessions and handling them
James Laver's avatar
James Laver committed
2 3
module Gargantext.Sessions
  ( module Gargantext.Sessions.Types
4
  , WithSession, WithSessionContext
James Laver's avatar
James Laver committed
5 6 7 8 9 10
  , load, change
  , Action(..), act, delete, get, post, put, put_
  , postAuthRequest, deleteWithBody, postWwwUrlencoded
  , getCacheState, setCacheState
  ) where

11 12
import DOM.Simple.Console (log2)
import Data.Either (Either(..), hush)
13 14
import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe)
15 16
import Effect (Effect)
import Effect.Aff (Aff)
17 18 19 20 21 22 23
import Reactix as R
import Simple.JSON as JSON
import Toestand as T
import Web.Storage.Storage (getItem, removeItem, setItem)

import Gargantext.Prelude

24 25 26 27 28
import Gargantext.Components.Login.Types (AuthData(..), AuthInvalid(..), AuthRequest(..), AuthResponse(..))
import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Config.REST as REST
import Gargantext.Ends (class ToUrl, Backend, toUrl)
import Gargantext.Sessions.Types (Session(..), Sessions(..), OpenNodes, NodeId, mkNodeId, sessionUrl, sessionId, empty, null, unSessions, lookup, cons, tryCons, update, remove, tryRemove)
29 30 31 32
import Gargantext.Utils.Reactix as R2

here :: R2.Here
here = R2.here "Gargantext.Sessions"
33

34 35 36 37 38 39 40 41
type WithSession c =
  ( session :: Session
  | c )

type WithSessionContext c =
  ( session :: R.Context Session
  | c )

James Laver's avatar
James Laver committed
42 43 44
load :: forall c. T.Write c Sessions => c -> Effect Sessions
load cell = do
  sessions <- loadSessions
45
  T.write sessions cell
James Laver's avatar
James Laver committed
46 47 48 49 50 51 52 53 54 55

change
  :: forall c
   . T.Read  c Sessions
  => T.Write c Sessions
  => Action -> c -> Effect Sessions
change action cell = do
  cur <- T.read cell
  new <- act cur action
  saveSessions new *> T.write new cell
56

57 58 59
data Action
  = Login Session
  | Logout Session
60
  | Update Session
61 62

act :: Sessions -> Action -> Effect Sessions
63 64 65 66 67
act ss (Login s) =
  case tryCons s ss of
    Right new -> pure new
    _ -> pure ss <* log2 "Cannot overwrite existing session: " (sessionId s)
act old@(Sessions ss) (Logout s) =
68
  case tryRemove (sessionId s) old of
69 70
    Right new -> pure $ new
    _ -> pure old <* log2 "Logged out of stale session:" (sessionId s)
71
act ss (Update s) = saveSessions $ update s ss
72

73 74 75 76
-- Key we will store the data under
localStorageKey :: String
localStorageKey = "garg-sessions"

77 78 79 80 81 82 83
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 }
84 85 86

-- | Will attempt to load saved sessions from localstorage. should log
-- | if decoding fails
87
loadSessions :: Effect Sessions
88
loadSessions = do
89
  storage <- R2.getls
90 91 92 93 94 95 96 97
  mItem :: Maybe String <- getItem localStorageKey storage
  case mItem of
    Nothing -> pure empty
    Just val -> do
      let r = JSON.readJSON val
      case hush r of
        Nothing -> pure empty
        Just p -> pure p
98
-- loadSessions = R2.getls >>= getItem localStorageKey >>= handleMaybe
99 100 101 102 103 104 105 106
--   where
--     -- a localstorage lookup can find nothing
--     handleMaybe (Just val) = handleEither (JSON.readJSON val)
--     handleMaybe Nothing    = pure empty

--     -- either parsing or decoding could fail, hence two errors
--     handleEither (Left err) = err *> pure empty
--     handleEither (Right ss) = pure ss
107

108
saveSessions :: Sessions -> Effect Sessions
109
saveSessions sessions = effect *> pure sessions where
110 111
  rem = R2.getls >>= removeItem localStorageKey
  set v  = R2.getls >>= setItem    localStorageKey v
112
  effect
113
    | null sessions = rem
114
    | otherwise = set (JSON.writeJSON sessions)
115

116 117 118 119 120 121
updateSession :: Session -> Effect Unit
updateSession s = do
  ss <- loadSessions
  _ <- saveSessions $ update s ss
  pure unit

122 123
postAuthRequest :: Backend -> AuthRequest -> Aff (Either String Session)
postAuthRequest backend ar@(AuthRequest {username}) =
124
  decode <$> REST.post Nothing (toUrl backend "auth") ar
125 126
  where
    decode (AuthResponse ar2)
127
      | {inval: Just (AuthInvalid {message})}     <- ar2 = Left message
128
      | {valid: Just (AuthData {token, tree_id})} <- ar2 =
129
          Right $ Session { backend, caches: Map.empty, token, treeId: tree_id, username }
130
      | otherwise = Left "Invalid response from server"
131

132
get :: forall a p. JSON.ReadForeign a => ToUrl Session p => Session -> p -> Aff a
133 134
get session@(Session {token}) p = REST.get (Just token) (toUrl session p)

135
put :: forall a b p. JSON.WriteForeign a => JSON.ReadForeign b => ToUrl Session p => Session -> p -> a -> Aff b
136 137
put session@(Session {token}) p = REST.put (Just token) (toUrl session p)

138
put_ :: forall b p. JSON.ReadForeign b => ToUrl Session p => Session -> p -> Aff b
139 140
put_ session@(Session {token}) p = REST.put_ (Just token) (toUrl session p)

141
delete :: forall a p. JSON.ReadForeign a => ToUrl Session p => Session -> p -> Aff a
142 143 144 145
delete session@(Session {token}) p = REST.delete (Just token) (toUrl session p)

-- This might not be a good idea:
-- https://stackoverflow.com/questions/14323716/restful-alternatives-to-delete-request-body
146
deleteWithBody :: forall a b p. JSON.WriteForeign a => JSON.ReadForeign b => ToUrl Session p => Session -> p -> a -> Aff b
147 148
deleteWithBody session@(Session {token}) p = REST.deleteWithBody (Just token) (toUrl session p)

149
post :: forall a b p. JSON.WriteForeign a => JSON.ReadForeign b => ToUrl Session p => Session -> p -> a -> Aff b
150 151
post session@(Session {token}) p = REST.post (Just token) (toUrl session p)

152
postWwwUrlencoded :: forall b p. JSON.ReadForeign b => ToUrl Session p => Session -> p -> REST.FormDataParams -> Aff b
153
postWwwUrlencoded session@(Session {token}) p = REST.postWwwUrlencoded (Just token) (toUrl session p)
154

155
postMultipartFormData :: forall b p. JSON.ReadForeign b => ToUrl Session p => Session -> p -> String -> Aff b
156
postMultipartFormData session@(Session {token}) p = REST.postMultipartFormData (Just token) (toUrl session p)