[docker] update image, add README info
[gargantext.git] / src / Gargantext / API.hs
index 020645f2205864f426115168da62b2eb2a36a209..651795397a88dc97d3ebf4783657c22db6723b18 100644 (file)
@@ -47,80 +47,56 @@ Pouillard (who mainly made it).
 module Gargantext.API
       where
 ---------------------------------------------------------------------
-
-import           System.IO (FilePath)
-
-import           GHC.Generics (D1, Meta (..), Rep)
-import           GHC.TypeLits (AppendSymbol, Symbol)
-
-import           Control.Lens
-import           Control.Exception (finally)
-import           Control.Monad.Except (withExceptT, ExceptT)
-import           Control.Monad.IO.Class (liftIO)
-import           Control.Monad.Reader (ReaderT, runReaderT)
-import           Data.Aeson.Encode.Pretty (encodePretty)
-import qualified Data.ByteString.Lazy.Char8 as BL8
-import           Data.Swagger
-import           Data.Text (Text)
-import qualified Data.Text.IO as T
---import qualified Data.Set as Set
-import           Data.Validity
-
-import           Network.Wai
-import           Network.Wai.Handler.Warp hiding (defaultSettings)
-
-import           Servant
-import           Servant.Auth as SA
-import           Servant.Auth.Server (AuthResult(..))
-import           Servant.Auth.Swagger ()
---import           Servant.Mock (mock)
---import           Servant.Job.Server (WithCallbacks)
-import           Servant.Job.Async
-import           Servant.Swagger
-import           Servant.Swagger.UI
--- import Servant.API.Stream
-
---import Gargantext.API.Swagger
-
-import Gargantext.Database.Node.Contact (HyperdataContact)
+import Control.Concurrent (threadDelay)
+import Control.Exception (finally)
+import Control.Lens
+import Control.Monad.Except (withExceptT, ExceptT)
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.Reader (ReaderT, runReaderT)
+import Data.Aeson.Encode.Pretty (encodePretty)
+import Data.Swagger
+import Data.Text (Text)
+import Data.Validity
+import GHC.Generics (D1, Meta (..), Rep)
+import GHC.TypeLits (AppendSymbol, Symbol)
+import Network.Wai
+import Network.Wai.Handler.Warp hiding (defaultSettings)
+import Servant
+import Servant.Auth as SA
+import Servant.Auth.Server (AuthResult(..))
+import Servant.Auth.Swagger ()
+import Servant.Job.Async
+import Servant.Swagger
+import Servant.Swagger.UI
+import System.IO (FilePath)
+import Data.List (lookup)
+import Data.Text.Encoding (encodeUtf8)
+import GHC.Base (Applicative)
 import Gargantext.API.Auth (AuthRequest, AuthResponse, AuthenticatedUser(..), AuthContext, auth, withAccess, PathId(..))
 import Gargantext.API.Count  ( CountAPI, count, Query)
 import Gargantext.API.FrontEnd (FrontEndAPI, frontEndServer)
 import Gargantext.API.Ngrams (HasRepo(..), HasRepoSaver(..), saveRepo, TableNgramsApi, apiNgramsTableDoc)
 import Gargantext.API.Node
+import Gargantext.API.Orchestrator.Types
 import Gargantext.API.Search (SearchPairsAPI, searchPairs)
+import Gargantext.API.Settings
 import Gargantext.API.Types
-import qualified Gargantext.API.Annuaire as Annuaire
-import qualified Gargantext.API.Export as Export
-import qualified Gargantext.API.Corpus.New as New
+import Gargantext.Database.Node.Contact (HyperdataContact)
 import Gargantext.Database.Types.Node
 import Gargantext.Database.Types.Node (NodeId, CorpusId, AnnuaireId)
 import Gargantext.Database.Utils (HasConnection)
 import Gargantext.Prelude
 import Gargantext.Viz.Graph.API
-
---import Gargantext.API.Orchestrator
-import Gargantext.API.Orchestrator.Types
-
----------------------------------------------------------------------
-
-import GHC.Base (Applicative)
--- import Control.Lens
-
-import Data.List (lookup)
-import Data.Text.Encoding (encodeUtf8)
-
---import Network.Wai (Request, requestHeaders, responseLBS)
+import Network.HTTP.Types hiding (Query)
 import Network.Wai (Request, requestHeaders)
