Merge branch 'dev-phylo' of https://gitlab.iscpif.fr/gargantext/haskell-gargantext...
[gargantext.git] / src / Gargantext / API.hs
index acbcca832d614fcff9e958693ecc64247ae375a2..b276448072e062d0057e72bc76933a28827bb5fb 100644 (file)
@@ -1,6 +1,6 @@
 {-|
 Module      : Gargantext.API
-Description : Server API
+Description : REST API declaration
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
 Maintainer  : team@gargantext.org
@@ -10,6 +10,7 @@ Portability : POSIX
 Main REST API of Gargantext (both Server and Client sides)
 
 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
@@ -20,108 +21,293 @@ Thanks @yannEsposito for this.
 
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 
-{-# LANGUAGE DataKinds                   #-}
-{-# LANGUAGE DeriveGeneric               #-}
-{-# LANGUAGE FlexibleInstances           #-}
-{-# LANGUAGE OverloadedStrings           #-}
-{-# LANGUAGE TemplateHaskell             #-}
-{-# LANGUAGE TypeOperators               #-}
-{-# LANGUAGE KindSignatures              #-}
-{-# LANGUAGE TypeFamilies                #-}
-{-# LANGUAGE UndecidableInstances        #-}
+{-# LANGUAGE NoImplicitPrelude    #-}
+{-# LANGUAGE DataKinds            #-}
+{-# LANGUAGE DeriveGeneric        #-}
+{-# LANGUAGE FlexibleContexts     #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# LANGUAGE TemplateHaskell      #-}
+{-# LANGUAGE TypeOperators        #-}
+{-# LANGUAGE KindSignatures       #-}
+{-# LANGUAGE TypeFamilies         #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 ---------------------------------------------------------------------
 module Gargantext.API
       where
 ---------------------------------------------------------------------
-import           Gargantext.Prelude
 
-import           System.IO (FilePath, print)
+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.IO.Class (liftIO)
+import           Control.Monad.Reader (runReaderT)
 import           Data.Aeson.Encode.Pretty (encodePretty)
 import qualified Data.ByteString.Lazy.Char8 as BL8
 import           Data.Swagger
-import           Data.Text (Text, pack)
+import           Data.Text (Text)
+import qualified Data.Text.IO as T
 --import qualified Data.Set as Set
 
-import           Database.PostgreSQL.Simple (Connection, connect)
-
 import           Network.Wai
-import           Network.Wai.Handler.Warp
+import           Network.Wai.Handler.Warp hiding (defaultSettings)
 
 import           Servant
+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.Static.TH (createApiAndServerDecs)
 -- import Servant.API.Stream
+import           Text.Blaze.Html (Html)
+
+--import Gargantext.API.Swagger
+import Gargantext.Prelude
+import Gargantext.API.FrontEnd (FrontEndAPI, frontEndServer)
 
-import Gargantext.API.Node ( Roots    , roots
+import Gargantext.API.Auth (AuthRequest, AuthResponse, auth)
+import Gargantext.API.Ngrams (HasRepoVar(..), HasRepoSaver(..), saveRepo)
+import Gargantext.API.Node ( GargServer
+                           , Roots    , roots
                            , NodeAPI  , nodeAPI
                            , NodesAPI , nodesAPI
+                           , GraphAPI , graphAPI
+                           , TreeAPI  , treeAPI
+                           , HyperdataAny
+                           , HyperdataCorpus
+                           , HyperdataAnnuaire
                            )
-import Gargantext.API.Count ( CountAPI, count, Query)
-import Gargantext.Database.Utils (databaseParameters)
+--import Gargantext.Database.Node.Contact (HyperdataContact)
+import Gargantext.Database.Utils (HasConnection)
+import Gargantext.Database.Types.Node (NodeId, CorpusId, AnnuaireId)
+import Gargantext.API.Count  ( CountAPI, count, Query)
+import Gargantext.API.Search ( SearchAPI, search, SearchQuery)
+import Gargantext.Database.Facet
+
+--import Gargantext.API.Orchestrator
+--import Gargantext.API.Orchestrator.Types
 
 ---------------------------------------------------------------------
----------------------------------------------------------------------
-type PortNumber = Int
+
+import GHC.Base (Applicative)
+-- import Control.Lens
+
+import Data.List (lookup)
+import Data.Text.Encoding (encodeUtf8)
+
+--import Network.Wai (Request, requestHeaders, responseLBS)
+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
+
+fireWall :: Applicative f => Request -> FireWall -> f Bool
+fireWall req fw = do
+    let origin = lookup "Origin" (requestHeaders req)
+    let host   = lookup "Host"   (requestHeaders req)
+
+    let hostOk   = Just (encodeUtf8 "localhost:3000")
+    let originOk = Just (encodeUtf8 "http://localhost:8008")
+
+    if  origin == originOk
+       && host == hostOk
+       || (not $ unFireWall fw)
+       
+       then pure True
+       else pure False
+
+
+-- makeMockApp :: Env -> IO (Warp.Settings, Application)
+makeMockApp :: MockEnv -> IO Application
+makeMockApp env = do
+    let serverApp = appMock
+
+    -- logWare <- mkRequestLogger def { destination = RequestLogger.Logger $ env^.logger }
+    --logWare <- mkRequestLogger def { destination = RequestLogger.Logger "/tmp/logs.txt" }
+    let checkOriginAndHost app req resp = do
+            blocking <- fireWall req (env ^. menv_firewall)
+            case blocking  of
+                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 --  == /*
+            , corsMethods        = [ methodGet   , methodPost   , methodPut
+                                   , methodDelete, methodOptions, methodHead]
+            , corsRequestHeaders = ["authorization", "content-type"]
+            , corsExposedHeaders = Nothing
+            , corsMaxAge         = Just ( 60*60*24 ) -- one day
+            , corsVaryOrigin     = False
+            , corsRequireOrigin  = False
+            , corsIgnoreFailures = False
+            }
+
+    --let warpS = Warp.setPort (8008 :: Int)   -- (env^.settings.appPort)
+    --          $ Warp.defaultSettings
+    
+    --pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp)
+    pure $ logStdoutDev $ checkOriginAndHost $ corsMiddleware $ serverApp
+
+
+
+makeDevMiddleware :: IO Middleware
+makeDevMiddleware = do
+
+    -- logWare <- mkRequestLogger def { destination = RequestLogger.Logger $ env^.logger }
+    --logWare <- mkRequestLogger def { destination = RequestLogger.Logger "/tmp/logs.txt" }
+--    let checkOriginAndHost app req resp = do
+--            blocking <- fireWall req (env ^. menv_firewall)
+--            case blocking  of
+--                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 --  == /*
+            , corsMethods        = [ methodGet   , methodPost   , methodPut
+                                   , methodDelete, methodOptions, methodHead]
+            , corsRequestHeaders = ["authorization", "content-type"]
+            , corsExposedHeaders = Nothing
+            , corsMaxAge         = Just ( 60*60*24 ) -- one day
+            , corsVaryOrigin     = False
+            , corsRequireOrigin  = False
+            , corsIgnoreFailures = False
+            }
+
+    --let warpS = Warp.setPort (8008 :: Int)   -- (env^.settings.appPort)
+    --          $ Warp.defaultSettings
+    
+    --pure (warpS, logWare . checkOriginAndHost . corsMiddleware)
+    pure $ logStdoutDev . corsMiddleware
+
 ---------------------------------------------------------------------
 -- | API Global
 
-
 -- | API for serving @swagger.json@
--- TODO Do we need to add this in the API ?
--- type SwaggerAPI = "swagger.json" :> Get '[JSON] Swagger
-
 type SwaggerAPI = SwaggerSchemaUI "swagger-ui" "swagger.json"
 
-
 -- | API for serving main operational routes of @gargantext.org@
-type GargAPI =  "user"  :> Summary "First user endpoint" 
+
+
+type GargAPI = "api" :> Summary "API " :> GargAPIVersion
+-- | TODO          :<|> Summary "Latest API" :> GargAPI'
+
+
+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"
                         :> Roots
-       
+           
+           -- Node endpoint
            :<|> "node"  :> Summary "Node endpoint"
-                        :> Capture "id" Int      :> NodeAPI
+                        :> Capture "id" NodeId      :> NodeAPI HyperdataAny
            
+           -- Corpus endpoint
            :<|> "corpus":> Summary "Corpus endpoint"
-                        :> Capture "id" Int      :> NodeAPI
+                        :> Capture "id" CorpusId      :> NodeAPI HyperdataCorpus
 
+           -- Annuaire endpoint
+           :<|> "annuaire":> Summary "Annuaire endpoint"
+                          :> Capture "id" AnnuaireId      :> NodeAPI HyperdataAnnuaire
+
+           -- Corpus endpoint
            :<|> "nodes" :> Summary "Nodes endpoint"
-                        :> ReqBody '[JSON] [Int] :> NodesAPI
+                        :> ReqBody '[JSON] [NodeId] :> NodesAPI
        
-       -- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI
+        -- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI
+           -- Corpus endpoint
            :<|> "count" :> Summary "Count endpoint"
-                        :> ReqBody '[JSON] Query :> CountAPI 
+                        :> ReqBody '[JSON] Query :> CountAPI
+           
+           -- Corpus endpoint
+           :<|> "search":> Summary "Search endpoint"
+                        :> ReqBody '[JSON] SearchQuery 
+                        :> QueryParam "offset" Int
+                        :> QueryParam "limit"  Int
+                        :> QueryParam "order"  OrderBy
+                        :> SearchAPI
+
+           -- TODO move to NodeAPI?
+           :<|> "graph" :> Summary "Graph endpoint"
+                        :> Capture "id" NodeId       :> GraphAPI
+
+           -- TODO move to NodeAPI?
+           -- Tree endpoint
+           :<|> "tree" :> Summary "Tree endpoint"
+                       :> Capture "id" NodeId        :> TreeAPI
+
+
+       --    :<|> "scraper" :> WithCallbacks ScraperAPI
 
 -- /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
 ---------------------------------------------------------------------
--- | Serve front end files
-$(createApiAndServerDecs "FrontEndAPI" "frontEndServer" "frontEnd")
+type SwaggerFrontAPI = SwaggerAPI :<|> FrontEndAPI
 
-type SwaggerFrontAPI = SwaggerAPI :<|> FrontEndAPI 
-
-type API = SwaggerFrontAPI :<|> GargAPI
+type API = SwaggerFrontAPI :<|> GargAPI :<|> Get '[HTML] Html
 
 ---------------------------------------------------------------------
--- | Server declaration
-server :: Connection -> Server API
-server conn = swaggerFront
-          :<|> roots    conn
-          :<|> nodeAPI  conn
-          :<|> nodeAPI  conn
-          :<|> nodesAPI conn
-          :<|> count
+-- | Server declarations
+
+server :: (HasConnection env, HasRepoVar env, HasRepoSaver env)
+       => env -> IO (Server API)
+server env = do
+  -- orchestrator <- scrapyOrchestrator env
+  pure $  swaggerFront
+     :<|> hoistServer (Proxy :: Proxy GargAPI) (`runReaderT` env) serverGargAPI
+     :<|> serverStatic
+
+serverGargAPI :: GargServer GargAPI
+serverGargAPI -- orchestrator
+       =  auth
+     :<|> roots
+     :<|> nodeAPI  (Proxy :: Proxy HyperdataAny)      fakeUserId
+     :<|> nodeAPI  (Proxy :: Proxy HyperdataCorpus)   fakeUserId
+     :<|> nodeAPI  (Proxy :: Proxy HyperdataAnnuaire) fakeUserId
+     :<|> nodesAPI
+     :<|> count -- TODO: undefined
+     :<|> search
+     :<|> graphAPI -- TODO: mock
+     :<|> treeAPI
+  --   :<|> orchestrator
+  where
+    fakeUserId = 1 -- TODO
+
+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
@@ -132,11 +318,12 @@ gargMock :: Server GargAPI
 gargMock = mock apiGarg Proxy
 
 ---------------------------------------------------------------------
-app :: Connection -> Application
-app  = serve api . server
+makeApp :: (HasConnection env, HasRepoVar env, HasRepoSaver env) 
+        => env -> IO Application
+makeApp = fmap (serve api) . server
 
 appMock :: Application
-appMock = serve api (swaggerFront :<|> gargMock)
+appMock = serve api (swaggerFront :<|> gargMock :<|> serverStatic)
 
 ---------------------------------------------------------------------
 api :: Proxy API
@@ -151,7 +338,7 @@ schemaUiServer :: (Server api ~ Handler Swagger)
 schemaUiServer = swaggerSchemaUIServer
 
 
--- Type Familiy for the Documentation
+-- Type Family for the Documentation
 type family TypeName (x :: *) :: Symbol where
     TypeName Int  = "Int"
     TypeName Text = "Text"
@@ -167,12 +354,12 @@ 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]
   & applyTagsFor (subOperations (Proxy :: Proxy GargAPI)(Proxy :: Proxy GargAPI)) 
-                 ["Garg" & description ?~ "Main operations"]
+                 ["Gargantext" & description ?~ "Main operations"]
   & info.license     ?~ ("AGPLV3 (English) and CECILL (French)" & url ?~ URL urlLicence )
     where
         urlLicence = "https://gitlab.iscpif.fr/gargantext/haskell-gargantext/blob/master/LICENSE"
@@ -181,25 +368,29 @@ swaggerDoc = toSwagger (Proxy :: Proxy GargAPI)
 swaggerWriteJSON :: IO ()
 swaggerWriteJSON = BL8.writeFile "swagger.json" (encodePretty swaggerDoc)
 
+portRouteInfo :: PortNumber -> IO ()
+portRouteInfo port = do
+  T.putStrLn "      ----Main Routes-----      "
+  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
-  print ("Starting Gargantext server" <> show port)
-  print ("http://localhost:" <> show port)
-  param <- databaseParameters file
-  conn  <- connect param
-  run port (app conn)
+  env <- newEnv port file
+  portRouteInfo port
+  app <- makeApp env
+  mid <- makeDevMiddleware
+  run port (mid app) `finally` stopGargantext env
 
 startGargantextMock :: PortNumber -> IO ()
 startGargantextMock port = do
-  print (pack "Starting Mock server")
-  print (pack $ "curl "
-        <> "-H \"content-type: application/json"
-        <> "-d \'{\"query_query\":\"query\"}\'  "
-        <> "-v  http://localhost:" 
-        <> show port 
-        <>"/count"
-         )
-  run port appMock
+  portRouteInfo port
+  application <- makeMockApp . MockEnv $ FireWall False
+  run port application