src/Gargantext/API/Server.hs

   1 {-|
   2 Module      : Gargantext.API.Server
   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
  11 {-# LANGUAGE ScopedTypeVariables  #-}
  12
  13 ---------------------------------------------------------------------
  14 module Gargantext.API.Server where
  15 ---------------------------------------------------------------------
  16 import Control.Lens ((^.))
  17 import Control.Monad.Except (withExceptT)
  18 import Control.Monad.Reader (runReaderT)
  19 import Data.Text (Text)
  20 import Data.Version (showVersion)
  21 import Servant
  22 import Servant.Swagger.UI (swaggerSchemaUIServer)
  23 import qualified Data.ByteString.Lazy.Char8 as BL8
  24 import qualified Paths_gargantext           as PG -- cabal magic build module
  25
  26 import qualified Gargantext.API.Public      as Public
  27
  28 import Gargantext.API.Admin.Auth (AuthContext, auth)
  29 import Gargantext.API.Admin.FrontEnd (frontEndServer)
  30 import Gargantext.API.Prelude
  31 import Gargantext.API.Routes
  32 import Gargantext.API.Swagger (swaggerDoc)
  33 import Gargantext.API.ThrowAll (serverPrivateGargAPI)
  34 import Gargantext.Prelude
  35 import Gargantext.Prelude.Config (gc_url_backend_api)
  36 import Gargantext.Database.Prelude (config)
  37
  38
  39 serverGargAPI :: Text -> GargServerM env err GargAPI
  40 serverGargAPI baseUrl -- orchestrator
  41        =  auth
  42      :<|> gargVersion
  43      :<|> serverPrivateGargAPI
  44      :<|> Public.api baseUrl
  45
  46   --   :<|> orchestrator
  47   where
  48     gargVersion :: GargServer GargVersion
  49     gargVersion = pure (cs $ showVersion PG.version)
  50
  51 -- | Server declarations
  52 server :: forall env. EnvC env => env -> IO (Server API)
  53 server env = do
  54   -- orchestrator <- scrapyOrchestrator env
  55   pure $  swaggerSchemaUIServer swaggerDoc
  56      :<|> hoistServerWithContext
  57             (Proxy :: Proxy GargAPI)
  58             (Proxy :: Proxy AuthContext)
  59             transform
  60             (serverGargAPI (env ^. config . gc_url_backend_api))
  61      :<|> frontEndServer
  62   where
  63     transform :: forall a. GargM env GargError a -> Handler a
  64     transform = Handler . withExceptT showAsServantErr . (`runReaderT` env)
  65
  66
  67 showAsServantErr :: GargError -> ServerError
  68 showAsServantErr (GargServerError err) = err
  69 showAsServantErr a = err500 { errBody = BL8.pack $ show a }