Commit 11f4718e authored by Nicolas Pouillard's avatar Nicolas Pouillard

Auth: Rework the get/put/post... to pass session

parent 6cbaad00
...@@ -24,15 +24,13 @@ import Effect.Class (liftEffect) ...@@ -24,15 +24,13 @@ import Effect.Class (liftEffect)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
------------------------------------------------------------------------ ------------------------------------------------------------------------
import Gargantext.Config.REST (post, delete)
import Gargantext.Components.Search.Types (Category(..), CategoryQuery(..), favCategory, trashCategory, decodeCategory, putCategories) import Gargantext.Components.Search.Types (Category(..), CategoryQuery(..), favCategory, trashCategory, decodeCategory, putCategories)
import Gargantext.Components.Table as T import Gargantext.Components.Table as T
import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Routes as Routes import Gargantext.Routes as Routes
import Gargantext.Routes (SessionRoute(NodeAPI)) import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, sessionId) import Gargantext.Sessions (Session, sessionId, post, delete)
import Gargantext.Types (NodeType(..), OrderBy(..), TabType, TabPostQuery(..)) import Gargantext.Types (NodeType(..), OrderBy(..), TabType, TabPostQuery(..))
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -223,8 +221,8 @@ loadPage :: Session -> PageParams -> Aff (Array DocumentsView) ...@@ -223,8 +221,8 @@ loadPage :: Session -> PageParams -> Aff (Array DocumentsView)
loadPage session {nodeId, tabType, query, listId, corpusId, params: {limit, offset, orderBy}} = do loadPage session {nodeId, tabType, query, listId, corpusId, params: {limit, offset, orderBy}} = do
liftEffect $ log "loading documents page: loadPage with Offset and limit" liftEffect $ log "loading documents page: loadPage with Offset and limit"
-- res <- get $ toUrl endConfigStateful Back (Tab tabType offset limit (convOrderBy <$> orderBy)) (Just nodeId) -- res <- get $ toUrl endConfigStateful Back (Tab tabType offset limit (convOrderBy <$> orderBy)) (Just nodeId)
let url2 = (url session (NodeAPI Node (Just nodeId))) <> "/table" let p = NodeAPI Node (Just nodeId) "table"
res <- post url2 $ TabPostQuery { res <- post session p $ TabPostQuery {
offset offset
, limit , limit
, orderBy: convOrderBy orderBy , orderBy: convOrderBy orderBy
...@@ -337,29 +335,27 @@ sampleDocuments :: Array (Tuple String String) ...@@ -337,29 +335,27 @@ sampleDocuments :: Array (Tuple String String)
sampleDocuments = [Tuple "Macroscopic dynamics of the fusion process" "Journal de Physique Lettres",Tuple "Effects of static and cyclic fatigue at high temperature upon reaction bonded silicon nitride" "Journal de Physique Colloques",Tuple "Reliability of metal/glass-ceramic junctions made by solid state bonding" "Journal de Physique Colloques",Tuple "High temperature mechanical properties and intergranular structure of sialons" "Journal de Physique Colloques",Tuple "SOLUTIONS OF THE LANDAU-VLASOV EQUATION IN NUCLEAR PHYSICS" "Journal de Physique Colloques",Tuple "A STUDY ON THE FUSION REACTION 139La + 12C AT 50 MeV/u WITH THE VUU EQUATION" "Journal de Physique Colloques",Tuple "Atomic structure of \"vitreous\" interfacial films in sialon" "Journal de Physique Colloques",Tuple "MICROSTRUCTURAL AND ANALYTICAL CHARACTERIZATION OF Al2O3/Al-Mg COMPOSITE INTERFACES" "Journal de Physique Colloques",Tuple "Development of oxidation resistant high temperature NbTiAl alloys and intermetallics" "Journal de Physique IV Colloque",Tuple "Determination of brazed joint constitutive law by inverse method" "Journal de Physique IV Colloque",Tuple "Two dimensional estimates from ocean SAR images" "Nonlinear Processes in Geophysics",Tuple "Comparison Between New Carbon Nanostructures Produced by Plasma with Industrial Carbon Black Grades" "Journal de Physique III",Tuple "<i>Letter to the Editor:</i> SCIPION, a new flexible ionospheric sounder in Senegal" "Annales Geophysicae",Tuple "Is reducibility in nuclear multifragmentation related to thermal scaling?" "Physics Letters B",Tuple "Independence of fragment charge distributions of the size of heavy multifragmenting sources" "Physics Letters B",Tuple "Hard photons and neutral pions as probes of hot and dense nuclear matter" "Nuclear Physics A",Tuple "Surveying the nuclear caloric curve" "Physics Letters B",Tuple "A hot expanding source in 50 A MeV Xe+Sn central reactions" "Physics Letters B"] sampleDocuments = [Tuple "Macroscopic dynamics of the fusion process" "Journal de Physique Lettres",Tuple "Effects of static and cyclic fatigue at high temperature upon reaction bonded silicon nitride" "Journal de Physique Colloques",Tuple "Reliability of metal/glass-ceramic junctions made by solid state bonding" "Journal de Physique Colloques",Tuple "High temperature mechanical properties and intergranular structure of sialons" "Journal de Physique Colloques",Tuple "SOLUTIONS OF THE LANDAU-VLASOV EQUATION IN NUCLEAR PHYSICS" "Journal de Physique Colloques",Tuple "A STUDY ON THE FUSION REACTION 139La + 12C AT 50 MeV/u WITH THE VUU EQUATION" "Journal de Physique Colloques",Tuple "Atomic structure of \"vitreous\" interfacial films in sialon" "Journal de Physique Colloques",Tuple "MICROSTRUCTURAL AND ANALYTICAL CHARACTERIZATION OF Al2O3/Al-Mg COMPOSITE INTERFACES" "Journal de Physique Colloques",Tuple "Development of oxidation resistant high temperature NbTiAl alloys and intermetallics" "Journal de Physique IV Colloque",Tuple "Determination of brazed joint constitutive law by inverse method" "Journal de Physique IV Colloque",Tuple "Two dimensional estimates from ocean SAR images" "Nonlinear Processes in Geophysics",Tuple "Comparison Between New Carbon Nanostructures Produced by Plasma with Industrial Carbon Black Grades" "Journal de Physique III",Tuple "<i>Letter to the Editor:</i> SCIPION, a new flexible ionospheric sounder in Senegal" "Annales Geophysicae",Tuple "Is reducibility in nuclear multifragmentation related to thermal scaling?" "Physics Letters B",Tuple "Independence of fragment charge distributions of the size of heavy multifragmenting sources" "Physics Letters B",Tuple "Hard photons and neutral pions as probes of hot and dense nuclear matter" "Nuclear Physics A",Tuple "Surveying the nuclear caloric curve" "Physics Letters B",Tuple "A hot expanding source in 50 A MeV Xe+Sn central reactions" "Physics Letters B"]
newtype SearchQuery = SearchQuery newtype SearchQuery = SearchQuery
{ { query :: Array String
query :: Array String
, parent_id :: Int , parent_id :: Int
} }
instance encodeJsonSQuery :: EncodeJson SearchQuery where instance encodeJsonSQuery :: EncodeJson SearchQuery where
encodeJson (SearchQuery post) encodeJson (SearchQuery {query, parent_id})
= "query" := post.query = "query" := query
~> "parent_id" := post.parent_id ~> "parent_id" := parent_id
~> jsonEmptyObject ~> jsonEmptyObject
searchResults :: SearchQuery -> Aff Int searchResults :: SearchQuery -> Aff Int
searchResults squery = post "http://localhost:8008/count" unit searchResults squery = pure 42 -- TODO post "http://localhost:8008/count" unit
-- TODO
documentsUrl :: Session -> Int -> String documentsRoute :: Int -> SessionRoute
documentsUrl session nodeId = url session (NodeAPI Node (Just nodeId)) <> "/documents" documentsRoute nodeId = NodeAPI Node (Just nodeId) "documents"
deleteAllDocuments :: Session -> Int -> Aff (Array Int) deleteAllDocuments :: Session -> Int -> Aff (Array Int)
deleteAllDocuments session = delete <<< documentsUrl session deleteAllDocuments session = delete session <<< documentsRoute
-- TODO: not optimal but Data.Set lacks some function (Set.alter) -- TODO: not optimal but Data.Set lacks some function (Set.alter)
toggleSet :: forall a. Ord a => a -> Set a -> Set a toggleSet :: forall a. Ord a => a -> Set a -> Set a
......
...@@ -20,13 +20,12 @@ import Effect.Aff (Aff, launchAff_) ...@@ -20,13 +20,12 @@ import Effect.Aff (Aff, launchAff_)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
------------------------------------------------------------------------ ------------------------------------------------------------------------
import Gargantext.Config.REST (post, deleteWithBody)
import Gargantext.Ends (url) import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Components.Search.Types (Category(..), CategoryQuery(..), favCategory, decodeCategory, putCategories) import Gargantext.Components.Search.Types (Category(..), CategoryQuery(..), favCategory, decodeCategory, putCategories)
import Gargantext.Components.Table as T import Gargantext.Components.Table as T
import Gargantext.Routes (SessionRoute(Search,NodeAPI)) import Gargantext.Routes (SessionRoute(Search,NodeAPI))
import Gargantext.Sessions (Session, sessionId) import Gargantext.Sessions (Session, sessionId, post, deleteWithBody)
import Gargantext.Types (NodeType(..), OrderBy(..), NodePath(..)) import Gargantext.Types (NodeType(..), OrderBy(..), NodePath(..))
import Gargantext.Utils (toggleSet) import Gargantext.Utils (toggleSet)
import Gargantext.Utils.DecodeMaybe ((.|)) import Gargantext.Utils.DecodeMaybe ((.|))
...@@ -43,8 +42,8 @@ type TextQuery = Array (Array String) ...@@ -43,8 +42,8 @@ type TextQuery = Array (Array String)
newtype SearchQuery = SearchQuery { query :: TextQuery } newtype SearchQuery = SearchQuery { query :: TextQuery }
instance encodeJsonSearchQuery :: EncodeJson SearchQuery where instance encodeJsonSearchQuery :: EncodeJson SearchQuery where
encodeJson (SearchQuery post) encodeJson (SearchQuery {query})
= "query" := post.query !! 0 -- TODO anoe = "query" := query !! 0 -- TODO anoe
~> jsonEmptyObject ~> jsonEmptyObject
newtype SearchResults = SearchResults { results :: Array Response } newtype SearchResults = SearchResults { results :: Array Response }
...@@ -234,8 +233,8 @@ initialPagePath {session, nodeId, listId, query} = {session, nodeId, listId, que ...@@ -234,8 +233,8 @@ initialPagePath {session, nodeId, listId, query} = {session, nodeId, listId, que
loadPage :: PagePath -> Aff (Array DocumentsView) loadPage :: PagePath -> Aff (Array DocumentsView)
loadPage {session, nodeId, listId, query, params: {limit, offset, orderBy}} = do loadPage {session, nodeId, listId, query, params: {limit, offset, orderBy}} = do
liftEffect $ log "loading documents page: loadPage with Offset and limit" liftEffect $ log "loading documents page: loadPage with Offset and limit"
let url2 = url session $ Search { listId, offset, limit, orderBy: convOrderBy <$> orderBy } (Just nodeId) let p = Search { listId, offset, limit, orderBy: convOrderBy <$> orderBy } (Just nodeId)
SearchResults res <- post url2 $ SearchQuery {query} SearchResults res <- post session p $ SearchQuery {query}
pure $ res2corpus <$> res.results pure $ res2corpus <$> res.results
where where
res2corpus :: Response -> DocumentsView res2corpus :: Response -> DocumentsView
...@@ -319,11 +318,10 @@ pageCpt = R.staticComponent "G.C.FacetsTable.Page" cpt ...@@ -319,11 +318,10 @@ pageCpt = R.staticComponent "G.C.FacetsTable.Page" cpt
newtype DeleteDocumentQuery = DeleteDocumentQuery { documents :: Array Int } newtype DeleteDocumentQuery = DeleteDocumentQuery { documents :: Array Int }
instance encodeJsonDDQuery :: EncodeJson DeleteDocumentQuery where instance encodeJsonDDQuery :: EncodeJson DeleteDocumentQuery where
encodeJson (DeleteDocumentQuery post) = encodeJson (DeleteDocumentQuery {documents}) =
"documents" := post.documents ~> jsonEmptyObject "documents" := documents ~> jsonEmptyObject
deleteDocuments :: Session -> Int -> DeleteDocumentQuery -> Aff (Array Int) deleteDocuments :: Session -> Int -> DeleteDocumentQuery -> Aff (Array Int)
deleteDocuments session nodeId = deleteDocuments session nodeId =
deleteWithBody $ deleteWithBody session $ NodeAPI Node (Just nodeId) "documents"
(url session $ NodeAPI Node $ Just nodeId) <> "/documents"
...@@ -26,12 +26,11 @@ import Web.File.File (toBlob) ...@@ -26,12 +26,11 @@ import Web.File.File (toBlob)
import Web.File.FileList (FileList, item) import Web.File.FileList (FileList, item)
import Web.File.FileReader.Aff (readAsText) import Web.File.FileReader.Aff (readAsText)
import Gargantext.Config.REST (get, put, post, postWwwUrlencoded, delete)
import Gargantext.Ends (Frontends, url) import Gargantext.Ends (Frontends, url)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as Routes import Gargantext.Routes as Routes
import Gargantext.Routes (AppRoute, SessionRoute(..)) import Gargantext.Routes (AppRoute, SessionRoute(..))
import Gargantext.Sessions (Session, sessionId) import Gargantext.Sessions (Session, sessionId, get, put, post, postWwwUrlencoded, delete)
import Gargantext.Types (class ToQuery, toQuery, NodeType(..), NodePath(..), readNodeType) import Gargantext.Types (class ToQuery, toQuery, NodeType(..), NodePath(..), readNodeType)
import Gargantext.Utils (id) import Gargantext.Utils (id)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
...@@ -668,7 +667,7 @@ nodeText p = R.createElement el p [] ...@@ -668,7 +667,7 @@ nodeText p = R.createElement el p []
-- END node text -- END node text
loadNode :: Session -> ID -> Aff FTree loadNode :: Session -> ID -> Aff FTree
loadNode session = get <<< url session <<< NodeAPI Tree <<< Just loadNode session nodeId = get session $ NodeAPI Tree (Just nodeId) ""
----- TREE CRUD Operations ----- TREE CRUD Operations
...@@ -695,21 +694,18 @@ instance encodeJsonCreateValue :: EncodeJson CreateValue where ...@@ -695,21 +694,18 @@ instance encodeJsonCreateValue :: EncodeJson CreateValue where
~> jsonEmptyObject ~> jsonEmptyObject
createNode :: Session -> ID -> CreateValue -> Aff ID createNode :: Session -> ID -> CreateValue -> Aff ID
--createNode = post $ urlPlease Back $ "new" createNode session parentId = post session $ NodeAPI Node (Just parentId) ""
createNode session parentId = post $ url session (NodeAPI Node $ Just parentId)
renameNode :: Session -> ID -> RenameValue -> Aff (Array ID) renameNode :: Session -> ID -> RenameValue -> Aff (Array ID)
renameNode session renameNodeId = put $ url session (NodeAPI Node $ Just renameNodeId) <> "/rename" renameNode session renameNodeId = put session $ NodeAPI Node (Just renameNodeId) "rename"
deleteNode :: Session -> ID -> Aff ID deleteNode :: Session -> ID -> Aff ID
deleteNode session = delete <<< url session <<< NodeAPI Node <<< Just deleteNode session nodeId = delete session $ NodeAPI Node (Just nodeId) ""
newtype FileUploadQuery = FileUploadQuery { newtype FileUploadQuery = FileUploadQuery {
fileType :: FileType fileType :: FileType
} }
derive instance newtypeSearchQuery :: Newtype FileUploadQuery _ derive instance newtypeSearchQuery :: Newtype FileUploadQuery _
instance fileUploadQueryToQuery :: ToQuery FileUploadQuery where instance fileUploadQueryToQuery :: ToQuery FileUploadQuery where
toQuery (FileUploadQuery {fileType}) = toQuery (FileUploadQuery {fileType}) =
QP.print id id $ QP.QueryPairs $ QP.print id id $ QP.QueryPairs $
...@@ -718,10 +714,11 @@ instance fileUploadQueryToQuery :: ToQuery FileUploadQuery where ...@@ -718,10 +714,11 @@ instance fileUploadQueryToQuery :: ToQuery FileUploadQuery where
pair k v = [ QP.keyFromString k /\ (Just $ QP.valueFromString $ show v) ] pair k v = [ QP.keyFromString k /\ (Just $ QP.valueFromString $ show v) ]
uploadFile :: Session -> ID -> FileType -> UploadFileContents -> Aff (Array FileHash) uploadFile :: Session -> ID -> FileType -> UploadFileContents -> Aff (Array FileHash)
uploadFile session id fileType (UploadFileContents fileContents) = postWwwUrlencoded url2 fileContents uploadFile session id fileType (UploadFileContents fileContents) =
postWwwUrlencoded session p fileContents
where where
q = FileUploadQuery { fileType: fileType } q = FileUploadQuery { fileType: fileType }
url2 = url session (NodeAPI Node (Just id)) <> "/upload" <> Q.print (toQuery q) p = NodeAPI Node (Just id) $ "upload" <> Q.print (toQuery q)
fnTransform :: LNode -> FTree fnTransform :: LNode -> FTree
fnTransform n = NTree n [] fnTransform n = NTree n []
...@@ -22,10 +22,9 @@ import Gargantext.Components.GraphExplorer.ToggleButton as Toggle ...@@ -22,10 +22,9 @@ import Gargantext.Components.GraphExplorer.ToggleButton as Toggle
import Gargantext.Components.GraphExplorer.Types as GET import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.Graph as Graph import Gargantext.Components.Graph as Graph
import Gargantext.Components.Forest (forest) import Gargantext.Components.Forest (forest)
import Gargantext.Config.REST (get) import Gargantext.Ends (Frontends)
import Gargantext.Ends (Frontends, url)
import Gargantext.Routes (SessionRoute(NodeAPI), AppRoute) import Gargantext.Routes (SessionRoute(NodeAPI), AppRoute)
import Gargantext.Sessions (Session, Sessions(..)) import Gargantext.Sessions (Session, Sessions(..), get)
import Gargantext.Types (NodeType(Graph)) import Gargantext.Types (NodeType(Graph))
type GraphId = Int type GraphId = Int
...@@ -289,4 +288,4 @@ defaultPalette = ["#5fa571","#ab9ba2","#da876d","#bdd3ff","#b399df","#ffdfed","# ...@@ -289,4 +288,4 @@ defaultPalette = ["#5fa571","#ab9ba2","#da876d","#bdd3ff","#b399df","#ffdfed","#
getNodes :: Session -> GraphId -> Aff GET.GraphData getNodes :: Session -> GraphId -> Aff GET.GraphData
getNodes session graphId = get $ url session $ NodeAPI Graph (Just graphId) getNodes session graphId = get session $ NodeAPI Graph (Just graphId) ""
...@@ -85,12 +85,11 @@ import Thermite (StateCoTransformer, modifyState_) ...@@ -85,12 +85,11 @@ import Thermite (StateCoTransformer, modifyState_)
import Partial (crashWith) import Partial (crashWith)
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import Gargantext.Config.REST (get, put, post)
import Gargantext.Components.Table as T import Gargantext.Components.Table as T
import Gargantext.Components.OldLoader as Loader import Gargantext.Components.OldLoader as Loader
import Gargantext.Ends (url) import Gargantext.Ends (url)
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session, get, put, post)
import Gargantext.Types (OrderBy(..), CTabNgramType(..), TabType, TermList(..), TermSize) import Gargantext.Types (OrderBy(..), CTabNgramType(..), TabType, TermList(..), TermSize)
import Gargantext.Utils.KarpRabin (indicesOfAny) import Gargantext.Utils.KarpRabin (indicesOfAny)
...@@ -568,9 +567,9 @@ type CoreState s = ...@@ -568,9 +567,9 @@ type CoreState s =
postNewNgrams :: forall s. Session -> Array NgramsTerm -> Maybe TermList -> CoreParams s -> Aff Unit postNewNgrams :: forall s. Session -> Array NgramsTerm -> Maybe TermList -> CoreParams s -> Aff Unit
postNewNgrams session newNgrams mayList {nodeId, listIds, tabType} = postNewNgrams session newNgrams mayList {nodeId, listIds, tabType} =
when (not (A.null newNgrams)) $ do when (not (A.null newNgrams)) $ do
(_ :: Array Unit) <- post (url session put) newNgrams (_ :: Array Unit) <- post session p newNgrams
pure unit pure unit
where put = PutNgrams tabType (head listIds) mayList (Just nodeId) where p = PutNgrams tabType (head listIds) mayList (Just nodeId)
postNewElems :: forall s. Session -> NewElems -> CoreParams s -> Aff Unit postNewElems :: forall s. Session -> NewElems -> CoreParams s -> Aff Unit
postNewElems session newElems params = void $ traverseWithIndex postNewElem newElems postNewElems session newElems params = void $ traverseWithIndex postNewElem newElems
...@@ -582,7 +581,7 @@ addNewNgram ntype ngrams list = { ngramsPatches: mempty ...@@ -582,7 +581,7 @@ addNewNgram ntype ngrams list = { ngramsPatches: mempty
, ngramsNewElems: Map.singleton (normNgram ntype ngrams) list } , ngramsNewElems: Map.singleton (normNgram ntype ngrams) list }
putNgramsPatches :: Session -> {nodeId :: Int, listIds :: Array Int, tabType :: TabType} -> Versioned NgramsPatches -> Aff (Versioned NgramsPatches) putNgramsPatches :: Session -> {nodeId :: Int, listIds :: Array Int, tabType :: TabType} -> Versioned NgramsPatches -> Aff (Versioned NgramsPatches)
putNgramsPatches session {nodeId, listIds, tabType} = put $ url session putNgrams putNgramsPatches session {nodeId, listIds, tabType} = put session putNgrams
where putNgrams = PutNgrams tabType (head listIds) Nothing (Just nodeId) where putNgrams = PutNgrams tabType (head listIds) Nothing (Just nodeId)
commitPatch :: forall s. Session -> {nodeId :: Int, listIds :: Array Int, tabType :: TabType} commitPatch :: forall s. Session -> {nodeId :: Int, listIds :: Array Int, tabType :: TabType}
...@@ -601,12 +600,11 @@ loadNgramsTable :: Session -> PageParams -> Aff VersionedNgramsTable ...@@ -601,12 +600,11 @@ loadNgramsTable :: Session -> PageParams -> Aff VersionedNgramsTable
loadNgramsTable session loadNgramsTable session
{ nodeId, listIds, termListFilter, termSizeFilter { nodeId, listIds, termListFilter, termSizeFilter
, searchQuery, tabType, params: {offset, limit, orderBy}} , searchQuery, tabType, params: {offset, limit, orderBy}}
= get $ url session query = get session query
where query = GetNgrams { tabType, offset, limit, listIds where query = GetNgrams { tabType, offset, limit, listIds
, orderBy: convOrderBy <$> orderBy , orderBy: convOrderBy <$> orderBy
, termListFilter, termSizeFilter , termListFilter, termSizeFilter
, searchQuery } (Just nodeId) , searchQuery } (Just nodeId)
convOrderBy :: T.OrderByDirection T.ColumnName -> OrderBy convOrderBy :: T.OrderByDirection T.ColumnName -> OrderBy
convOrderBy (T.ASC (T.ColumnName "Score (Occurrences)")) = ScoreAsc convOrderBy (T.ASC (T.ColumnName "Score (Occurrences)")) = ScoreAsc
......
...@@ -13,9 +13,8 @@ import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (Contact(..), Hy ...@@ -13,9 +13,8 @@ import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (Contact(..), Hy
import Gargantext.Components.Table as T import Gargantext.Components.Table as T
import Gargantext.Ends (url) import Gargantext.Ends (url)
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, sessionId) import Gargantext.Sessions (Session, sessionId, get)
import Gargantext.Types (NodePath(..), NodeType(..)) import Gargantext.Types (NodePath(..), NodeType(..))
import Gargantext.Config.REST (get)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
newtype IndividuView = newtype IndividuView =
...@@ -42,7 +41,7 @@ annuaireLayoutCpt = R.hooksComponent "G.P.Annuaire.annuaireLayout" cpt ...@@ -42,7 +41,7 @@ annuaireLayoutCpt = R.hooksComponent "G.P.Annuaire.annuaireLayout" cpt
path <- R.useState' nodeId path <- R.useState' nodeId
useLoader (fst path) (getAnnuaireInfo session) $ useLoader (fst path) (getAnnuaireInfo session) $
\info -> annuaire {session, path, info} \info -> annuaire {session, path, info}
type AnnuaireProps = type AnnuaireProps =
( session :: Session ( session :: Session
, path :: R.State Int , path :: R.State Int
...@@ -186,7 +185,7 @@ instance decodeAnnuaireTable :: DecodeJson AnnuaireTable where ...@@ -186,7 +185,7 @@ instance decodeAnnuaireTable :: DecodeJson AnnuaireTable where
loadPage :: Session -> PagePath -> Aff AnnuaireTable loadPage :: Session -> PagePath -> Aff AnnuaireTable
loadPage session {nodeId, params: { offset, limit, orderBy }} = loadPage session {nodeId, params: { offset, limit, orderBy }} =
get $ url session children get session children
-- TODO orderBy -- TODO orderBy
-- where -- where
-- convOrderBy (T.ASC (T.ColumnName "Name")) = NameAsc -- convOrderBy (T.ASC (T.ColumnName "Name")) = NameAsc
...@@ -198,5 +197,5 @@ loadPage session {nodeId, params: { offset, limit, orderBy }} = ...@@ -198,5 +197,5 @@ loadPage session {nodeId, params: { offset, limit, orderBy }} =
children = Children NodeContact offset limit Nothing {-(convOrderBy <$> orderBy)-} (Just nodeId) children = Children NodeContact offset limit Nothing {-(convOrderBy <$> orderBy)-} (Just nodeId)
getAnnuaireInfo :: Session -> Int -> Aff AnnuaireInfo getAnnuaireInfo :: Session -> Int -> Aff AnnuaireInfo
getAnnuaireInfo session id = get $ url session (NodeAPI Node (Just id)) getAnnuaireInfo session id = get session (NodeAPI Node (Just id) "")
...@@ -13,15 +13,13 @@ import Data.String (joinWith) ...@@ -13,15 +13,13 @@ import Data.String (joinWith)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Gargantext.Config.REST (get)
import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types
( Contact(..), ContactData, ContactTouch(..), ContactWhere(..) ( Contact(..), ContactData, ContactTouch(..), ContactWhere(..)
, ContactWho(..), HyperData(..), HyperdataContact(..) ) , ContactWho(..), HyperData(..), HyperdataContact(..) )
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs as Tabs import Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs as Tabs
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session, get)
import Gargantext.Types (NodeType(..)) import Gargantext.Types (NodeType(..))
display :: String -> Array R.Element -> R.Element display :: String -> Array R.Element -> R.Element
...@@ -142,7 +140,7 @@ userLayoutCpt = R.hooksComponent "G.P.Annuaire.UserLayout" cpt ...@@ -142,7 +140,7 @@ userLayoutCpt = R.hooksComponent "G.P.Annuaire.UserLayout" cpt
-- | toUrl to get data -- | toUrl to get data
getContact :: Session -> Int -> Aff ContactData getContact :: Session -> Int -> Aff ContactData
getContact session id = do getContact session id = do
contactNode <- get $ url session (NodeAPI NodeContact (Just id)) contactNode <- get session $ NodeAPI NodeContact (Just id) ""
-- TODO: we need a default list for the pairings -- TODO: we need a default list for the pairings
--defaultListIds <- get $ toUrl endConfigStateful Back (Children NodeList 0 1 Nothing) $ Just id --defaultListIds <- get $ toUrl endConfigStateful Back (Children NodeList 0 1 Nothing) $ Just id
--case (head defaultListIds :: Maybe (NodePoly HyperdataList)) of --case (head defaultListIds :: Maybe (NodePoly HyperdataList)) of
......
module Gargantext.Components.Nodes.Corpus where module Gargantext.Components.Nodes.Corpus where
import Prelude ((<<<))
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.??))
import Data.Array (head)
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff, throwError)
import Effect.Exception (error)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Components.Node (NodePoly(..), HyperdataList)
import Gargantext.Types (NodeType(..))
import Gargantext.Routes (SessionRoute(NodeAPI, Children))
import Gargantext.Sessions (Session, get)
type Props = ( nodeId :: Int ) type Props = ( nodeId :: Int )
...@@ -15,3 +26,64 @@ corpusLayoutCpt = R.staticComponent "G.P.Corpus.corpusLayout" cpt ...@@ -15,3 +26,64 @@ corpusLayoutCpt = R.staticComponent "G.P.Corpus.corpusLayout" cpt
H.div {} H.div {}
[ H.h1 {} [H.text "Corpus Description"] [ H.h1 {} [H.text "Corpus Description"]
, H.p {} [H.text "Soon: corpus synthesis here (when all others charts/features will be stabilized)."] ] , H.p {} [H.text "Soon: corpus synthesis here (when all others charts/features will be stabilized)."] ]
newtype CorpusInfo =
CorpusInfo
{ title :: String
, desc :: String
, query :: String
, authors :: String
, chart :: (Maybe (Array Number))
, totalRecords :: Int }
hyperdataDefault :: CorpusInfo
hyperdataDefault =
CorpusInfo
{ title : "Default title"
, desc : " Default desc"
, query : " Default Query"
, authors : " Author(s): default"
, chart : Nothing
, totalRecords : 0 }
corpusInfoDefault :: NodePoly CorpusInfo
corpusInfoDefault =
NodePoly
{ id : 0
, typename : 0
, userId : 0
, parentId : 0
, name : "Default name"
, date : " Default date"
, hyperdata : hyperdataDefault }
instance decodeCorpusInfo :: DecodeJson CorpusInfo where
decodeJson json = do
obj <- decodeJson json
title <- obj .: "title"
desc <- obj .: "desc"
query <- obj .: "query"
authors <- obj .: "authors"
chart <- obj .?? "chart"
let totalRecords = 47361 -- TODO
pure $ CorpusInfo {title, desc, query, authors, chart, totalRecords}
type CorpusData = { corpusId :: Int
, corpusNode :: NodePoly CorpusInfo
, defaultListId :: Int}
loadCorpus :: { session :: Session, nodeId :: Int } -> Aff CorpusData
loadCorpus {session, nodeId: listId} = do
-- fetch corpus via lists parentId
(NodePoly {parentId: corpusId} :: NodePoly {}) <- get session nodePolyRoute
corpusNode <- get session $ corpusNodeRoute corpusId ""
defaultListIds <- get session $ defaultListIdsRoute corpusId
case (head defaultListIds :: Maybe (NodePoly HyperdataList)) of
Just (NodePoly { id: defaultListId }) ->
pure {corpusId, corpusNode, defaultListId}
Nothing ->
throwError $ error "Missing default list"
where
nodePolyRoute = NodeAPI Corpus (Just listId) ""
corpusNodeRoute = NodeAPI Corpus <<< Just
defaultListIdsRoute = Children NodeList 0 1 Nothing <<< Just
...@@ -4,7 +4,6 @@ import Prelude (bind, map, pure, ($)) ...@@ -4,7 +4,6 @@ import Prelude (bind, map, pure, ($))
import Data.Argonaut (class DecodeJson, decodeJson, (.:)) import Data.Argonaut (class DecodeJson, decodeJson, (.:))
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Config.REST (get)
import Reactix as R import Reactix as R
import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis') import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis')
...@@ -16,7 +15,7 @@ import Gargantext.Ends (url) ...@@ -16,7 +15,7 @@ import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session, get)
import Gargantext.Types (ChartType(..), TabType) import Gargantext.Types (ChartType(..), TabType)
type Path = { corpusId :: Int, tabType :: TabType } type Path = { corpusId :: Int, tabType :: TabType }
...@@ -55,7 +54,7 @@ chartOptions (HistoMetrics { dates: dates', count: count'}) = Options ...@@ -55,7 +54,7 @@ chartOptions (HistoMetrics { dates: dates', count: count'}) = Options
getMetrics :: Session -> Path -> Aff HistoMetrics getMetrics :: Session -> Path -> Aff HistoMetrics
getMetrics session {corpusId, tabType} = do getMetrics session {corpusId, tabType} = do
ChartMetrics ms <- get $ url session chart ChartMetrics ms <- get session chart
pure ms."data" pure ms."data"
where chart = Chart {chartType: Histo, tabType: tabType} (Just corpusId) where chart = Chart {chartType: Histo, tabType: tabType} (Just corpusId)
......
...@@ -7,7 +7,6 @@ import Data.Map (Map) ...@@ -7,7 +7,6 @@ import Data.Map (Map)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Config.REST (get)
import Reactix as R import Reactix as R
import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, yAxis') import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, yAxis')
...@@ -20,7 +19,7 @@ import Gargantext.Ends (url) ...@@ -20,7 +19,7 @@ import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session, get)
import Gargantext.Types (TabType, TermList(..)) import Gargantext.Types (TabType, TermList(..))
type Path = type Path =
...@@ -96,7 +95,7 @@ scatterOptions metrics' = Options ...@@ -96,7 +95,7 @@ scatterOptions metrics' = Options
getMetrics :: Session -> Path -> Aff Loaded getMetrics :: Session -> Path -> Aff Loaded
getMetrics session {corpusId, listId, limit, tabType} = do getMetrics session {corpusId, listId, limit, tabType} = do
Metrics ms <- get $ url session metrics' Metrics ms <- get session metrics'
pure ms."data" pure ms."data"
where metrics' = CorpusMetrics {listId, tabType, limit} (Just corpusId) where metrics' = CorpusMetrics {listId, tabType, limit} (Just corpusId)
......
...@@ -8,7 +8,6 @@ import Data.Maybe (Maybe(..)) ...@@ -8,7 +8,6 @@ import Data.Maybe (Maybe(..))
import Data.String (take, joinWith, Pattern(..), split, length) import Data.String (take, joinWith, Pattern(..), split, length)
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Config.REST (get)
import Reactix as R import Reactix as R
import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis') import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis')
...@@ -20,7 +19,7 @@ import Gargantext.Ends (url) ...@@ -20,7 +19,7 @@ import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session, get)
import Gargantext.Types (ChartType(..), TabType) import Gargantext.Types (ChartType(..), TabType)
type Path = type Path =
...@@ -80,7 +79,7 @@ chartOptionsPie (HistoMetrics { dates: dates', count: count'}) = Options ...@@ -80,7 +79,7 @@ chartOptionsPie (HistoMetrics { dates: dates', count: count'}) = Options
getMetrics :: Session -> Path -> Aff HistoMetrics getMetrics :: Session -> Path -> Aff HistoMetrics
getMetrics session {corpusId, tabType:tabType} = do getMetrics session {corpusId, tabType:tabType} = do
ChartMetrics ms <- get $ url session chart ChartMetrics ms <- get session chart
pure ms."data" pure ms."data"
where chart = Chart {chartType: ChartPie, tabType: tabType} (Just corpusId) where chart = Chart {chartType: ChartPie, tabType: tabType} (Just corpusId)
......
...@@ -7,7 +7,6 @@ import Effect.Aff (Aff) ...@@ -7,7 +7,6 @@ import Effect.Aff (Aff)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Gargantext.Config.REST (get)
import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis') import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis')
import Gargantext.Components.Charts.Options.Series (TreeNode, Trees(..), mkTree) import Gargantext.Components.Charts.Options.Series (TreeNode, Trees(..), mkTree)
import Gargantext.Components.Charts.Options.Font (mkTooltip, templateFormatter) import Gargantext.Components.Charts.Options.Font (mkTooltip, templateFormatter)
...@@ -15,7 +14,7 @@ import Gargantext.Ends (url) ...@@ -15,7 +14,7 @@ import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session, get)
import Gargantext.Types (ChartType(..), TabType) import Gargantext.Types (ChartType(..), TabType)
type Path = type Path =
...@@ -54,7 +53,7 @@ scatterOptions nodes = Options ...@@ -54,7 +53,7 @@ scatterOptions nodes = Options
getMetrics :: Session -> Path -> Aff Loaded getMetrics :: Session -> Path -> Aff Loaded
getMetrics session {corpusId, listId, limit, tabType} = do getMetrics session {corpusId, listId, limit, tabType} = do
Metrics ms <- get $ url session chart Metrics ms <- get session chart
pure ms."data" pure ms."data"
where where
chart = Chart {chartType : ChartTree, tabType: tabType} (Just corpusId) chart = Chart {chartType : ChartTree, tabType: tabType} (Just corpusId)
......
...@@ -12,7 +12,6 @@ import React.DOM.Props (className) ...@@ -12,7 +12,6 @@ import React.DOM.Props (className)
import Reactix as R import Reactix as R
import Thermite (PerformAction, Render, Spec, simpleSpec, createClass) import Thermite (PerformAction, Render, Spec, simpleSpec, createClass)
import Gargantext.Config.REST (get)
import Gargantext.Components.AutoUpdate (autoUpdateElt) import Gargantext.Components.AutoUpdate (autoUpdateElt)
import Gargantext.Components.Node (NodePoly(..)) import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.NgramsTable.Core import Gargantext.Components.NgramsTable.Core
...@@ -23,7 +22,7 @@ import Gargantext.Components.Annotation.AnnotatedField as AnnotatedField ...@@ -23,7 +22,7 @@ import Gargantext.Components.Annotation.AnnotatedField as AnnotatedField
import Gargantext.Ends (url) import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session, get)
import Gargantext.Types (CTabNgramType(..), NodeType(..), TabSubType(..), TabType(..), TermList) import Gargantext.Types (CTabNgramType(..), NodeType(..), TabSubType(..), TabType(..), TermList)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
...@@ -369,7 +368,7 @@ documentLayoutCpt = R.hooksComponent "G.P.Corpus.Document.documentLayout" cpt ...@@ -369,7 +368,7 @@ documentLayoutCpt = R.hooksComponent "G.P.Corpus.Document.documentLayout" cpt
------------------------------------------------------------------------ ------------------------------------------------------------------------
loadDocument :: Session -> Int -> Aff NodeDocument loadDocument :: Session -> Int -> Aff NodeDocument
loadDocument session = get <<< url session <<< NodeAPI Node <<< Just loadDocument session nodeId = get session $ NodeAPI Node (Just nodeId) ""
loadData :: Session -> DocPath -> Aff LoadedData loadData :: Session -> DocPath -> Aff LoadedData
loadData session {nodeId, listIds, tabType} = do loadData session {nodeId, listIds, tabType} = do
......
module Gargantext.Components.Nodes.Lists where module Gargantext.Components.Nodes.Lists where
import Prelude ((<<<))
import Data.Array (head)
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff, throwError)
import Effect.Exception (error)
import Reactix as R import Reactix as R
-------------------------------------------------------- --------------------------------------------------------
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Components.Node (NodePoly(..), HyperdataList) import Gargantext.Components.Nodes.Corpus (CorpusInfo(..), loadCorpus)
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Table as Table import Gargantext.Components.Table as Table
import Gargantext.Config.REST (get)
import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Components.Nodes.Lists.Tabs as Tabs import Gargantext.Components.Nodes.Lists.Tabs as Tabs
import Gargantext.Routes (SessionRoute(NodeAPI, Children))
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (NodeType(..))
------------------------------------------------------------------------ ------------------------------------------------------------------------
type Props = ( nodeId :: Int, session :: Session ) type Props = ( session :: Session, nodeId :: Int )
listsLayout :: Record Props -> R.Element listsLayout :: Record Props -> R.Element
listsLayout props = R.createElement listsLayoutCpt props [] listsLayout props = R.createElement listsLayoutCpt props []
...@@ -28,29 +20,13 @@ listsLayout props = R.createElement listsLayoutCpt props [] ...@@ -28,29 +20,13 @@ listsLayout props = R.createElement listsLayoutCpt props []
listsLayoutCpt :: R.Component Props listsLayoutCpt :: R.Component Props
listsLayoutCpt = R.hooksComponent "G.P.Lists.listsLayout" cpt listsLayoutCpt = R.hooksComponent "G.P.Lists.listsLayout" cpt
where where
cpt {nodeId, session} _ = cpt path@{session} _ =
useLoader nodeId (getCorpus session) $ useLoader path loadCorpus $
\corpusData@{corpusId, defaultListId, corpusNode: NodePoly poly} -> \corpusData@{corpusId, defaultListId, corpusNode: NodePoly poly} ->
let { name, date, hyperdata: Tabs.CorpusInfo corpus } = poly let { name, date, hyperdata: CorpusInfo corpus } = poly
{ desc, query, authors: user } = corpus in { desc, query, authors: user } = corpus in
R.fragment R.fragment
[ Table.tableHeaderLayout [ Table.tableHeaderLayout
{ title: "Corpus " <> name, desc, query, user, date } { title: "Corpus " <> name, desc, query, user, date }
, Tabs.tabs {session, corpusId, corpusData}] , Tabs.tabs {session, corpusId, corpusData}]
------------------------------------------------------------------------ ------------------------------------------------------------------------
getCorpus :: Session -> Int -> Aff Tabs.CorpusData
getCorpus session listId = do
-- fetch corpus via lists parentId
(NodePoly {parentId: corpusId} :: NodePoly {}) <- get nodePolyUrl
corpusNode <- get $ corpusNodeUrl corpusId
defaultListIds <- get $ defaultListIdsUrl corpusId
case (head defaultListIds :: Maybe (NodePoly HyperdataList)) of
Just (NodePoly { id: defaultListId }) ->
pure {corpusId, corpusNode, defaultListId}
Nothing ->
throwError $ error "Missing default list"
where
nodePolyUrl = url session (NodeAPI Corpus (Just listId))
corpusNodeUrl = url session <<< NodeAPI Corpus <<< Just
defaultListIdsUrl = url session <<< Children NodeList 0 1 Nothing <<< Just
module Gargantext.Components.Nodes.Lists.Tabs where module Gargantext.Components.Nodes.Lists.Tabs where
import Prelude import Prelude
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.??))
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Reactix as R import Reactix as R
import Gargantext.Components.NgramsTable as NT import Gargantext.Components.NgramsTable as NT
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Tab as Tab import Gargantext.Components.Tab as Tab
import Gargantext.Components.Nodes.Corpus (CorpusData)
import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics) import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics)
import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie, bar) import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie, bar)
import Gargantext.Components.Nodes.Corpus.Chart.Tree (tree) import Gargantext.Components.Nodes.Corpus.Chart.Tree (tree)
...@@ -73,50 +72,3 @@ ngramsViewCpt = R.staticComponent "ListsNgramsView" cpt ...@@ -73,50 +72,3 @@ ngramsViewCpt = R.staticComponent "ListsNgramsView" cpt
chart Sources = bar {session, path} chart Sources = bar {session, path}
chart Institutes = tree {session, path: path2} chart Institutes = tree {session, path: path2}
chart Terms = metrics {session, path: path2} chart Terms = metrics {session, path: path2}
newtype CorpusInfo =
CorpusInfo
{ title :: String
, desc :: String
, query :: String
, authors :: String
, chart :: (Maybe (Array Number))
, totalRecords :: Int }
hyperdataDefault :: CorpusInfo
hyperdataDefault =
CorpusInfo
{ title : "Default title"
, desc : " Default desc"
, query : " Default Query"
, authors : " Author(s): default"
, chart : Nothing
, totalRecords : 0 }
corpusInfoDefault :: NodePoly CorpusInfo
corpusInfoDefault =
NodePoly
{ id : 0
, typename : 0
, userId : 0
, parentId : 0
, name : "Default name"
, date : " Default date"
, hyperdata : hyperdataDefault }
instance decodeCorpusInfo :: DecodeJson CorpusInfo where
decodeJson json = do
obj <- decodeJson json
title <- obj .: "title"
desc <- obj .: "desc"
query <- obj .: "query"
authors <- obj .: "authors"
chart <- obj .?? "chart"
let totalRecords = 47361 -- TODO
pure $ CorpusInfo {title, desc, query, authors, chart, totalRecords}
type CorpusData = { corpusId :: Int
, corpusNode :: NodePoly CorpusInfo
, defaultListId :: Int}
module Gargantext.Components.Nodes.Texts where module Gargantext.Components.Nodes.Texts where
import Prelude ((<<<))
import Data.Array (head)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import DOM.Simple.Console (log2)
import Effect.Class (liftEffect)
import Effect.Aff (Aff, throwError)
import Effect.Exception (error)
import Reactix as R import Reactix as R
-------------------------------------------------------- --------------------------------------------------------
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Components.Loader (loader) import Gargantext.Components.Loader (loader)
import Gargantext.Components.Node (NodePoly(..), HyperdataList) import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Table as Table import Gargantext.Components.Table as Table
import Gargantext.Config.REST (get)
import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Components.Nodes.Texts.Tabs (CorpusData, CorpusInfo(..)) import Gargantext.Components.Nodes.Corpus (CorpusInfo(..), loadCorpus)
import Gargantext.Components.Nodes.Texts.Tabs as Tabs import Gargantext.Components.Nodes.Texts.Tabs as Tabs
import Gargantext.Routes (SessionRoute(NodeAPI, Children))
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (NodeType(..)) import Gargantext.Types (NodeType(..))
...@@ -41,23 +32,3 @@ textsLayoutCpt = R.hooksComponent "G.P.Texts.textsLayout" cpt where ...@@ -41,23 +32,3 @@ textsLayoutCpt = R.hooksComponent "G.P.Texts.textsLayout" cpt where
tabs = Tabs.tabs {session, corpusId, corpusData} tabs = Tabs.tabs {session, corpusId, corpusData}
title = "Corpus " <> name title = "Corpus " <> name
headerProps = { title, desc, query, date, user } headerProps = { title, desc, query, date, user }
------------------------------------------------------------------------
loadCorpus :: Record Props -> Aff CorpusData
loadCorpus {session, nodeId} = do
liftEffect $ log2 "nodepolyurl: " nodePolyUrl
-- fetch corpus via texts parentId
(NodePoly {parentId: corpusId} :: NodePoly {}) <- get nodePolyUrl
liftEffect $ log2 "corpusnodeurl: " $ corpusNodeUrl corpusId
corpusNode <- get $ corpusNodeUrl corpusId
liftEffect $ log2 "defaultlistidsurl: " $ defaultListIdsUrl corpusId
defaultListIds <- get $ defaultListIdsUrl corpusId
case (head defaultListIds :: Maybe (NodePoly HyperdataList)) of
Just (NodePoly { id: defaultListId }) ->
pure {corpusId, corpusNode, defaultListId}
Nothing ->
throwError $ error "Missing default list"
where
nodePolyUrl = url session $ NodeAPI Corpus (Just nodeId)
corpusNodeUrl = url session <<< NodeAPI Corpus <<< Just
defaultListIdsUrl = url session <<< Children NodeList 0 1 Nothing <<< Just
...@@ -13,6 +13,7 @@ import Reactix.DOM.HTML as H ...@@ -13,6 +13,7 @@ import Reactix.DOM.HTML as H
import Gargantext.Components.DocsTable as DT import Gargantext.Components.DocsTable as DT
import Gargantext.Components.Node (NodePoly(..)) import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Tab as Tab import Gargantext.Components.Tab as Tab
import Gargantext.Components.Nodes.Corpus (CorpusData)
import Gargantext.Components.Nodes.Corpus.Chart.Histo (histo) import Gargantext.Components.Nodes.Corpus.Chart.Histo (histo)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType(..), TabSubType(..), TabType(..)) import Gargantext.Types (CTabNgramType(..), TabSubType(..), TabType(..))
...@@ -117,45 +118,5 @@ docViewCpt = R.hooksComponent "DocViewWithCorpus" cpt ...@@ -117,45 +118,5 @@ docViewCpt = R.hooksComponent "DocViewWithCorpus" cpt
, showSearch: true , showSearch: true
, session } , session }
newtype CorpusInfo = CorpusInfo { title :: String
, desc :: String
, query :: String
, authors :: String
, chart :: (Maybe (Array Number))
, totalRecords :: Int
}
corpusInfoDefault :: NodePoly CorpusInfo
corpusInfoDefault = NodePoly { id : 0
, typename : 0
, userId : 0
, parentId : 0
, name : "Default name"
, date : " Default date"
, hyperdata : CorpusInfo
{ title : "Default title"
, desc : " Default desc"
, query : " Default Query"
, authors : " Author(s): default"
, chart : Nothing
, totalRecords : 0
}
}
instance decodeCorpusInfo :: DecodeJson CorpusInfo where
decodeJson json = do
obj <- decodeJson json
title <- obj .: "title"
desc <- obj .: "desc"
query <- obj .: "query"
authors <- obj .: "authors"
chart <- obj .?? "chart"
let totalRecords = 47361 -- TODO
pure $ CorpusInfo {title, desc, query, authors, chart, totalRecords}
type CorpusData = { corpusId :: Int
, corpusNode :: NodePoly CorpusInfo
, defaultListId :: Int}
...@@ -10,10 +10,9 @@ import Data.Newtype (class Newtype) ...@@ -10,10 +10,9 @@ import Data.Newtype (class Newtype)
import Data.Tuple (Tuple) import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Config.REST (post, put) import Gargantext.Ends (class ToUrl, backendUrl)
import Gargantext.Ends (class ToUrl, backendUrl, url)
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session(..)) import Gargantext.Sessions (Session(..), post, put)
import Gargantext.Types (class ToQuery, toQuery, NodeType(..)) import Gargantext.Types (class ToQuery, toQuery, NodeType(..))
import Gargantext.Utils (id) import Gargantext.Utils (id)
import URI.Extra.QueryPairs as QP import URI.Extra.QueryPairs as QP
...@@ -170,12 +169,12 @@ instance encodeJsonCategoryQuery :: EncodeJson CategoryQuery where ...@@ -170,12 +169,12 @@ instance encodeJsonCategoryQuery :: EncodeJson CategoryQuery where
~> "ntc_category" := encodeJson post.category ~> "ntc_category" := encodeJson post.category
~> jsonEmptyObject ~> jsonEmptyObject
categoryUrl :: Session -> Int -> String categoryRoute :: Int -> SessionRoute
categoryUrl session nodeId = url session (NodeAPI Node $ Just nodeId) <> "/category" categoryRoute nodeId = NodeAPI Node (Just nodeId) "category"
putCategories :: Session -> Int -> CategoryQuery -> Aff (Array Int) putCategories :: Session -> Int -> CategoryQuery -> Aff (Array Int)
putCategories session nodeId = put $ categoryUrl session nodeId putCategories session nodeId = put session $ categoryRoute nodeId
performSearch :: forall a. DecodeJson a => Session -> SearchQuery -> Aff a performSearch :: forall a. DecodeJson a => Session -> SearchQuery -> Aff a
performSearch session q = post (url session q) q performSearch session q = post session q q
This diff is collapsed.
module Gargantext.Config.REST where module Gargantext.Config.REST where
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Ends
import Affjax (defaultRequest, printResponseFormatError, request) import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.RequestBody (RequestBody(..), string) import Affjax.RequestBody (RequestBody(..), string)
...@@ -11,20 +12,26 @@ import Data.Either (Either(..)) ...@@ -11,20 +12,26 @@ import Data.Either (Either(..))
import Data.HTTP.Method (Method(..)) import Data.HTTP.Method (Method(..))
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.MediaType.Common (applicationFormURLEncoded, applicationJSON) import Data.MediaType.Common (applicationFormURLEncoded, applicationJSON)
import Data.Foldable (foldMap)
import Effect.Aff (Aff, throwError) import Effect.Aff (Aff, throwError)
import Effect.Exception (error) import Effect.Exception (error)
type Token = String
-- TODO too much duplicate code in `postWwwUrlencoded`
send :: forall a b. EncodeJson a => DecodeJson b => send :: forall a b. EncodeJson a => DecodeJson b =>
Method -> String -> Maybe a -> Aff b Method -> Maybe Token -> String -> Maybe a -> Aff b
send m url reqbody = do send m mtoken url reqbody = do
affResp <- request $ defaultRequest affResp <- request $ defaultRequest
{ url = url { url = url
, responseFormat = ResponseFormat.json , responseFormat = ResponseFormat.json
, method = Left m , method = Left m
, headers = [ ContentType applicationJSON , headers = [ ContentType applicationJSON
, Accept applicationJSON , Accept applicationJSON
-- , RequestHeader "Authorization" $ "Bearer " <> token ] <>
] foldMap (\token ->
[RequestHeader "Authorization" $ "Bearer " <> token]
) mtoken
, content = (Json <<< encodeJson) <$> reqbody , content = (Json <<< encodeJson) <$> reqbody
} }
case affResp.body of case affResp.body of
...@@ -42,32 +49,36 @@ send m url reqbody = do ...@@ -42,32 +49,36 @@ send m url reqbody = do
noReqBody :: Maybe Unit noReqBody :: Maybe Unit
noReqBody = Nothing noReqBody = Nothing
get :: forall a. DecodeJson a => String -> Aff a get :: forall a. DecodeJson a => Maybe Token -> String -> Aff a
get url = send GET url noReqBody get mtoken url = send GET mtoken url noReqBody
put :: forall a b. EncodeJson a => DecodeJson b => String -> a -> Aff b put :: forall a b. EncodeJson a => DecodeJson b => Maybe Token -> String -> a -> Aff b
put url = send PUT url <<< Just put mtoken url = send PUT mtoken url <<< Just
delete :: forall a. DecodeJson a => String -> Aff a delete :: forall a. DecodeJson a => Maybe Token -> String -> Aff a
delete url = send DELETE url noReqBody delete mtoken url = send DELETE mtoken url noReqBody
-- This might not be a good idea: -- This might not be a good idea:
-- https://stackoverflow.com/questions/14323716/restful-alternatives-to-delete-request-body -- https://stackoverflow.com/questions/14323716/restful-alternatives-to-delete-request-body
deleteWithBody :: forall a b. EncodeJson a => DecodeJson b => String -> a -> Aff b deleteWithBody :: forall a b. EncodeJson a => DecodeJson b => Maybe Token -> String -> a -> Aff b
deleteWithBody url = send DELETE url <<< Just deleteWithBody mtoken url = send DELETE mtoken url <<< Just
post :: forall a b. EncodeJson a => DecodeJson b => String -> a -> Aff b post :: forall a b. EncodeJson a => DecodeJson b => Maybe Token -> String -> a -> Aff b
post url = send POST url <<< Just post mtoken url = send POST mtoken url <<< Just
postWwwUrlencoded :: forall b. DecodeJson b => String -> String -> Aff b -- TODO too much duplicate code with `send`
postWwwUrlencoded url body = do postWwwUrlencoded :: forall b. DecodeJson b => Maybe Token -> String -> String -> Aff b
postWwwUrlencoded mtoken url body = do
affResp <- request $ defaultRequest affResp <- request $ defaultRequest
{ url = url { url = url
, responseFormat = ResponseFormat.json , responseFormat = ResponseFormat.json
, method = Left POST , method = Left POST
, headers = [ ContentType applicationFormURLEncoded , headers = [ ContentType applicationFormURLEncoded
, Accept applicationJSON , Accept applicationJSON
] ] <>
foldMap (\token ->
[RequestHeader "Authorization" $ "Bearer " <> token]
) mtoken
, content = Just $ string body , content = Just $ string body
} }
case affResp.body of case affResp.body of
......
...@@ -3,7 +3,7 @@ module Gargantext.Ends ...@@ -3,7 +3,7 @@ module Gargantext.Ends
-- ( ) -- ( )
where where
import Prelude (class Eq, class Show, identity, show, ($), (<>), bind, pure) import Prelude (class Eq, class Show, identity, show, ($), (<>), bind, pure, (<<<), (==))
import Data.Argonaut ( class DecodeJson, decodeJson, class EncodeJson, encodeJson, (:=), (~>), jsonEmptyObject, (.:)) import Data.Argonaut ( class DecodeJson, decodeJson, class EncodeJson, encodeJson, (:=), (~>), jsonEmptyObject, (.:))
import Data.Foldable (foldMap) import Data.Foldable (foldMap)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
...@@ -114,54 +114,57 @@ staticUrl :: Frontends -> String -> String ...@@ -114,54 +114,57 @@ staticUrl :: Frontends -> String -> String
staticUrl (Frontends {static}) = frontendUrl static staticUrl (Frontends {static}) = frontendUrl static
sessionPath :: R.SessionRoute -> String sessionPath :: R.SessionRoute -> String
sessionPath (R.Tab t i) = sessionPath (R.NodeAPI Node i) <> "/" <> showTabType' t sessionPath (R.Tab t i) = sessionPath (R.NodeAPI Node i (showTabType' t))
sessionPath (R.Children n o l s i) = root <> "children?type=" <> show n <> offsetUrl o <> limitUrl l <> orderUrl s sessionPath (R.Children n o l s i) = sessionPath (R.NodeAPI Node i ("children?type=" <> show n <> offsetUrl o <> limitUrl l <> orderUrl s))
where root = sessionPath (R.NodeAPI Node i) <> "/" sessionPath (R.NodeAPI Phylo pId p) = "phyloscape?nodeId=" <> (show $ maybe 0 identity pId) <> p
sessionPath (R.NodeAPI Phylo pId) = "phyloscape?nodeId=" <> (show $ maybe 0 identity pId) sessionPath (R.GetNgrams opts i) =
sessionPath (R.GetNgrams opts i) =
base opts.tabType base opts.tabType
<> "/ngrams?ngramsType=" $ "ngrams?ngramsType="
<> showTabType' opts.tabType <> showTabType' opts.tabType
<> offsetUrl opts.offset <> offsetUrl opts.offset
<> limitUrl opts.limit <> limitUrl opts.limit
<> orderByUrl opts.orderBy <> orderByUrl opts.orderBy
<> foldMap (\x -> "&list=" <> show x) opts.listIds <> foldMap (\x -> "&list=" <> show x) opts.listIds
<> foldMap (\x -> "&listType=" <> show x) opts.termListFilter <> foldMap (\x -> "&listType=" <> show x) opts.termListFilter
<> foldMap termSizeFilter opts.termSizeFilter <> foldMap termSizeFilter opts.termSizeFilter
<> search opts.searchQuery <> search opts.searchQuery
where where
base (TabCorpus _) = sessionPath (R.NodeAPI Node i) base (TabCorpus _) = sessionPath <<< R.NodeAPI Node i
base _ = sessionPath (R.NodeAPI Url_Document i) base _ = sessionPath <<< R.NodeAPI Url_Document i
termSizeFilter MonoTerm = "&minTermSize=0&maxTermSize=1" termSizeFilter MonoTerm = "&minTermSize=0&maxTermSize=1"
termSizeFilter MultiTerm = "&minTermSize=2" termSizeFilter MultiTerm = "&minTermSize=2"
search "" = "" search "" = ""
search s = "&search=" <> s search s = "&search=" <> s
sessionPath (R.ListDocument lId dId) = sessionPath (R.ListDocument lId dId) =
sessionPath (R.NodeAPI NodeList lId) <> "/document/" <> (show $ maybe 0 identity dId) sessionPath $ R.NodeAPI NodeList lId ("document/" <> (show $ maybe 0 identity dId))
sessionPath (R.PutNgrams t listId termList i) = sessionPath (R.PutNgrams t listId termList i) =
sessionPath (R.NodeAPI Node i) sessionPath $ R.NodeAPI Node i
<> "/ngrams?ngramsType=" $ "ngrams?ngramsType="
<> showTabType' t <> showTabType' t
<> maybe "" (\x -> "&list=" <> show x) listId <> maybe "" (\x -> "&list=" <> show x) listId
<> foldMap (\x -> "&listType=" <> show x) termList <> foldMap (\x -> "&listType=" <> show x) termList
sessionPath (R.NodeAPI nt i) = nodeTypePath nt <> (maybe "" (\i' -> "/" <> show i') i) sessionPath (R.NodeAPI nt i p) = nodeTypePath nt
<> (maybe "" (\i' -> "/" <> show i') i)
<> (if p == "" then "" else "/" <> p)
sessionPath (R.Search {listId,limit,offset,orderBy} i) = sessionPath (R.Search {listId,limit,offset,orderBy} i) =
sessionPath (R.NodeAPI Corpus i) sessionPath $ R.NodeAPI Corpus i
<> "/search?list_id=" <> show listId $ "search?list_id=" <> show listId
<> offsetUrl offset <> offsetUrl offset
<> limitUrl limit <> limitUrl limit
<> orderUrl orderBy <> orderUrl orderBy
sessionPath (R.CorpusMetrics {tabType, listId, limit} i) = sessionPath (R.CorpusMetrics {tabType, listId, limit} i) =
sessionPath (R.NodeAPI Corpus i) <> "/metrics" sessionPath $ R.NodeAPI Corpus i
<> "?ngrams=" <> show listId $ "metrics"
<> "&ngramsType=" <> showTabType' tabType <> "?ngrams=" <> show listId
<> maybe "" (\x -> "&limit=" <> show x) limit <> "&ngramsType=" <> showTabType' tabType
<> maybe "" (\x -> "&limit=" <> show x) limit
-- TODO fix this url path -- TODO fix this url path
sessionPath (R.Chart {chartType, tabType} i) = sessionPath (R.Chart {chartType, tabType} i) =
sessionPath (R.NodeAPI Corpus i) <> "/" <> show chartType sessionPath $ R.NodeAPI Corpus i
<> "?ngramsType=" <> showTabType' tabType $ show chartType
<> "&listType=GraphTerm" -- <> show listId <> "?ngramsType=" <> showTabType' tabType
-- <> maybe "" (\x -> "&limit=" <> show x) limit <> "&listType=GraphTerm" -- <> show listId
-- <> maybe "" (\x -> "&limit=" <> show x) limit
------- misc routing stuff ------- misc routing stuff
......
...@@ -25,7 +25,7 @@ data SessionRoute ...@@ -25,7 +25,7 @@ data SessionRoute
| GetNgrams NgramsGetOpts (Maybe Id) | GetNgrams NgramsGetOpts (Maybe Id)
| PutNgrams TabType (Maybe ListId) (Maybe TermList) (Maybe Id) | PutNgrams TabType (Maybe ListId) (Maybe TermList) (Maybe Id)
-- ^ This name is not good. In particular this URL is used both in PUT and POST. -- ^ This name is not good. In particular this URL is used both in PUT and POST.
| NodeAPI NodeType (Maybe Id) | NodeAPI NodeType (Maybe Id) String
| ListDocument (Maybe ListId) (Maybe Id) | ListDocument (Maybe ListId) (Maybe Id)
| Search SearchOpts (Maybe Id) | Search SearchOpts (Maybe Id)
| CorpusMetrics CorpusMetricOpts (Maybe Id) | CorpusMetrics CorpusMetricOpts (Maybe Id)
......
...@@ -20,7 +20,7 @@ import Web.HTML.Window (localStorage) ...@@ -20,7 +20,7 @@ import Web.HTML.Window (localStorage)
import Web.Storage.Storage (removeItem) -- (getItem, setItem, removeItem) import Web.Storage.Storage (removeItem) -- (getItem, setItem, removeItem)
import Gargantext.Components.Login.Types import Gargantext.Components.Login.Types
(AuthRequest(..), AuthResponse(..), AuthInvalid(..), AuthData(..)) (AuthRequest(..), AuthResponse(..), AuthInvalid(..), AuthData(..))
import Gargantext.Config.REST (post) import Gargantext.Config.REST as REST
import Gargantext.Ends (class ToUrl, Backend, backendUrl, toUrl, sessionPath) import Gargantext.Ends (class ToUrl, Backend, backendUrl, toUrl, sessionPath)
import Gargantext.Routes (SessionRoute) import Gargantext.Routes (SessionRoute)
import Gargantext.Types (NodePath, SessionId(..), nodePath) import Gargantext.Types (NodePath, SessionId(..), nodePath)
...@@ -127,13 +127,13 @@ tryCons s ss = try (lookup sid ss) where ...@@ -127,13 +127,13 @@ tryCons s ss = try (lookup sid ss) where
try Nothing = Right (cons s ss) try Nothing = Right (cons s ss)
try _ = Left unit try _ = Left unit
delete :: SessionId -> Sessions -> Sessions remove :: SessionId -> Sessions -> Sessions
delete sid (Sessions ss) = Sessions (Seq.filter f ss) where remove sid (Sessions ss) = Sessions (Seq.filter f ss) where
f s = sid /= sessionId s f s = sid /= sessionId s
tryDelete :: SessionId -> Sessions -> Either Unit Sessions tryRemove :: SessionId -> Sessions -> Either Unit Sessions
tryDelete sid old@(Sessions ss) = ret where tryRemove sid old@(Sessions ss) = ret where
new = delete sid old new = remove sid old
ret ret
| new == old = Left unit | new == old = Left unit
| otherwise = Right new | otherwise = Right new
...@@ -148,7 +148,7 @@ act ss (Login s) = ...@@ -148,7 +148,7 @@ act ss (Login s) =
Right new -> pure new Right new -> pure new
_ -> pure ss <* log2 "Cannot overwrite existing session: " (sessionId s) _ -> pure ss <* log2 "Cannot overwrite existing session: " (sessionId s)
act old@(Sessions ss) (Logout s) = act old@(Sessions ss) (Logout s) =
case tryDelete (sessionId s) old of case tryRemove (sessionId s) old of
Right new -> pure $ new Right new -> pure $ new
_ -> pure old <* log2 "Logged out of stale session:" (sessionId s) _ -> pure old <* log2 "Logged out of stale session:" (sessionId s)
...@@ -185,10 +185,30 @@ saveSessions sessions = effect *> pure sessions ...@@ -185,10 +185,30 @@ saveSessions sessions = effect *> pure sessions
postAuthRequest :: Backend -> AuthRequest -> Aff (Either String Session) postAuthRequest :: Backend -> AuthRequest -> Aff (Either String Session)
postAuthRequest backend ar@(AuthRequest {username}) = postAuthRequest backend ar@(AuthRequest {username}) =
decode <$> post (toUrl backend "auth") ar decode <$> REST.post Nothing (toUrl backend "auth") ar
where where
decode (AuthResponse ar2) decode (AuthResponse ar2)
| {inval: Just (AuthInvalid {message})} <- ar2 = Left message | {inval: Just (AuthInvalid {message})} <- ar2 = Left message
| {valid: Just (AuthData {token, tree_id})} <- ar2 = | {valid: Just (AuthData {token, tree_id})} <- ar2 =
Right $ Session { backend, username, token, treeId: tree_id } Right $ Session { backend, username, token, treeId: tree_id }
| otherwise = Left "Invalid response from server" | otherwise = Left "Invalid response from server"
get :: forall a p. DecodeJson a => ToUrl Session p => Session -> p -> Aff a
get session@(Session {token}) p = REST.get (Just token) (toUrl session p)
put :: forall a b p. EncodeJson a => DecodeJson b => ToUrl Session p => Session -> p -> a -> Aff b
put session@(Session {token}) p = REST.put (Just token) (toUrl session p)
delete :: forall a p. DecodeJson a => ToUrl Session p => Session -> p -> Aff a
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
deleteWithBody :: forall a b p. EncodeJson a => DecodeJson b => ToUrl Session p => Session -> p -> a -> Aff b
deleteWithBody session@(Session {token}) p = REST.deleteWithBody (Just token) (toUrl session p)
post :: forall a b p. EncodeJson a => DecodeJson b => ToUrl Session p => Session -> p -> a -> Aff b
post session@(Session {token}) p = REST.post (Just token) (toUrl session p)
postWwwUrlencoded :: forall b p. DecodeJson b => ToUrl Session p => Session -> p -> String -> Aff b
postWwwUrlencoded session@(Session {token}) p = REST.postWwwUrlencoded (Just token) (toUrl session p)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment