Sessions.purs 5.75 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
import Gargantext.Utils.Reactix as R2

31 32 33 34 35 36 37 38
type WithSession c =
  ( session :: Session
  | c )

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

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

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
53

54 55 56
data Action
  = Login Session
  | Logout Session
57
  | Update Session
58 59

act :: Sessions -> Action -> Effect Sessions
60 61 62 63 64
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) =
65
  case tryRemove (sessionId s) old of
66 67
    Right new -> pure $ new
    _ -> pure old <* log2 "Logged out of stale session:" (sessionId s)
68
act ss (Update s) = saveSessions $ update s ss
69

70 71 72 73
-- Key we will store the data under
localStorageKey :: String
localStorageKey = "garg-sessions"

74 75 76 77 78 79 80
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 }
81 82 83

-- | Will attempt to load saved sessions from localstorage. should log
-- | if decoding fails
84
loadSessions :: Effect Sessions
85
loadSessions = do
86
  storage <- R2.getls
87 88 89 90 91 92 93 94
  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
95
-- loadSessions = R2.getls >>= getItem localStorageKey >>= handleMaybe
96 97 98 99 100 101 102 103
--   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
104

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

postAuthRequest :: Backend -> AuthRequest -> Aff (Either String Session)
postAuthRequest backend ar@(AuthRequest {username}) =
115
  decode <$> REST.post Nothing (toUrl backend "auth") ar
116
  where
117 118
    decode (Left _err) = Left "Error when sending REST.post"
    decode (Right (AuthResponse ar2))
119
      | {inval: Just (AuthInvalid {message})}     <- ar2 = Left message
120
      | {valid: Just (AuthData {token, tree_id})} <- ar2 =
121
          Right $ Session { backend, caches: Map.empty, token, treeId: tree_id, username }
122
      | otherwise = Left "Invalid response from server"
123

124 125
get :: forall a p. JSON.ReadForeign a => ToUrl Session p =>
       Session -> p -> Aff (Either REST.RESTError a)
126 127
get session@(Session {token}) p = REST.get (Just token) (toUrl session p)

128 129
put :: forall a b p. JSON.WriteForeign a => JSON.ReadForeign b => ToUrl Session p =>
       Session -> p -> a -> Aff (Either REST.RESTError b)
130 131
put session@(Session {token}) p = REST.put (Just token) (toUrl session p)

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

135 136
delete :: forall a p. JSON.ReadForeign a => ToUrl Session p =>
          Session -> p -> Aff (Either REST.RESTError a)
137 138 139 140
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
141 142
deleteWithBody :: forall a b p. JSON.WriteForeign a => JSON.ReadForeign b => ToUrl Session p =>
                  Session -> p -> a -> Aff (Either REST.RESTError b)
143 144
deleteWithBody session@(Session {token}) p = REST.deleteWithBody (Just token) (toUrl session p)

145 146
post :: forall a b p. JSON.WriteForeign a => JSON.ReadForeign b => ToUrl Session p =>
        Session -> p -> a -> Aff (Either REST.RESTError b)
147 148
post session@(Session {token}) p = REST.post (Just token) (toUrl session p)

149 150
postWwwUrlencoded :: forall b p. JSON.ReadForeign b => ToUrl Session p =>
                     Session -> p -> REST.FormDataParams -> Aff (Either REST.RESTError b)
151
postWwwUrlencoded session@(Session {token}) p = REST.postWwwUrlencoded (Just token) (toUrl session p)