---import qualified Network.Wai.Handler.Warp as Warp
 import Network.Wai.Middleware.Cors
-
 import Network.Wai.Middleware.RequestLogger
--- import qualified Network.Wai.Middleware.RequestLogger as RequestLogger
-
-import Network.HTTP.Types hiding (Query)
-
-import Gargantext.API.Settings
+import qualified Data.ByteString.Lazy.Char8 as BL8
+import qualified Data.Text.IO               as T
+import qualified Gargantext.API.Annuaire    as Annuaire
+import qualified Gargantext.API.Corpus.New  as New
+import qualified Gargantext.API.Export      as Export
+import qualified Gargantext.API.Ngrams.List as List
 
 showAsServantErr :: GargError -> ServerError
 showAsServantErr (GargServerError err) = err
@@ -188,7 +164,7 @@ makeDevMiddleware = do
 --                True  -> app req resp
 --                False -> resp ( responseLBS status401 [] 
 --                              "Invalid Origin or Host header")
---        
+--
     let corsMiddleware = cors $ \_ -> Just CorsResourcePolicy
 --          { corsOrigins        = Just ([env^.settings.allowedOrigin], False)
             { corsOrigins        = Nothing --  == /*
@@ -204,7 +180,7 @@ makeDevMiddleware = do
 
     --let warpS = Warp.setPort (8008 :: Int)   -- (env^.settings.appPort)
     --          $ Warp.defaultSettings
-    
+
     --pure (warpS, logWare . checkOriginAndHost . corsMiddleware)
     pure $ logStdoutDev . corsMiddleware
 
@@ -232,7 +208,7 @@ type GargAPI' =
            -- auth and capabilities.
           :<|> GargPrivateAPI
 
-type GargPrivateAPI = SA.Auth '[SA.JWT] AuthenticatedUser :> GargPrivateAPI'
+type GargPrivateAPI = SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser :> GargPrivateAPI'
 
 type GargAdminAPI
               -- Roots endpoint
@@ -241,62 +217,77 @@ type GargAdminAPI
            :<|> "nodes" :> Summary "Nodes endpoint"
                         :> ReqBody '[JSON] [NodeId] :> NodesAPI
 
+----------------------------------------
+-- For Tests
+type WaitAPI = Get '[JSON] Text
+
+waitAPI ::  Int -> GargServer WaitAPI
+waitAPI n = do
+  let
+    m = (10 :: Int) ^ (6 :: Int)
+  _ <- liftIO $ threadDelay ( m * n)
+  pure $ "Waited: " <> (cs $ show n)
+----------------------------------------
+
+
 type GargPrivateAPI' =
                 GargAdminAPI
 
            -- Node endpoint
-           :<|> "node"  :> Summary "Node endpoint"
-                        :> Capture "node_id" NodeId
-                        :> NodeAPI HyperdataAny
+           :<|> "node"     :> Summary "Node endpoint"
+                           :> Capture "node_id" NodeId
+                           :> NodeAPI HyperdataAny
 
-           -- Corpus endpoint
-           :<|> "corpus":> Summary "Corpus endpoint"
-                        :> Capture "corpus_id" CorpusId
-                        :> NodeAPI HyperdataCorpus
+           -- Corpus endpoints
+           :<|> "corpus"   :> Summary "Corpus endpoint"
+                           :> Capture "corpus_id" CorpusId
+                           :> NodeAPI HyperdataCorpus
 
-           :<|> "corpus":> Summary "Corpus endpoint"
-                        :> Capture "node1_id" NodeId
-                        :> "document"
-                        :> Capture "node2_id" NodeId
-                        :> NodeNodeAPI HyperdataAny
+           :<|> "corpus"   :> Summary "Corpus endpoint"
+                           :> Capture "node1_id" NodeId
+                           :> "document"
+                           :> Capture "node2_id" NodeId
+                           :> NodeNodeAPI HyperdataAny
 
-           :<|> "corpus" :> Capture "node_id" CorpusId
-                         :> Export.API
+           :<|> "corpus"   :> Capture "node_id" CorpusId
+                           :> Export.API
 
            -- Annuaire endpoint
-           :<|> "annuaire":> Summary "Annuaire endpoint"
-                          :> Capture "annuaire_id" AnnuaireId
-                          :> NodeAPI HyperdataAnnuaire
+           :<|> "annuaire" :> Summary "Annuaire endpoint"
+                           :> Capture "annuaire_id" AnnuaireId
+                           :> NodeAPI HyperdataAnnuaire
 
            :<|> "annuaire" :> Summary "Contact endpoint"
                            :> Capture "annuaire_id" NodeId
-                           :> "contact" :> Capture "contact_id" NodeId
+                           :> "contact"
+                           :> Capture "contact_id" NodeId
                            :> NodeNodeAPI HyperdataContact
 
            -- Document endpoint
-           :<|> "document":> Summary "Document endpoint"
-                          :> Capture "doc_id" DocId
-                          :> "ngrams" :> TableNgramsApi
+           :<|> "document" :> Summary "Document endpoint"
+                           :> Capture "doc_id" DocId
+                           :> "ngrams" :> TableNgramsApi
 
         -- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI
             -- TODO-SECURITY
-           :<|> "count" :> Summary "Count endpoint"
-                        :> ReqBody '[JSON] Query :> CountAPI
+           :<|> "count"    :> Summary "Count endpoint"
+                           :> ReqBody '[JSON] Query
+                           :> CountAPI
 
            -- Corpus endpoint --> TODO rename s/search/filter/g
-           :<|> "search":> Capture "corpus" NodeId
-                        :> SearchPairsAPI
+           :<|> "search"   :> Capture "corpus" NodeId
+                           :> SearchPairsAPI
 
            -- TODO move to NodeAPI?
-           :<|> "graph" :> Summary "Graph endpoint"
-                        :> Capture "graph_id" NodeId
-                        :> GraphAPI
+           :<|> "graph"    :> Summary "Graph endpoint"
+                           :> Capture "graph_id" NodeId
+                           :> GraphAPI
 
            -- TODO move to NodeAPI?
            -- Tree endpoint
-           :<|> "tree" :> Summary "Tree endpoint"
-                       :> Capture "tree_id" NodeId
-                       :> TreeAPI
+           :<|> "tree"    :> Summary "Tree endpoint"
+                          :> Capture "tree_id" NodeId
+                          :> TreeAPI
 
            -- :<|> New.Upload
            :<|> New.AddWithForm
@@ -307,6 +298,14 @@ type GargPrivateAPI' =
        --  :<|> "scraper" :> WithCallbacks ScraperAPI
        --  :<|> "new"  :> New.Api
 
+           :<|> "lists"  :> Summary "List export API"
+                         :> Capture "listId" ListId
+                         :> List.API
+
+           :<|> "wait"   :> Summary "Wait test"
+                         :> Capture "x" Int
+                         :> WaitAPI -- Get '[JSON] Int
+
 -- /mv/<id>/<id>
 -- /merge/<id>/<id>
 -- /rename/<id>
@@ -357,9 +356,9 @@ serverPrivateGargAPI _                     = throwAll' (_ServerError # err401)
 -- TODO-SECURITY admin only: withAdmin
 -- Question: How do we mark admins?
 serverGargAdminAPI :: GargServer GargAdminAPI
-serverGargAdminAPI
-   =  roots
- :<|> nodesAPI
+serverGargAdminAPI =  roots
+                 :<|> nodesAPI
+
 
 serverPrivateGargAPI' :: AuthenticatedUser -> GargServer GargPrivateAPI'
 serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
@@ -393,6 +392,9 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
      :<|> addAnnuaireWithForm
      -- :<|> New.api  uid -- TODO-SECURITY
      -- :<|> New.info uid -- TODO-SECURITY
+     :<|> List.api
+     :<|> waitAPI
+
 
 {-
 addUpload :: GargServer New.Upload
@@ -470,7 +472,7 @@ type Desc t n = Description (AppendSymbol (TypeName t) (AppendSymbol " | " n))
 swaggerDoc :: Swagger
 swaggerDoc = toSwagger (Proxy :: Proxy GargAPI)
   & info.title       .~ "Gargantext"
-  & info.version     .~ "4.0.2" -- TODO same version as Gargantext
+  & info.version     .~ "0.0.1.3.1" -- TODO same version as Gargantext
   -- & info.base_url     ?~ (URL "http://gargantext.org/")
   & info.description ?~ "REST API specifications"
   -- & tags             .~ Set.fromList [Tag "Garg" (Just "Main perations") Nothing]
@@ -511,3 +513,6 @@ startGargantextMock port = do
   application <- makeMockApp . MockEnv $ FireWall False
   run port application
 -}
+
+
+