Merge remote-tracking branch 'origin/login'

src/Gargantext/Components/Login.purs

 module Gargantext.Components.Login where
 
-import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.?), (:=), (~>))
-import Data.Lens (over)
-import Data.Maybe (Maybe)
+import Control.Monad.Cont.Trans (lift)
+import Data.Int as Int
+import Data.Lens (over, view)
+import Data.Maybe (Maybe(..))
+import Data.Traversable (traverse_)
 import Effect.Class (liftEffect)
 import Effect (Effect)
 import Effect.Aff (Aff)
 import React.DOM (a, button, div, h2, h4, h5, i, input, label, p, span, text)
 import React.DOM.Props (_data, _id, _type, aria, className, href, maxLength, name, onClick, onInput, placeholder, role, target, value)
-import Thermite (PerformAction, Render, Spec, _render, modifyState, simpleSpec)
+import Thermite (PerformAction, Render, Spec, _render, modifyState_, simpleSpec)
 import Unsafe.Coerce (unsafeCoerce)
 import Web.HTML (window)
 import Web.HTML.Window (localStorage)
-import Web.Storage.Storage (getItem, setItem)
+import Web.Storage.Storage (getItem, setItem, removeItem)
 
 ------------------------------------------------------------------------
 import Gargantext.Prelude
+import Gargantext.Config (toUrl, Path(..), End(..))
 import Gargantext.Config.REST (post)
 import Gargantext.Components.Modals.Modal (modalHide)
+import Gargantext.Components.Login.Types
 
 -- TODO: ask for login (modal) or account creation after 15 mn when user
 -- is not logged and has made one search at least
 
-newtype State = State
+type State =
   { username :: String
   , password :: String
-  , response :: LoginRes
+  , authData :: Maybe AuthData
   , errorMessage :: String
-  , loginC :: Boolean
   }
 
 
