1  {-|
  2  Module      : Gargantext.API
  3  Description : REST API declaration
  4  Copyright   : (c) CNRS, 2017-Present
  5  License     : AGPL + CECILL v3
  6  Maintainer  : team@gargantext.org
  7  Stability   : experimental
  8  Portability : POSIX
  9  
 10  Main (RESTful) API of the instance Gargantext.
 11  
 12  The Garg-API is typed to derive the documentation, the mock and tests.
 13  
 14  This API is indeed typed in order to be able to derive both the server
 15  and the client sides.
 16  
 17  The Garg-API-Monad enables:
 18    - Security (WIP)
 19    - Features (WIP)
 20    - Database connection (long term)
 21    - In Memory stack management (short term)
 22    - Logs (WIP)
 23  
 24  Thanks to Yann Esposito for our discussions at the start and to Nicolas
 25  Pouillard (who mainly made it).
 26  
 27  -}
 28  
 29  {-# LANGUAGE BangPatterns         #-}
 30  {-# LANGUAGE NumericUnderscores   #-}
 31  {-# LANGUAGE ScopedTypeVariables  #-}
 32  {-# LANGUAGE TypeFamilies         #-}
 33  {-# LANGUAGE TypeOperators        #-}
 34  module Gargantext.API
 35        where
 36  
 37  import Control.Concurrent
 38  import Control.Lens hiding (Level)
 39  import Data.List (lookup)
 40  import Data.Text (pack)
 41  import Data.Text.Encoding qualified as TE
 42  import Data.Text.IO (putStrLn)
 43  import Data.Validity
 44  import Gargantext.API.Admin.Auth.Types (AuthContext)
 45  import Gargantext.API.Admin.EnvTypes (Env, Mode(..))
 46  import Gargantext.API.Admin.Settings (newEnv)
 47  import Gargantext.API.Admin.Settings.CORS
 48  import Gargantext.API.Admin.Types (FireWall(..), PortNumber, cookieSettings, jwtSettings, settings, corsSettings)
 49  import Gargantext.API.EKG
 50  import Gargantext.API.Middleware (logStdoutDevSanitised)
 51  import Gargantext.API.Routes
 52  import Gargantext.API.Server (server)
 53  import Gargantext.Database.Prelude qualified as DB
 54  import Gargantext.Prelude hiding (putStrLn)
 55  import Gargantext.System.Logging
 56  import Network.HTTP.Types hiding (Query)
 57  import Network.Wai
 58  import Network.Wai.Handler.Warp hiding (defaultSettings)
 59  import Network.Wai.Middleware.Cors
 60  import Network.Wai.Middleware.RequestLogger
 61  import Paths_gargantext (getDataDir)
 62  import Servant hiding (Header)
 63  import System.Cron.Schedule qualified as Cron
 64  import System.FilePath
 65  
 66  -- | startGargantext takes as parameters port number and Ini file.
 67  startGargantext :: Mode -> PortNumber -> FilePath -> IO ()
 68  startGargantext mode port file = withLoggerHoisted mode $ \logger -> do
 69    env <- newEnv logger port file
 70    runDbCheck env
 71    portRouteInfo port
 72    app <- makeApp env
 73    mid <- makeGargMiddleware (env ^. settings.corsSettings) mode
 74    periodicActions <- schedulePeriodicActions env
 75    run port (mid app) `finally` stopGargantext periodicActions
 76  
 77    where runDbCheck env = do
 78            r <- runExceptT (runReaderT DB.dbCheck env) `catch`
 79              (\(_ :: SomeException) -> pure $ Right False)
 80            case r of
 81              Right True -> pure ()
 82              _ -> panicTrace $
 83                "You must run 'gargantext-init " <> pack file <>
 84                "' before running gargantext-server (only the first time)."
 85  
 86  portRouteInfo :: PortNumber -> IO ()
 87  portRouteInfo port = do
 88    putStrLn   "=========================================================================================================="
 89    putStrLn   " GarganText Main Routes"
 90    putStrLn   "=========================================================================================================="
 91    putStrLn $ " - Web GarganText Frontend..................: " <> "http://localhost:" <> toUrlPiece port <> "/index.html"
 92    putStrLn $ " - Swagger UI (API documentation)...........: " <> "http://localhost:" <> toUrlPiece port <> "/swagger-ui"
 93    putStrLn $ " - Playground GraphQL (API documentation)...: " <> "http://localhost:" <> toUrlPiece port <> "/gql"
 94    putStrLn   "=========================================================================================================="
 95  
 96  -- | Stops the gargantext server and cancels all the periodic actions
 97  -- scheduled to run up to that point.
 98  -- TODO clean this Monad condition (more generic) ?
 99  stopGargantext :: [ThreadId] -> IO ()
100  stopGargantext scheduledPeriodicActions = do
101    forM_ scheduledPeriodicActions killThread
102    putStrLn "----- Stopping gargantext -----"
103  
104  -- | Schedules all sorts of useful periodic actions to be run while
105  -- the server is alive accepting requests.
106  schedulePeriodicActions :: DB.CmdCommon env => env -> IO [ThreadId]
107  schedulePeriodicActions _env =
108    -- Add your scheduled actions here.
109    let actions = [
110            -- refreshDBViews
111          ]
112    in foldlM (\ !acc action -> (`mappend` acc) <$> Cron.execSchedule action) [] actions
113  
114  {-
115    where
116  
117      refreshDBViews :: Cron.Schedule ()
118      refreshDBViews = do
119        let doRefresh = do
120              res <- DB.runCmd env (refreshNgramsMaterialized :: Cmd IOException ())
121              case res of
122                Left e   -> liftIO $ putStrLn $ pack ("Refreshing Ngrams materialized view failed: " <> displayException e)
123                Right () ->  do
124                  _ <- liftIO $ putStrLn $ pack "Refresh Index Database done"
125                  pure ()
126        Cron.addJob doRefresh "* 2 * * *"
127  -}
128  
129  ----------------------------------------------------------------------
130  
131  fireWall :: Applicative f => Request -> FireWall -> f Bool
132  fireWall req fw = do
133      let origin = lookup "Origin" (requestHeaders req)
134      let host   = lookup "Host"   (requestHeaders req)
135  
136      if  origin == Just (encodeUtf8 "http://localhost:8008")
137         && host == Just (encodeUtf8 "localhost:3000")
138         || (not $ unFireWall fw)
139  
140         then pure True
141         else pure False
142  
143  makeGargMiddleware :: CORSSettings -> Mode -> IO Middleware
144  makeGargMiddleware crsSettings mode = do
145      let corsMiddleware = cors $ \_incomingRq -> Just
146            simpleCorsResourcePolicy
147              { corsOrigins = Just (map mkCorsOrigin (crsSettings ^. corsAllowedOrigins), True)
148              , corsMethods = [ methodGet   , methodPost   , methodPut
149                              , methodDelete, methodOptions, methodHead]
150              , corsIgnoreFailures = False
151              , corsRequestHeaders = ["authorization", "content-type", "x-garg-error-scheme"]
152              , corsMaxAge         = Just ( 60*60*24 ) -- one day
153              }
154      case mode of
155        Prod -> pure $ logStdout . corsMiddleware
156        _    -> do
157          loggerMiddleware <- logStdoutDevSanitised
158          pure $ loggerMiddleware . corsMiddleware
159    where
160      mkCorsOrigin :: CORSOrigin -> Origin
161      mkCorsOrigin = TE.encodeUtf8 . _CORSOrigin
162  
163  ---------------------------------------------------------------------
164  -- | API Global
165  ---------------------------------------------------------------------
166  
167  makeApp :: Env -> IO Application
168  makeApp env = do
169    serv <- server env
170    (ekgStore, ekgMid) <- newEkgStore api
171    ekgDir <- (</> "ekg-assets") <$> getDataDir
172    pure $ ekgMid $ serveWithContext apiWithEkg cfg
173      (ekgServer ekgDir ekgStore :<|> serv)
174    where
175      cfg :: Servant.Context AuthContext
176      cfg = env ^. settings . jwtSettings
177         :. env ^. settings . cookieSettings
178         :. EmptyContext
179  
180  ---------------------------------------------------------------------
181  api :: Proxy API
182  api  = Proxy
183  
184  apiWithEkg :: Proxy (EkgAPI :<|> API)
185  apiWithEkg = Proxy
186  
187  apiGarg :: Proxy GargAPI
188  apiGarg  = Proxy
189  ---------------------------------------------------------------------