[SECURITY] newtype GargPassword with Show hidden.
[gargantext.git] / src / Gargantext / API.hs
index 780db034c659b65ddacc7b589d3e494f9f563c3e..6a07f4d853cc70ac4d52022a6e3f222e05469ac0 100644 (file)
@@ -7,29 +7,39 @@ Maintainer  : team@gargantext.org
 Stability   : experimental
 Portability : POSIX
 
-Main REST API of Gargantext (both Server and Client sides)
+Main (RESTful) API of the instance Gargantext.
 
-TODO App type, the main monad in which the bot code is written with.
+The Garg-API is typed to derive the documentation, the mock and tests.
+
+This API is indeed typed in order to be able to derive both the server
+and the client sides.
+
+The Garg-API-Monad enables:
+  - Security (WIP)
+  - Features (WIP)
+  - Database connection (long term)
+  - In Memory stack management (short term)
+  - Logs (WIP)
+
+Thanks to Yann Esposito for our discussions at the start and to Nicolas
+Pouillard (who mainly made it).
 
-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 ConstraintKinds      #-}
 {-# 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,80 +47,107 @@ Thanks @yannEsposito for this.
 module Gargantext.API
       where
 ---------------------------------------------------------------------
-import           Gargantext.Prelude
-
-import           System.IO (FilePath)
-
-import           GHC.Generics (D1, Meta (..), Rep)
-import           GHC.TypeLits (AppendSymbol, Symbol)
-
-import           Control.Lens
-import           Data.Aeson.Encode.Pretty (encodePretty)
+import Control.Exception (finally)
+import Control.Lens
+import Control.Monad.Except (withExceptT)
+import Control.Monad.Reader (runReaderT)
+import Data.Aeson.Encode.Pretty (encodePretty)
+import Data.List (lookup)
+import Data.Swagger
+import Data.Text (Text)
+import Data.Text.Encoding (encodeUtf8)
+import Data.Validity
+import Data.Version (showVersion)
+import GHC.Base (Applicative)
+import GHC.Generics (D1, Meta (..), Rep)
+import GHC.TypeLits (AppendSymbol, Symbol)
+import Gargantext.API.Admin.Auth (AuthContext, auth)
+import Gargantext.API.Admin.FrontEnd (frontEndServer)
+import Gargantext.API.Admin.Settings
+import Gargantext.API.Ngrams (HasRepoSaver(..), saveRepo)
+import Gargantext.API.Prelude
+import Gargantext.API.Routes
+import Gargantext.Prelude
+import Network.HTTP.Types hiding (Query)
+import Network.Wai
+import Network.Wai (Request, requestHeaders)
+import Network.Wai.Handler.Warp hiding (defaultSettings)
+import Network.Wai.Middleware.Cors
+import Network.Wai.Middleware.RequestLogger
+import Servant
+import Servant.Auth.Server (AuthResult(..))
+import Servant.Auth.Swagger ()
+import Servant.Swagger
+import Servant.Swagger.UI
+import System.IO (FilePath)
 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           Network.Wai
-import           Network.Wai.Handler.Warp hiding (defaultSettings)
-
-import           Servant
-import           Servant.Mock (mock)
---import           Servant.Job.Server (WithCallbacks)
-import           Servant.Swagger
-import           Servant.Swagger.UI
--- import Servant.API.Stream
-
---import Gargantext.API.Swagger
-import Gargantext.API.FrontEnd (FrontEndAPI, frontEndServer)
-
-import Gargantext.API.Node ( Roots    , roots
-                           , NodeAPI  , nodeAPI
-                           , NodesAPI , nodesAPI
-                           )
-import Gargantext.API.Count  ( CountAPI, count, Query)
-import Gargantext.API.Search ( SearchAPI, search, SearchQuery)
---import Gargantext.API.Orchestrator
---import Gargantext.API.Orchestrator.Types
+import qualified Data.Text.IO               as T
+import qualified Paths_gargantext           as PG -- cabal magic build module
 
----------------------------------------------------------------------
 
-import GHC.Base (Applicative)
--- import Control.Lens
+-- | startGargantext takes as parameters port number and Ini file.
+startGargantext :: PortNumber -> FilePath -> IO ()
+startGargantext port file = do
+  env <- newEnv port file
+  portRouteInfo port
+  app <- makeApp env
+  mid <- makeDevMiddleware
+  run port (mid app) `finally` stopGargantext env
 
-import Data.List (lookup)
-import Data.Text.Encoding (encodeUtf8)
+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"
 
---import Network.Wai (Request, requestHeaders, responseLBS)
-import Network.Wai (Request, requestHeaders)
---import qualified Network.Wai.Handler.Warp as Warp
-import Network.Wai.Middleware.Cors
+-- TODO clean this Monad condition (more generic) ?
+stopGargantext :: HasRepoSaver env => env -> IO ()
+stopGargantext env = do
+  T.putStrLn "----- Stopping gargantext -----"
+  runReaderT saveRepo env
 
-import Network.Wai.Middleware.RequestLogger
--- import qualified Network.Wai.Middleware.RequestLogger as RequestLogger
 
-import Network.HTTP.Types hiding (Query)
+-- | Output generated @swagger.json@ file for the @'TodoAPI'@.
+swaggerWriteJSON :: IO ()
+swaggerWriteJSON = BL8.writeFile "swagger.json" (encodePretty swaggerDoc)
+
+-- | Swagger Specifications
+swaggerDoc :: Swagger
+swaggerDoc = toSwagger (Proxy :: Proxy GargAPI)
+  & info.title       .~ "Gargantext"
+  & info.version     .~ (cs $ showVersion PG.version)
+  -- & 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)) 
+                 ["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"
 
+{-
+startGargantextMock :: PortNumber -> IO ()
+startGargantextMock port = do
+  portRouteInfo port
+  application <- makeMockApp . MockEnv $ FireWall False
+  run port application
+-}
 
-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
+    if  origin == Just (encodeUtf8 "http://localhost:8008")
+       && host == Just (encodeUtf8 "localhost:3000")
        || (not $ unFireWall fw)
-       
+
        then pure True
        else pure False
 
-
+{-
 -- makeMockApp :: Env -> IO (Warp.Settings, Application)
 makeMockApp :: MockEnv -> IO Application
 makeMockApp env = do
@@ -143,12 +180,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" }
@@ -158,7 +194,7 @@ makeDevApp env = 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 --  == /*
@@ -174,93 +210,74 @@ 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
-
--- | API for serving @swagger.json@
-type SwaggerAPI = SwaggerSchemaUI "swagger-ui" "swagger.json"
-
--- | API for serving main operational routes of @gargantext.org@
-type GargAPI =
-          
-           -- Roots endpoint
-                "user"  :> Summary "First user endpoint"
-                        :> Roots
-           
-           
-           -- Node endpoint
-           :<|> "node"  :> Summary "Node endpoint"
-                        :> Capture "id" Int      :> NodeAPI
-           
-           
-           -- Corpus endpoint
-           :<|> "corpus":> Summary "Corpus endpoint"
-                        :> Capture "id" Int      :> NodeAPI
-           
-           -- Corpus endpoint
-           :<|> "nodes" :> Summary "Nodes endpoint"
-                        :> ReqBody '[JSON] [Int] :> 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
-
-       --    :<|> "scraper" :> WithCallbacks ScraperAPI
-
--- /mv/<id>/<id>
--- /merge/<id>/<id>
--- /rename/<id>
-       -- :<|> "static"   
-       -- :<|> "list"     :> Capture "id" Int  :> NodeAPI
-       -- :<|> "ngrams"   :> Capture "id" Int  :> NodeAPI
-       -- :<|> "auth"     :> Capture "id" Int  :> NodeAPI
----------------------------------------------------------------------
-type SwaggerFrontAPI = SwaggerAPI :<|> FrontEndAPI 
-
-type API = SwaggerFrontAPI :<|> GargAPI
-
 ---------------------------------------------------------------------
--- | Server declaration
-server :: Env -> IO (Server API)
+-- | Server declarations
+server :: forall env. EnvC env => env -> IO (Server API)
 server env = do
   -- orchestrator <- scrapyOrchestrator env
-  pure $ swaggerFront
-     :<|> roots    conn
-     :<|> nodeAPI  conn
-     :<|> nodeAPI  conn
-     :<|> nodesAPI conn
-     :<|> count
-     :<|> search conn
+  pure $  schemaUiServer swaggerDoc
+     :<|> hoistServerWithContext 
+            (Proxy :: Proxy GargAPI)
+            (Proxy :: Proxy AuthContext)
+            transform
+            serverGargAPI
+     :<|> frontEndServer
+  where
+    transform :: forall a. GargServerM env GargError a -> Handler a
+    transform = Handler . withExceptT showAsServantErr . (`runReaderT` env)
+
+showAsServantErr :: GargError -> ServerError
+showAsServantErr (GargServerError err) = err
+showAsServantErr a = err500 { errBody = BL8.pack $ show a }
+
+---------------------------
+
+serverGargAPI :: GargServerT env err (GargServerM env err) GargAPI
+serverGargAPI -- orchestrator
+       =  auth
+     :<|> gargVersion
+     :<|> serverPrivateGargAPI
   --   :<|> orchestrator
   where
-    conn = env ^. env_conn
 
----------------------------------------------------------------------
-swaggerFront :: Server SwaggerFrontAPI
-swaggerFront = schemaUiServer swaggerDoc
-           :<|> frontEndServer
+    gargVersion :: GargServer GargVersion
+    gargVersion = pure (cs $ showVersion PG.version)
 
-gargMock :: Server GargAPI
-gargMock = mock apiGarg Proxy
+    serverPrivateGargAPI :: GargServerT env err (GargServerM env err) GargPrivateAPI
+    serverPrivateGargAPI (Authenticated auser) = serverPrivateGargAPI' auser
+    serverPrivateGargAPI _                     = throwAll' (_ServerError # err401)
+-- Here throwAll' requires a concrete type for the monad.
 
----------------------------------------------------------------------
-makeApp :: Env -> IO Application
-makeApp = fmap (serve api) . server
 
-appMock :: Application
-appMock = serve api (swaggerFront :<|> gargMock)
+-- TODO-SECURITY admin only: withAdmin
+-- Question: How do we mark admins?
+{-
+serverGargAdminAPI :: GargServer GargAdminAPI
+serverGargAdminAPI =  roots
+                 :<|> nodesAPI
+-}
 
+---------------------------------------------------------------------
+--gargMock :: Server GargAPI
+--gargMock = mock apiGarg Proxy
+---------------------------------------------------------------------
+makeApp :: EnvC env => env -> IO Application
+makeApp env = serveWithContext api cfg <$> server env
+  where
+    cfg :: Servant.Context AuthContext
+    cfg = env ^. settings . jwtSettings
+       :. env ^. settings . cookieSettings
+    -- :. authCheck env
+       :. EmptyContext
+
+--appMock :: Application
+--appMock = serve api (swaggerFront :<|> gargMock :<|> serverStatic)
 ---------------------------------------------------------------------
 api :: Proxy API
 api  = Proxy
@@ -268,12 +285,11 @@ api  = Proxy
 apiGarg :: Proxy GargAPI
 apiGarg  = Proxy
 ---------------------------------------------------------------------
-
 schemaUiServer :: (Server api ~ Handler Swagger)
         => Swagger -> Server (SwaggerSchemaUI' dir api)
 schemaUiServer = swaggerSchemaUIServer
 
-
+---------------------------------------------------------------------
 -- Type Family for the Documentation
 type family TypeName (x :: *) :: Symbol where
     TypeName Int  = "Int"
@@ -286,41 +302,3 @@ type family GenericTypeName t (r :: *) :: Symbol where
 type Desc t n = Description (AppendSymbol (TypeName t) (AppendSymbol " | " n))
 
 
--- | Swagger Specifications
-swaggerDoc :: Swagger
-swaggerDoc = toSwagger (Proxy :: Proxy GargAPI)
-  & info.title       .~ "Gargantext"
-  & info.version     .~ "0.1.0"
-  -- & 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"]
-  & info.license     ?~ ("AGPLV3 (English) and CECILL (French)" & url ?~ URL urlLicence )
-    where
-        urlLicence = "https://gitlab.iscpif.fr/gargantext/haskell-gargantext/blob/master/LICENSE"
-
--- | Output generated @swagger.json@ file for the @'TodoAPI'@.
-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"
-
--- | 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
-
-startGargantextMock :: PortNumber -> IO ()
-startGargantextMock port = do
-  portRouteInfo port
-  application <- makeMockApp . MockEnv $ FireWall False
-  run port application
-