[FIX] Tree NodeTexts + DB.
[gargantext.git] / src / Gargantext / API.hs
index fb4acb403f88090f3993a50ffd01404d326c5bda..3c073c814878d84140bfa019bc29d2f040c4ee3e 100644 (file)
@@ -8,28 +8,23 @@ Stability   : experimental
 Portability : POSIX
 
 Main REST API of Gargantext (both Server and Client sides)
+Thanks @yannEsposito for our discussions at the beginning of this project :).
 
-TODO App type, the main monad in which the bot code is written with.
-
-Provide config, state, logs and IO
- type App m a =  ( MonadState AppState m
-                 , MonadReader Conf m
-                 , MonadLog (WithSeverity Doc) m
-                 , MonadIO m) => m a
-Thanks @yannEsposito for this.
 -}
 
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 
-
 {-# LANGUAGE NoImplicitPrelude    #-}
 {-# LANGUAGE DataKinds            #-}
 {-# LANGUAGE DeriveGeneric        #-}
+{-# LANGUAGE FlexibleContexts     #-}
 {-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE OverloadedStrings    #-}
 {-# LANGUAGE TemplateHaskell      #-}
 {-# LANGUAGE TypeOperators        #-}
 {-# LANGUAGE KindSignatures       #-}
+{-# LANGUAGE RankNTypes           #-}
+{-# LANGUAGE ScopedTypeVariables  #-}
 {-# LANGUAGE TypeFamilies         #-}
 {-# LANGUAGE UndecidableInstances #-}
 
@@ -37,7 +32,6 @@ Thanks @yannEsposito for this.
 module Gargantext.API
       where
 ---------------------------------------------------------------------
-import           Gargantext.Prelude
 
 import           System.IO (FilePath)
 
@@ -45,37 +39,52 @@ import           GHC.Generics (D1, Meta (..), Rep)
 import           GHC.TypeLits (AppendSymbol, Symbol)
 
 import           Control.Lens
-import           Data.Aeson (Value)
+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.Mock (mock)
+import           Servant.HTML.Blaze (HTML)
+--import           Servant.Mock (mock)
 --import           Servant.Job.Server (WithCallbacks)
+import           Servant.Static.TH.Internal.Server (fileTreeToServer)
+import           Servant.Static.TH.Internal.FileTree (fileTypeToFileTree, FileType(FileTypeFile))
 import           Servant.Swagger
 import           Servant.Swagger.UI
 -- import Servant.API.Stream
+import           Text.Blaze.Html (Html)
 
 --import Gargantext.API.Swagger
-import Gargantext.API.FrontEnd (FrontEndAPI, frontEndServer)
 
-import Gargantext.API.Node ( Roots    , roots
-                           , NodeAPI  , nodeAPI
-                           , NodesAPI , nodesAPI
-                           , GraphAPI , graphAPI
-                           , TreeAPI  , treeAPI
-                           , HyperdataCorpus
-                           )
-import Gargantext.Database.Types.Node ()
+--import Gargantext.Database.Node.Contact (HyperdataContact)
+import Gargantext.API.Auth (AuthRequest, AuthResponse, auth)
 import Gargantext.API.Count  ( CountAPI, count, Query)
-import Gargantext.API.Search ( SearchAPI, search, SearchQuery)
+import Gargantext.API.FrontEnd (FrontEndAPI, frontEndServer)
+import Gargantext.API.Ngrams (HasRepo(..), HasRepoSaver(..), saveRepo, TableNgramsApi, apiNgramsTableDoc)
+import Gargantext.API.Node
+import Gargantext.API.Search (SearchPairsAPI, searchPairs)
+import Gargantext.API.Types
+import qualified Gargantext.API.Corpus.New as New
+import Gargantext.Core.Types (HasInvalidError(..))
+import Gargantext.Database.Schema.Node (HasNodeError(..), NodeError)
+import Gargantext.Database.Tree (HasTreeError(..), TreeError)
+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
 
@@ -100,6 +109,26 @@ import Network.HTTP.Types hiding (Query)
 
 import Gargantext.API.Settings
 
+data GargError
+  = GargNodeError NodeError
+  | GargTreeError TreeError
+  | GargInvalidError Validation
+  deriving (Show)
+
+makePrisms ''GargError
+
+instance HasNodeError GargError where
+  _NodeError = _GargNodeError
+
+instance HasInvalidError GargError where
+  _InvalidError = _GargInvalidError
+
+instance HasTreeError GargError where
+  _TreeError = _GargTreeError
+
+showAsServantErr :: Show a => a -> ServantErr
+showAsServantErr a = err500 { errBody = BL8.pack $ show a }
+
 fireWall :: Applicative f => Request -> FireWall -> f Bool
 fireWall req fw = do
     let origin = lookup "Origin" (requestHeaders req)
@@ -115,7 +144,7 @@ fireWall req fw = do
        then pure True
        else pure False
 
-
+{-
 -- makeMockApp :: Env -> IO (Warp.Settings, Application)
 makeMockApp :: MockEnv -> IO Application
 makeMockApp env = do
@@ -148,12 +177,11 @@ makeMockApp env = do
     
     --pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp)
     pure $ logStdoutDev $ checkOriginAndHost $ corsMiddleware $ serverApp
+-}
 
 
---
-makeDevApp :: Env -> IO Application
-makeDevApp env = do
-    serverApp <- makeApp env
+makeDevMiddleware :: IO Middleware
+makeDevMiddleware = do
 
     -- logWare <- mkRequestLogger def { destination = RequestLogger.Logger $ env^.logger }
     --logWare <- mkRequestLogger def { destination = RequestLogger.Logger "/tmp/logs.txt" }
@@ -180,10 +208,8 @@ makeDevApp env = do
     --let warpS = Warp.setPort (8008 :: Int)   -- (env^.settings.appPort)
     --          $ Warp.defaultSettings
     
-    --pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp)
-    pure $ logStdoutDev $ corsMiddleware $ serverApp
-
---
+    --pure (warpS, logWare . checkOriginAndHost . corsMiddleware)
+    pure $ logStdoutDev . corsMiddleware
 
 ---------------------------------------------------------------------
 -- | API Global
@@ -201,37 +227,53 @@ type GargAPI = "api" :> Summary "API " :> GargAPIVersion
 type GargAPIVersion = "v1.0" :> Summary "v1.0: " :> GargAPI'
 
 type GargAPI' =
+           -- Auth endpoint
+                "auth"  :> Summary "AUTH API"
+                        :> ReqBody '[JSON] AuthRequest
+                        :> Post    '[JSON] AuthResponse
           
            -- Roots endpoint
-                "user"  :> Summary "First user endpoint"
+          :<|>  "user"  :> Summary "First user endpoint"
                         :> Roots
            
            -- Node endpoint
            :<|> "node"  :> Summary "Node endpoint"
-                        :> Capture "id" Int      :> NodeAPI Value
+                        :> Capture "id" NodeId      :> NodeAPI HyperdataAny
            
            -- Corpus endpoint
            :<|> "corpus":> Summary "Corpus endpoint"
-                        :> Capture "id" Int      :> NodeAPI HyperdataCorpus
+                        :> Capture "id" CorpusId      :> NodeAPI HyperdataCorpus
+
+           -- Annuaire endpoint
+           :<|> "annuaire":> Summary "Annuaire endpoint"
+                          :> Capture "id" AnnuaireId      :> NodeAPI HyperdataAnnuaire
+
+           -- Document endpoint
+           :<|> "document":> Summary "Document endpoint"
+                          :> Capture "id" DocId    :> "ngrams" :> TableNgramsApi
+                          
            -- Corpus endpoint
            :<|> "nodes" :> Summary "Nodes endpoint"
-                        :> ReqBody '[JSON] [Int] :> NodesAPI
+                        :> ReqBody '[JSON] [NodeId] :> NodesAPI
        
         -- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI
            -- Corpus endpoint
            :<|> "count" :> Summary "Count endpoint"
                         :> ReqBody '[JSON] Query :> CountAPI
            
-           -- Corpus endpoint
-           :<|> "search":> Summary "Search endpoint"
-                        :> ReqBody '[JSON] SearchQuery :> SearchAPI
-           
+           -- Corpus endpoint --> TODO rename s/search/filter/g
+           :<|> "search":> Capture "corpus" NodeId :> SearchPairsAPI
+
+           -- TODO move to NodeAPI?
            :<|> "graph" :> Summary "Graph endpoint"
-                        :> Capture "id" Int         :> GraphAPI
-           
+                        :> Capture "id" NodeId       :> GraphAPI
+
+           -- TODO move to NodeAPI?
            -- Tree endpoint
            :<|> "tree" :> Summary "Tree endpoint"
-                       :> Capture "id" Int          :> TreeAPI
+                       :> Capture "id" NodeId        :> TreeAPI
+
+           :<|> "new"  :> New.Api
 
 
        --    :<|> "scraper" :> WithCallbacks ScraperAPI
@@ -239,47 +281,70 @@ type GargAPI' =
 -- /mv/<id>/<id>
 -- /merge/<id>/<id>
 -- /rename/<id>
-       -- :<|> "static"   
+       -- :<|> "static"
        -- :<|> "list"     :> Capture "id" Int  :> NodeAPI
        -- :<|> "ngrams"   :> Capture "id" Int  :> NodeAPI
        -- :<|> "auth"     :> Capture "id" Int  :> NodeAPI
 ---------------------------------------------------------------------
-type SwaggerFrontAPI = SwaggerAPI :<|> FrontEndAPI 
+type SwaggerFrontAPI = SwaggerAPI :<|> FrontEndAPI
 
-type API = SwaggerFrontAPI :<|> GargAPI
+type API = SwaggerFrontAPI :<|> GargAPI :<|> Get '[HTML] Html
 
 ---------------------------------------------------------------------
--- | Server declaration
-server :: Env -> IO (Server API)
+-- | Server declarations
+
+server :: forall env. (HasConnection env, HasRepo env, HasSettings env)
+       => env -> IO (Server API)
 server env = do
   -- orchestrator <- scrapyOrchestrator env
-  pure $ swaggerFront
-     :<|> roots    conn
-     :<|> nodeAPI  conn (Proxy :: Proxy Value)
-     :<|> nodeAPI  conn (Proxy :: Proxy HyperdataCorpus)
-     :<|> nodesAPI conn
+  pure $  swaggerFront
+     :<|> hoistServer (Proxy :: Proxy GargAPI) transform serverGargAPI
+     :<|> serverStatic
+  where
+    transform :: forall a. ReaderT env (ExceptT GargError IO) a -> Handler a
+    transform = Handler . withExceptT showAsServantErr . (`runReaderT` env)
+
+serverGargAPI :: GargServer GargAPI
+serverGargAPI -- orchestrator
+       =  auth
+     :<|> roots
+     :<|> nodeAPI  (Proxy :: Proxy HyperdataAny)      fakeUserId
+     :<|> nodeAPI  (Proxy :: Proxy HyperdataCorpus)   fakeUserId
+     :<|> nodeAPI  (Proxy :: Proxy HyperdataAnnuaire) fakeUserId
+     :<|> apiNgramsTableDoc
+     :<|> nodesAPI
      :<|> count -- TODO: undefined
-     :<|> search   conn
-     :<|> graphAPI conn -- TODO: mock
-     :<|> treeAPI  conn
+     :<|> searchPairs -- TODO: move elsewhere
+     :<|> graphAPI -- TODO: mock
+     :<|> treeAPI
+     :<|> New.api
+     :<|> New.info fakeUserId
   --   :<|> orchestrator
   where
-    conn = env ^. env_conn
+    fakeUserId = 2 -- TODO, byDefault user1 (if users automatically generated with inserUsersDemo)
+
+serverStatic :: Server (Get '[HTML] Html)
+serverStatic = $(do
+                let path = "purescript-gargantext/dist/index.html"
+                Just s <- liftIO (fileTypeToFileTree (FileTypeFile path))
+                fileTreeToServer s
+                )
 
 ---------------------------------------------------------------------
 swaggerFront :: Server SwaggerFrontAPI
 swaggerFront = schemaUiServer swaggerDoc
            :<|> frontEndServer
 
-gargMock :: Server GargAPI
-gargMock = mock apiGarg Proxy
+--gargMock :: Server GargAPI
+--gargMock = mock apiGarg Proxy
 
 ---------------------------------------------------------------------
-makeApp :: Env -> IO Application
+makeApp :: (HasConnection env, HasRepo env, HasSettings env)
+        => env -> IO Application
 makeApp = fmap (serve api) . server
 
-appMock :: Application
-appMock = serve api (swaggerFront :<|> gargMock)
+--appMock :: Application
+--appMock = serve api (swaggerFront :<|> gargMock :<|> serverStatic)
 
 ---------------------------------------------------------------------
 api :: Proxy API
@@ -310,7 +375,7 @@ type Desc t n = Description (AppendSymbol (TypeName t) (AppendSymbol " | " n))
 swaggerDoc :: Swagger
 swaggerDoc = toSwagger (Proxy :: Proxy GargAPI)
   & info.title       .~ "Gargantext"
-  & info.version     .~ "0.1.0"
+  & info.version     .~ "4.0.2" -- 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]
@@ -330,17 +395,28 @@ portRouteInfo port = do
   T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/index.html"
   T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/swagger-ui"
 
+stopGargantext :: HasRepoSaver env => env -> IO ()
+stopGargantext env = do
+  T.putStrLn "----- Stopping gargantext -----"
+  runReaderT saveRepo env
+
 -- | startGargantext takes as parameters port number and Ini file.
 startGargantext :: PortNumber -> FilePath -> IO ()
 startGargantext port file = do
   env <- newEnv port file
   portRouteInfo port
-  app <- makeDevApp env
-  run port app
+  app <- makeApp env
+  mid <- makeDevMiddleware
+  run port (mid app) `finally` stopGargantext env
 
+{-
 startGargantextMock :: PortNumber -> IO ()
 startGargantextMock port = do
   portRouteInfo port
   application <- makeMockApp . MockEnv $ FireWall False
   run port application
+-}
+
+
+