[Login] backend connection, local storage, logout link

src/Gargantext/Components/Login/Types.purs

+module Gargantext.Components.Login.Types where
+
+import Prelude
+import Data.Lens (Iso', iso)
+import Data.Argonaut ( class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject
+                     , (.?), (.??), (:=), (~>)
+                     )
+import Data.Maybe (Maybe)
+
+type Username = String
+type Password = String
+type Token    = String
+type TreeId   = Int
+
+newtype AuthRequest = AuthRequest
+  { username :: Username
+  , password :: Password
+  }
+
+newtype AuthResponse = AuthResponse
+  { valid :: Maybe AuthData
+  , inval :: Maybe AuthInvalid
+  }
+
+newtype AuthInvalid = AuthInvalid
+  { message :: String }
+
+newtype AuthData = AuthData
+  { token   :: Token
+  , tree_id :: TreeId
+  }
+
+_AuthData :: Iso' AuthData { token :: Token, tree_id :: TreeId }
+_AuthData = iso (\(AuthData v) -> v) AuthData
+
+instance decodeAuthInvalid :: DecodeJson AuthInvalid where
+  decodeJson json = do
+    obj     <- decodeJson json
+    message <- obj .? "message"
+    pure $ AuthInvalid {message}
+
+instance decodeAuthResponse :: DecodeJson AuthResponse where
+  decodeJson json = do
+    obj   <- decodeJson json
+    valid <- obj .?? "valid"
+    inval <- obj .?? "inval"
+    pure $ AuthResponse {valid, inval}
+
+instance decodeAuthData :: DecodeJson AuthData where
+  decodeJson json = do
+    obj   <- decodeJson json
+    token <- obj .? "token"
+    tree_id <- obj .? "tree_id"
+    pure $ AuthData {token, tree_id}
+
+instance encodeAuthRequest :: EncodeJson AuthRequest where
+  encodeJson (AuthRequest {username, password}) =
+       "username" := username
+    ~> "password" := password
+    ~> jsonEmptyObject

src/Gargantext/Components/Tree.purs

@@ -26,7 +26,7 @@ import React.DOM.Props (_id, _type, className, href, title, onClick, onInput, pl
 import React.DOM.Props as DOM
 import Thermite (PerformAction, Render, Spec, createClass, defaultPerformAction, defaultRender, modifyState_, simpleSpec)
 
-import Gargantext.Config (toUrl, End(..), NodeType(..), defaultRoot)
+import Gargantext.Config (toUrl, End(..), NodeType(..))
 import Gargantext.Config.REST (get, put, post, delete, deleteWithBody)
 import Gargantext.Components.Loader as Loader
 

src/Gargantext/Config.purs

@@ -27,11 +27,6 @@ endConfig' :: ApiVersion -> EndConfig
 endConfig' v = { front : frontRelative
                , back  : backLocal v }
 
--- | Default Root on shared database to develop
--- until authentication implementation
--- (Default Root will be given after authentication)
-defaultRoot :: Int
-defaultRoot = 950094
 ------------------------------------------------------------------------
 frontRelative :: Config
 frontRelative = { baseUrl: ""
@@ -100,25 +95,41 @@ endOf Front = _.front
 endBaseUrl :: End -> EndConfig -> UrlBase
 endBaseUrl end c = (endOf end c).baseUrl
 
-endPathUrl :: End -> EndConfig -> NodeType -> Maybe Id -> UrlPath
-endPathUrl end c nt i = pathUrl (endOf end c) nt i
+endPathUrl :: End -> EndConfig -> Path -> Maybe Id -> UrlPath
+endPathUrl end = pathUrl <<< endOf end
 
-pathUrl :: Config -> NodeType -> Maybe Id -> UrlPath
-pathUrl c nt@(Tab _ _ _ _) i = pathUrl c Node i <> "/" <> show nt
-pathUrl c nt@(Ngrams _ _) i = pathUrl c Node i <> "/" <> show nt
-pathUrl c nt i = c.prePath <> urlConfig nt <> (maybe "" (\i' -> "/" <> show i') i)
-------------------------------------------------------------
-toUrl :: End -> NodeType -> Maybe Id -> Url
-toUrl e nt i = doUrl base path params
+pathUrl :: Config -> Path -> Maybe Id -> UrlPath
+pathUrl c (Tab t o l s) i =
+    pathUrl c (NodeAPI Node) i <>
+      "/" <> "table?view=" <> show t <> "&offset=" <> show o
+          <> "&limit=" <> show l <> os
+  where
+    os = maybe "" (\x -> "&order=" <> show x) s
+pathUrl c (Ngrams t listid) i =
+    pathUrl c (NodeAPI Node) i <> "/" <> "listGet?ngramsType=" <> show t <> listid'
   where
-    base   = endBaseUrl e endConfig
-    path   = endPathUrl e endConfig nt i
-    params = ""
+    listid' = maybe "" (\x -> "&list=" <> show x) listid
+pathUrl c Auth Nothing = c.prePath <> "auth"
+pathUrl c Auth (Just _) = "impossible" -- TODO better types
+pathUrl c (NodeAPI nt) i = c.prePath <> nodeTypeUrl nt <> (maybe "" (\i' -> "/" <> show i') i)
+------------------------------------------------------------
+
+class ToUrl a where
+  toUrl :: End -> a -> Maybe Id -> Url
+
+instance toUrlNodeType :: ToUrl NodeType where
+  toUrl e nt i = toUrl e (NodeAPI nt) i
+
+instance toUrlPath :: ToUrl Path where
+  toUrl e p i = doUrl base path params
+    where
+      base   = endBaseUrl e endConfig
+      path   = endPathUrl e endConfig p i
+      params = ""
 ------------------------------------------------------------
+
 data NodeType = NodeUser
               | Annuaire
-              | Tab TabType Offset Limit (Maybe OrderBy)
-              | Ngrams TabType (Maybe TermList)
               | Corpus
               | CorpusV3
               | Dashboard
@@ -130,6 +141,13 @@ data NodeType = NodeUser
               | Node
               | Nodes
               | Tree
+
+data Path
+  = Auth
+  | Tab TabType Offset Limit (Maybe OrderBy)
+  | Ngrams TabType (Maybe TermList)
+  | NodeAPI NodeType
+
 data End = Back | Front
 type Id  = Int
 
@@ -162,56 +180,23 @@ instance showTabType :: Show TabType where
   show TabTrash      = "Trash"
 
 ------------------------------------------------------------
-urlConfig :: NodeType -> Url
-urlConfig Annuaire  = show Annuaire
-urlConfig nt@(Tab _ _ _ _) = show nt
-urlConfig nt@(Ngrams _ _) = show nt
-urlConfig Corpus    = show Corpus
-urlConfig CorpusV3  = show CorpusV3
-urlConfig Dashboard = show Dashboard
-urlConfig Url_Document  = show Url_Document
-urlConfig Error     = show Error
-urlConfig Folder    = show Folder
-urlConfig Graph     = show Graph
-urlConfig Individu  = show Individu
-urlConfig Node      = show Node
-urlConfig Nodes      = show Nodes
-urlConfig NodeUser  = show NodeUser
-urlConfig Tree      = show Tree
-------------------------------------------------------------
-instance showNodeType :: Show NodeType where
-  show Annuaire  = "annuaire"
-  show Corpus    = "corpus"
-  show CorpusV3  = "corpus"
-  show Dashboard = "dashboard"
-  show Url_Document  = "document"
-  show Error     = "ErrorNodeType"
-  show Folder    = "folder"
-  show Graph     = "graph"
-  show Individu  = "individu"
-  show Node      = "node"
-  show Nodes      = "nodes"
-  show NodeUser  = "user"
-  show Tree      = "tree"
-  show (Tab t o l s) = "table?view=" <> show t <> "&offset=" <> show o
-                         <> "&limit=" <> show l <> os
-    where
-      os = maybe "" (\x -> "&order=" <> show x) s
-  show (Ngrams t listid) = "listGet?ngramsType=" <> show t <> listid'
-    where
-      listid' = maybe "" (\x -> "&list=" <> show x) listid
-
--- | TODO : where is the Read Class ?
--- NP: We don't need the Read class. Here are the encoding formats we need:
--- * JSON
--- * URL parts has in {To,From}HttpApiData but only for certain types
--- The Show class should only be used for dev.
+nodeTypeUrl :: NodeType -> Url
+nodeTypeUrl Annuaire  = "annuaire"
+nodeTypeUrl Corpus    = "corpus"
+nodeTypeUrl CorpusV3  = "corpus"
+nodeTypeUrl Dashboard = "dashboard"
+nodeTypeUrl Url_Document  = "document"
+nodeTypeUrl Error     = "ErrorNodeType"
+nodeTypeUrl Folder    = "folder"
+nodeTypeUrl Graph     = "graph"
+nodeTypeUrl Individu  = "individu"
+nodeTypeUrl Node      = "node"
+nodeTypeUrl Nodes      = "nodes"
+nodeTypeUrl NodeUser  = "user"
+nodeTypeUrl Tree      = "tree"
 
--- instance readNodeType :: Read NodeType where
 readNodeType :: String -> NodeType
 readNodeType "NodeAnnuaire"   = Annuaire
-readNodeType "Tab"   = (Tab TabDocs 0 0 Nothing)
-readNodeType "Ngrams"   = (Ngrams TabTerms Nothing)
 readNodeType "NodeDashboard"  = Dashboard
 readNodeType "Document"   = Url_Document
 readNodeType "NodeFolder"     = Folder
@@ -224,12 +209,14 @@ readNodeType "NodeCorpusV3" = CorpusV3
 readNodeType "NodeUser"   = NodeUser
 readNodeType "Tree"       = Tree
 readNodeType _            = Error
+{-
 ------------------------------------------------------------
 instance ordNodeType :: Ord NodeType where
   compare n1 n2 = compare (show n1) (show n2)
 
 instance eqNodeType :: Eq NodeType where
   eq n1 n2  = eq (show n1) (show n2)
+-}
 ------------------------------------------------------------
 instance decodeJsonNodeType :: DecodeJson NodeType where
   decodeJson json = do

src/Gargantext/Pages/Annuaire.purs

@@ -20,7 +20,7 @@ import Gargantext.Prelude
 import Gargantext.Components.Loader as Loader
 import Gargantext.Components.Tab as Tab
 import Gargantext.Components.Table as T
-import Gargantext.Config      (toUrl, NodeType(..), TabType(..), End(..))
+import Gargantext.Config      (toUrl, Path(..), NodeType(..), TabType(..), End(..))
 import Gargantext.Config.REST (get)
 import Gargantext.Pages.Annuaire.User.Contacts.Types (Contact(..), HyperData(..))
 ------------------------------------------------------------------------------

src/Gargantext/Pages/Corpus/Tabs/Documents.purs

@@ -25,7 +25,7 @@ import React as React
 import React (ReactClass, ReactElement, Children)
 ------------------------------------------------------------------------
 import Gargantext.Prelude
-import Gargantext.Config (NodeType(..), TabType(..), toUrl, End(..), OrderBy(..))
+import Gargantext.Config (Path(..), NodeType(..), TabType(..), toUrl, End(..), OrderBy(..))
 import Gargantext.Config.REST (get, put, post, deleteWithBody)
 import Gargantext.Utils.DecodeMaybe ((.|))
 import Gargantext.Components.Charts.Options.ECharts (chart)

src/Gargantext/Pages/Layout/Actions.purs

@@ -2,16 +2,15 @@
 
 module Gargantext.Pages.Layout.Actions where
 
-import Control.Monad.Cont.Trans                        (lift)
 import Data.Either                                     (Either(..))
+import Data.Maybe                                      (Maybe(..))
 import Data.Lens                                       (Prism', prism)
 import Effect.Class                                    (liftEffect)
 import Thermite                                        (PerformAction, modifyState, modifyState_)
+import Routing.Hash                                    (setHash)
 
-import Gargantext.Config (defaultRoot)
 import Gargantext.Components.Login                  as LN
 import Gargantext.Components.Modals.Modal              (modalShow)
-import Gargantext.Components.Tree                   as Tree
 import Gargantext.Pages.Annuaire             as Annuaire
 import Gargantext.Pages.Annuaire.User.Contacts      as C
 import Gargantext.Pages.Corpus.Document       as D
@@ -36,6 +35,7 @@ data Action
     | UserPageA  C.Action
   | Go
   | ShowLogin
+  | Logout
   | ShowAddcorpus
   | ShowTree 
 
@@ -46,13 +46,20 @@ performAction (SetRoute route)  _ _ = void do
 performAction (Search s)  _ _ = void do
   modifyState $ _ {search = s}
 
-performAction (ShowTree)  _ (state) = void do
+performAction (ShowTree)  _ (state) = void do -- TODO
   modifyState $ _ {showTree = not (state.showTree)}
 
 performAction (ShowLogin)  _ _ = void do
   liftEffect $ modalShow "loginModal"
   modifyState $ _ {showLogin = true}
 
+performAction Logout _ _ = do
+  loginState <- liftEffect do
+    LN.setAuthData Nothing
+    setHash "/"
+    LN.initialState
+  modifyState_ $ _ {currentRoute = Nothing, loginState = loginState}
+
 ---------------------------------------------------------
 -- TODO chose one of them
 performAction (ShowAddcorpus)  _ _ = void do

src/Gargantext/Pages/Layout/Specs.purs

@@ -11,8 +11,8 @@ import Thermite (Render, Spec, _render, defaultPerformAction, defaultRender, foc
 import Unsafe.Coerce (unsafeCoerce)
 
 import Gargantext.Prelude
-import Gargantext.Config (defaultRoot)
 import Gargantext.Components.Data.Lang (Lang(..))
+import Gargantext.Components.Login.Types (AuthData(..))
 import Gargantext.Components.Login as LN
 import Gargantext.Components.Tree  as Tree
 import Gargantext.Folder           as F
@@ -22,7 +22,6 @@ import Gargantext.Pages.Corpus     as Corpus
 import Gargantext.Pages.Corpus.Document as Annotation
 import Gargantext.Pages.Corpus.Dashboard as Dsh
 import Gargantext.Pages.Corpus.Graph as GE
-import Gargantext.Pages.Corpus.Tabs.Ngrams.NgramsTable as NG
 import Gargantext.Pages.Home as L
 import Gargantext.Pages.Layout.Actions (Action(..), _addCorpusAction, _documentViewAction, _graphExplorerAction, _loginAction, _searchAction, _userPageAction, performAction)
 import Gargantext.Pages.Layout.Specs.AddCorpus as AC
@@ -85,10 +84,12 @@ layout0 layout =
     outerLayout =
       cont $ fold
       [ withState \st ->
-         if ((\(LN.State s) -> s.loginC) st.loginState == true)
-            then ls $ cmapProps (const {root: defaultRoot}) as
-            else outerLayout1
-      , rs bs      
+          case st.loginState.authData of
+            Just (AuthData {tree_id}) ->
+              ls $ cmapProps (const {root: tree_id}) as
+            Nothing ->
+              outerLayout1
+      , rs bs
       ]
     ls   = over _render \render d p s c -> [ 
          div [ className "col-md-2"] (render d p s c)  
@@ -124,10 +125,12 @@ layout1 layout =
     outerLayout =
       cont $ fold
       [ withState \st ->
-         if ((\(LN.State s) -> s.loginC) st.loginState == true)
-            then ls $ cmapProps (const {root: defaultRoot}) as
-            else outerLayout1
-      , rs bs      
+          case st.loginState.authData of
+            Just (AuthData {tree_id}) ->
+              ls $ cmapProps (const {root: tree_id}) as
+            Nothing ->
+              outerLayout1
+      , rs bs
       ]
     ls   = over _render \render d p s c -> [  
       
@@ -164,7 +167,7 @@ layoutSidebar = over _render \render d p s c ->
                           ,  div [ className "collapse navbar-collapse"]
                              $ [ divDropdownLeft]
                              <> render d p s c <>
-                             [ divDropdownRight d]
+                             [ divDropdownRight d s ]
                           ]
                     ]
               ]
@@ -308,29 +311,35 @@ divSearchBar = simpleSpec performAction render
                             ]
                   ]
 
---divDropdownRight :: Render AppState {} Action
-divDropdownRight :: (Action -> Effect Unit) -> ReactElement
-divDropdownRight d =
+divDropdownRight :: (Action -> Effect Unit) -> AppState -> ReactElement
+divDropdownRight d s =
   ul [className "nav navbar-nav pull-right"]
-     [
-       -- TODO if logged in : enable dropdown to logout
-       li [className "dropdown"]
-       [
-         a [ aria {hidden : true}
-           , className "glyphicon glyphicon-log-in"
-           , --href "#/login"
-             onClick $ \e -> d ShowLogin
-           , style {color:"white"}
-           , title "Log in and save your time"
-           -- TODO hover: bold
-            ]
-          -- TODO if logged in
-          --, text " username"
-          -- else
-         [text " Login / Signup"]
-        ]
-      
+     [ li [className "dropdown"]
+       [ case s.loginState.authData of
+           Nothing -> loginLink
+           Just _  -> logoutLink
+       ]
      ]
+  where
+    loginLink =
+      a [ aria {hidden : true}
+        , className "glyphicon glyphicon-log-in"
+        , onClick $ \e -> d ShowLogin
+        , style {color:"white"}
+        , title "Log in and save your time"
+        -- TODO hover: bold
+        ]
+        [text " Login / Signup"]
+    -- TODO dropdown to logout
+    logoutLink =
+      a [ aria {hidden : true}
+        , className "glyphicon glyphicon-log-out"
+        , onClick $ \e -> d Logout
+        , style {color:"white"}
+        , title "Log out" -- TODO
+        -- TODO hover: bold
+        ]
+        [text " Logout"]
 
 layoutFooter :: Spec AppState {} Action
 layoutFooter = simpleSpec performAction render

src/Gargantext/Pages/Layout/States.purs

@@ -4,6 +4,7 @@ import Prelude hiding (div)
 
 import Data.Lens                                       (Lens', lens)
 import Data.Maybe                                      (Maybe(Just))
+import Effect (Effect)
 import Gargantext.Components.Login                  as LN
 import Gargantext.Components.Tree                   as Tree
 
@@ -28,20 +29,22 @@ type AppState =
   , showTree :: Boolean
   }
 
-initAppState :: AppState
-initAppState =
-  { currentRoute   : Just Home
-  , loginState     : LN.initialState
-  , addCorpusState : AC.initialState
-  , searchState    : S.initialState
-  , userPageState  : C.initialState
-  , documentState  : D.initialState {}
-  , search         : ""
-  , showLogin      : false
-  , showCorpus     : false
-  , graphExplorerState : GE.initialState
-  , showTree : false
-  }
+initAppState :: Effect AppState
+initAppState = do
+  loginState <- LN.initialState
+  pure
+    { currentRoute   : Just Home
+    , loginState
+    , addCorpusState : AC.initialState
+    , searchState    : S.initialState
+    , userPageState  : C.initialState
+    , documentState  : D.initialState {}
+    , search         : ""
+    , showLogin      : false
+    , showCorpus     : false
+    , graphExplorerState : GE.initialState
+    , showTree : false
+    }
 
 ---------------------------------------------------------
 _loginState :: Lens' AppState LN.State

src/Gargantext/Router.purs

@@ -57,24 +57,3 @@ instance showRoutes :: Show Routes where
   show Dashboard        = "Dashboard"
   show (PGraphExplorer i)   = "graphExplorer" <> show i
   show Home             = "Home"
-
-
-routeHandler :: (Maybe Routes -> Routes -> Effect Unit)
-              -> Maybe Routes -> Routes -> Effect Unit
-routeHandler dispatchAction old new = do
-  logs $ "change route : " <> show new
-  
-  w      <- window
-  ls     <- localStorage w
-  token  <- getItem "accessToken" ls
-  let tkn = token
-  
-  logs $ "JWToken : " <> show tkn
-  
-  case tkn of
-    Nothing -> do
-      dispatchAction old new
-      logs $ "called SignIn Route :"
-    Just t -> do
-      dispatchAction old new
-      logs $ "called Route : " <> show new

src/Main.purs

@@ -7,7 +7,7 @@ import Effect (Effect)
 import Gargantext.Pages.Layout (dispatchAction)
 import Gargantext.Pages.Layout.Specs (layoutSpec)
 import Gargantext.Pages.Layout.States (initAppState)
-import Gargantext.Router (routeHandler, routing)
+import Gargantext.Router (routing)
 import Partial.Unsafe (unsafePartial)
 import React as R
 import ReactDOM as RDOM
@@ -24,10 +24,11 @@ setUnsafeComponentWillMount = unsafeSet "unsafeComponentWillMount"
 
 main :: Effect Unit
 main = do
- case T.createReactSpec layoutSpec (const initAppState) of
+  state <- initAppState
+  case T.createReactSpec layoutSpec (const state) of
     { spec, dispatcher } -> void $ do
       let setRouting this = void $ do
-            matches routing (routeHandler (dispatchAction (dispatcher this)))
+            matches routing (dispatchAction (dispatcher this))
           spec' this = setUnsafeComponentWillMount (setRouting this) <$> (spec this)
       document <- window >>= document
       container <- unsafePartial (fromJust  <$> querySelector (QuerySelector "#app") (toParentNode document))