-initialState :: State
-initialState = State
-  {username : ""
+initialState :: Effect State
+initialState = do
+  authData <- getAuthData
+  pure
+    { authData
+    , username : ""
     , password : ""
- , response : LoginRes {token : ""}
     , errorMessage : ""
- , loginC : false
     }
 
 data Action
-  = Login
+  = PostAuth
   | SetUserName String
   | SetPassword String
 
@@ -51,24 +55,22 @@ modalSpec sm t = over _render \render d p s c ->
   [ div [ _id "loginModal", className $ "modal myModal" <> if sm then "" else " fade"
         , role "dialog"
         , _data {show : true}
-            ][ div [ className "modal-dialog"
-                   , role "document"
-                   ] [ div [ className "modal-content"]
-                       [ div [ className "modal-header"]
-                         [ h5 [ className "modal-title"
         ]
-                           [ text $ t
+    [ div [ className "modal-dialog"
+          , role "document"
           ]
+      [ div [ className "modal-content"]
+        [ div [ className "modal-header"]
+          [ h5 [ className "modal-title" ]
+            [ text t ]
           , button [ _type "button"
                    , className "close"
                    , _data { dismiss : "modal"}
-                                  ] [ span [ aria {hidden : true}]
-                                      [ text "X"]
                    ]
+            [ span [ aria {hidden : true}] [ text "X"]
             ]
-
-                       , div [ className "modal-body"]
-                         (render d p s c)
+          ]
+        , div [ className "modal-body"] (render d p s c)
         ]
       ]
     ]
@@ -82,46 +84,36 @@ renderSpec = simpleSpec performAction render
   where
     performAction :: PerformAction State {} Action
 
-    performAction (SetUserName usr) _ _ = void do
-      modifyState \(State state) -> State $ state { username = usr }
+    performAction (SetUserName usr) _ _ =
+      modifyState_ $ _ { username = usr }
 
-    performAction (SetPassword pwd) _ _ = void do
-      modifyState \(State state) -> State $ state { password = pwd }
+    performAction (SetPassword pwd) _ _ =
+      modifyState_ $ _ { password = pwd }
 
-    performAction Login _ _ = void do
-      --lift $ setHash "/search"
+    performAction PostAuth _ {username, password} = do
+      res <- lift $ postAuthRequest $ AuthRequest {username, password}
+      case res of
+        AuthResponse {inval: Just (AuthInvalid {message})} ->
+          modifyState_ $ _ { errorMessage = message }
+        AuthResponse {valid} -> do
+          liftEffect $ setAuthData valid
+          modifyState_ $ _ {authData = valid, errorMessage = ""}
           liftEffect $ modalHide "loginModal"
-      modifyState \(State state) -> State $ state {loginC = true}
-      -- res <- lift $ loginReq $ LoginReq { username : state.username, password : state.password }
-      -- case res of
-      --   Left e -> do
-      --     logs e
-      --     modifyState \(State s) ->  State $ s { errorMessage = e}
-      --   Right r@(LoginRes response) -> do
-      --     lift $ setHash "/addCorpus"
-      --     modifyState \(State s) ->  State $ s {response = r, errorMessage = ""}
 
     render :: Render State {} Action
-    render dispatch _ (State state) _ =
-      [
-        div [className "row"]
-        [
-          div [className "col-sm-10 col-sm-push-1 col-md-6 col-md-push-3 col-lg-6 col-lg-push-3"]
-          [
-            h2 [className "text-primary center m-a-2"]
+    render dispatch _ state _ =
+      [ div [className "row"]
+        [ div [className "col-sm-10 col-sm-push-1 col-md-6 col-md-push-3 col-lg-6 col-lg-push-3"]
+          [ h2 [className "text-primary center m-a-2"]
             [ i [className "material-icons md-36"] [text "control_point"]
             , span [className "icon-text"] [text "Gargantext"]
             ]
           , div [className "card-group"]
-            [
-              div [className "card"]
-              [
-                div [className "card-block"]
-                [
-                  div [className "center"]
+            [ div [className "card"]
+              [ div [className "card-block"]
+                [ div [className "center"]
                   [ h4 [className "m-b-0"]
-                    [ span [className "icon-text"] [ text "Connexion"]
-                    ]
+                    [ span [className "icon-text"] [ text "Connexion"] ]
                   , p [className "text-muted"]
                     [ text $ "Login to your account or",
                       a [ target "blank",href "https://iscpif.fr/services/applyforourservices/"] [text " ask to get an access"]
@@ -130,6 +122,7 @@ renderSpec = simpleSpec performAction render
                 , div []
                   [ input [_type "hidden",
                            name "csrfmiddlewaretoken",
+                           -- TODO hard-coded CSRF token
                            value "Wy52D2nor8kC1r1Y4GrsrSIxQ2eqW8UwkdiQQshMoRwobzU4uldknRUhP0j4WcEM" ]
 
                   , div [className "form-group"]
@@ -141,14 +134,13 @@ renderSpec = simpleSpec performAction render
                     , div [className "clearfix"] []
                     ]
                   , div [className "center"]
-                    [
-                      label [] [
-                         div [className "checkbox"]
+                    [ label []
+                      [ div [className "checkbox"]
                         [ input [_id "terms-accept", _type "checkbox", value "", className "checkbox"]
                         , text "I accept the terms of uses ",
                           a [href "http://gitlab.iscpif.fr/humanities/tofu/tree/master"] [text "[Read the terms of use]"]
                         ]
-                         , button [_id "login-button",className "btn btn-primary btn-rounded", _type "submit", onClick \_ -> dispatch $ Login] [text "Login"]
+                      , button [_id "login-button",className "btn btn-primary btn-rounded", _type "submit", onClick \_ -> dispatch $ PostAuth] [text "Login"]
                       ]
                     ]
                   ]
@@ -179,7 +171,7 @@ renderSpec = simpleSpec performAction render
 --                                         ]
 
 --                                   , div [ className "modal-body"]
---                                         [ ul [ className "list-group"] ( map fn1 state.response ) ]
+--                                         [ ul [ className "list-group"] ( map fn1 state.authData ) ]
 
 --                                   , div [className "modal-footer"]
 --                                         [ button [ _type "button"
@@ -197,44 +189,28 @@ renderSpec = simpleSpec performAction render
 unsafeEventValue :: forall event. event -> String
 unsafeEventValue e = (unsafeCoerce e).target.value
 
-
-
-getDeviseID ::  Effect (Maybe String)
-getDeviseID = do
+getAuthData :: Effect (Maybe AuthData)
+getAuthData = do
   w  <- window
   ls <- localStorage w
-  getItem "token" ls
-
-
-setToken :: String -> Effect Unit
-setToken s = do
+  mto <- getItem "token" ls
+  mti <- getItem "tree_id" ls
+  pure do
+    token <- mto
+    tree_id <- Int.fromString =<< mti
+    pure $ AuthData {token, tree_id}
+
+setAuthData :: Maybe AuthData -> Effect Unit
+setAuthData Nothing = do
   w  <- window
   ls <- localStorage w
-  setItem "token" s ls
-
-
-
-newtype LoginRes = LoginRes
-  {token :: String
-  }
-
-
-newtype LoginReq = LoginReq
-  { username :: String
-  , password :: String
-  }
-
-loginReq :: LoginReq -> Aff LoginRes
-loginReq = post "https://dev.gargantext.org/api/auth/token"
-
-instance decodeLoginRes :: DecodeJson LoginRes where
-  decodeJson json = do
-    obj   <- decodeJson json
-    token <- obj .? "token"
-    pure $ LoginRes { token}
+  removeItem "token"   ls
+  removeItem "tree_id" ls
+setAuthData (Just (AuthData {tree_id, token})) = do
+  w  <- window
+  ls <- localStorage w
+  setItem "token"   token          ls
+  setItem "tree_id" (show tree_id) ls
 
-instance encodeLoginReq :: EncodeJson LoginReq where
-  encodeJson (LoginReq obj) =
-       "username"          := obj.username
-    ~> "password"          := obj.password
-    ~> jsonEmptyObject
+postAuthRequest :: AuthRequest -> Aff AuthResponse
+postAuthRequest = post $ toUrl Back Auth Nothing

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

@@ -8,6 +8,7 @@ import Affjax.RequestBody (RequestBody(..))
 import Affjax.ResponseFormat as ResponseFormat
 import CSS (backgroundColor, borderRadius, boxShadow, justifyContent, marginTop)
 import Control.Monad.Cont.Trans (lift)
+import Data.Array (filter)
 import Data.Argonaut (class DecodeJson, class EncodeJson, Json, decodeJson, encodeJson, jsonEmptyObject, (.?), (:=), (~>))
 import Data.Argonaut.Core (Json)
 import Data.Either (Either(..))
@@ -26,7 +27,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
 
@@ -39,6 +40,15 @@ type Props = { root :: ID }
 
 data NTree a = NTree a (Array (NTree a))
 
+instance ntreeFunctor :: Functor NTree where
+  map f (NTree x ary) = NTree (f x) (map (map f) ary)
+
+-- Keep only the nodes matching the predicate.
+-- The root of the tree is always kept.
+filterNTree :: forall a. (a -> Boolean) -> NTree a -> NTree a
+filterNTree p (NTree x ary) =
+  NTree x $ map (filterNTree p) $ filter (\(NTree a _) -> p a) ary
+
 type FTree = NTree LNode
 
 data Action =  ShowPopOver ID
@@ -55,40 +65,39 @@ data Action =  ShowPopOver ID
 
 type State = { state :: FTree }
 
+-- TODO remove
 initialState :: State
 initialState = { state: NTree (LNode {id : 3, name : "hello", nodeType : Node, open : true, popOver : false, renameNodeValue : "", createNode : false, nodeValue : "InitialNode", showRenameBox : false}) [] }
 
 mapFTree :: (FTree -> FTree) -> State -> State
 mapFTree f {state} = {state: f state}
 
-
+-- TODO: make it a local function
 performAction :: forall props. PerformAction State props Action
 
 performAction (ToggleFolder i) _ _ =
   modifyState_ $ mapFTree $ toggleNode i
 
 performAction (ShowPopOver id) _ _ =
-  modifyState_ $ mapFTree $ popOverNode id
+  modifyState_ $ mapFTree $ map $ popOverNode id
 
 performAction (ShowRenameBox id) _ _ =
-  modifyState_ $ mapFTree $ showPopOverNode id
+  modifyState_ $ mapFTree $ map $ showPopOverNode id
 
 performAction (CancelRename id) _ _ =
-  modifyState_ $ mapFTree $ showPopOverNode id
+  modifyState_ $ mapFTree $ map $ showPopOverNode id
 
 performAction (ToggleCreateNode id) _ _ =
   modifyState_ $ mapFTree $ showCreateNode id
 
 performAction (DeleteNode nid) _ _ = do
-  d <- lift $ deleteNode nid
-  --- TODO : Need to update state once API is called
-  pure unit
+  void $ lift $ deleteNode nid
+  modifyState_ $ mapFTree $ filterNTree (\(LNode {id}) -> id /= nid)
 
---- TODO : Need to update state once API is called
-performAction (Submit rid s'') _  _  = do
-  d <- lift $ renameNode rid $ RenameValue { name : s''}
-  -- modifyState_ $ mapFTree $ popOverNode rid
-  modifyState_ $ mapFTree $ showPopOverNode rid -- add this function to toggle rename function
+performAction (Submit rid name) _  _  = do
+  void $ lift $ renameNode rid $ RenameValue {name}
+  modifyState_ $ mapFTree $ map $ popOverNode rid
+                              <<< onNode rid (\(LNode node) -> LNode (node { name = name }))
 
 performAction (RenameNode  r nid) _ _ =
   modifyState_ $ mapFTree $ rename nid r
@@ -99,21 +108,25 @@ performAction (Create  nid) _ _ =
 performAction (SetNodeValue v nid) _ _ =
   modifyState_ $ mapFTree $ setNodeValue nid v
 
+toggleIf :: Boolean -> Boolean -> Boolean
+toggleIf true  = not
+toggleIf false = const false
 
-popOverNode :: Int -> NTree LNode -> NTree LNode
-popOverNode sid (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, createNode, nodeValue, showRenameBox}) ary) =
-  NTree (LNode {id,name, nodeType, open , popOver : npopOver, renameNodeValue, createNode, nodeValue, showRenameBox}) $ map (popOverNode sid) ary
-  where
-    npopOver = if sid == id then not popOver else popOver
-
+onNode :: Int -> (LNode -> LNode) -> LNode -> LNode
+onNode id f l@(LNode node)
+  | node.id == id = f l
+  | otherwise     = l
 
-showPopOverNode :: Int -> NTree LNode -> NTree LNode
-showPopOverNode sid (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, createNode, nodeValue, showRenameBox}) ary) =
-  NTree (LNode {id,name, nodeType, open , popOver , renameNodeValue, createNode, nodeValue, showRenameBox: nshowRenameBox}) $ map (showPopOverNode sid) ary
-  where
-    nshowRenameBox = if sid == id then not showRenameBox else showRenameBox
+popOverNode :: Int -> LNode -> LNode
+popOverNode sid (LNode node) =
+  LNode $ node { popOver = toggleIf (sid == node.id) node.popOver
+               , showRenameBox = false }
 
+showPopOverNode :: Int -> LNode -> LNode
+showPopOverNode sid (LNode node) =
+  LNode $ node {showRenameBox = toggleIf (sid == node.id) node.showRenameBox}
 
+-- TODO: DRY, NTree.map
 showCreateNode :: Int -> NTree LNode -> NTree LNode
 showCreateNode sid (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, createNode, nodeValue, showRenameBox}) ary) =
   NTree (LNode {id,name, nodeType, open , popOver, renameNodeValue, createNode : createNode', nodeValue, showRenameBox}) $ map (showCreateNode sid) ary
@@ -129,21 +142,21 @@ showCreateNode sid (NTree (LNode {id, name, nodeType, open, popOver, renameNodeV
 --     NTree (LNode {id,name, nodeType, open , popOver, renameNodeValue, createNode , nodeValue}) $ map (getCreateNode sid) ary
 --     createNode' = if sid == id then  nodeValue else ""
 
-
+-- TODO: DRY, NTree.map
 rename :: Int ->  String -> NTree LNode  -> NTree LNode
 rename sid v (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, createNode, nodeValue, showRenameBox}) ary)  =
   NTree (LNode {id,name, nodeType, open , popOver , renameNodeValue : rvalue, createNode, nodeValue, showRenameBox}) $ map (rename sid  v) ary
   where
     rvalue = if sid == id then  v   else ""
 
-
+-- TODO: DRY, NTree.map
 setNodeValue :: Int ->  String -> NTree LNode  -> NTree LNode
 setNodeValue sid v (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, createNode, nodeValue, showRenameBox}) ary)  =
   NTree (LNode {id,name, nodeType, open , popOver , renameNodeValue , createNode, nodeValue : nvalue, showRenameBox}) $ map (setNodeValue sid  v) ary
   where
     nvalue = if sid == id then  v   else ""
 
-
+-- TODO: DRY, NTree.map
 toggleNode :: Int -> NTree LNode -> NTree LNode
 toggleNode sid (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, createNode, nodeValue, showRenameBox}) ary) =
   NTree (LNode {id,name, nodeType, open : nopen, popOver, renameNodeValue, createNode, nodeValue, showRenameBox}) $ map (toggleNode sid) ary
@@ -252,7 +265,7 @@ renameTreeView d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeV
                [
                  input [ _type "text"
                     , placeholder "Rename Node"
-                    , defaultValue $ getRenameNodeValue s
+                    , defaultValue $ name
                     , style {float: "left"}
                     , className "col-md-2 form-control"
                     , onInput \e -> d (RenameNode (unsafeEventValue e) nid)
@@ -335,10 +348,6 @@ renameTreeViewDummy d s = div [] []
 popOverValue :: FTree -> Boolean
 popOverValue (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, showRenameBox }) ary) = popOver
 
-getRenameNodeValue :: FTree -> String
-getRenameNodeValue (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, showRenameBox }) ary) = renameNodeValue
-
-
 getCreateNodeValue :: FTree -> String
 getCreateNodeValue (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue, nodeValue, showRenameBox}) ary) = nodeValue
 
@@ -420,8 +429,8 @@ newtype RenameValue = RenameValue
   }
 
 instance encodeJsonRenameValue :: EncodeJson RenameValue where
-  encodeJson (RenameValue post)
-     = "r_name" := post.name
+  encodeJson (RenameValue {name})
+     = "r_name" := name
     ~> jsonEmptyObject
 
 renameNode :: Int -> RenameValue -> Aff (Array Int)

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)
+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
+    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)
 ------------------------------------------------------------
-toUrl :: End -> NodeType -> Maybe Id -> Url
-toUrl e nt i = doUrl base path params
+
+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 nt i
+      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
+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"
 
--- | 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.
-
--- 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

@@ -22,7 +22,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(..), HyperdataContact(..))
 ------------------------------------------------------------------------------

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/Corpus/Tabs/Ngrams/NgramsTable.purs

@@ -46,7 +46,6 @@ import Gargantext.Components.Table as T
 import Gargantext.Prelude
 import Gargantext.Config
 import Gargantext.Config.REST
-import Gargantext.Components.Tree (NTree(..))
 import Gargantext.Components.Loader as Loader
 import Gargantext.Pages.Corpus.Tabs.Types (CorpusInfo(..), PropsRow)
 

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,9 +84,11 @@ 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
+          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 -> [ 
@@ -124,9 +125,11 @@ 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
+          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"]
-       [
+     [ li [className "dropdown"]
+       [ case s.loginState.authData of
+           Nothing -> loginLink
+           Just _  -> logoutLink
+       ]
+     ]
+  where
+    loginLink =
       a [ aria {hidden : true}
         , className "glyphicon glyphicon-log-in"
-           , --href "#/login"
-             onClick $ \e -> d ShowLogin
+        , 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"]
+    -- 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,8 +4,8 @@ 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
 
 import Gargantext.Pages.Corpus.Document       as D
 import Gargantext.Pages.Corpus.Graph     as GE
@@ -28,10 +28,12 @@ type AppState =
   , showTree :: Boolean
   }
 
-initAppState :: AppState
-initAppState =
+initAppState :: Effect AppState
+initAppState = do
+  loginState <- LN.initialState
+  pure
     { currentRoute   : Just Home
-  , loginState     : LN.initialState
+    , loginState
     , addCorpusState : AC.initialState
     , searchState    : S.initialState
     , userPageState  : C.initialState

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))