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.Types (AuthContext)
  29 import Gargantext.API.Admin.Auth (auth)
  30 import Gargantext.API.Admin.FrontEnd (frontEndServer)
  31 import Gargantext.API.Prelude
  32 import Gargantext.API.Routes
  33 import Gargantext.API.Swagger (swaggerDoc)
  34 import Gargantext.API.ThrowAll (serverPrivateGargAPI)
  35 import Gargantext.Prelude
  36 import Gargantext.Prelude.Config (gc_url_backend_api)
  37 import Gargantext.Database.Prelude (hasConfig)
  38
  39
  40 serverGargAPI :: Text -> GargServerM env err GargAPI
  41 serverGargAPI baseUrl -- orchestrator
  42        =  auth
  43      :<|> gargVersion
  44      :<|> serverPrivateGargAPI
  45      :<|> Public.api baseUrl
  46
  47   --   :<|> orchestrator
  48   where
  49     gargVersion :: GargServer GargVersion
  50     gargVersion = pure (cs $ showVersion PG.version)
  51
  52 -- | Server declarations
  53 server :: forall env. EnvC env => env -> IO (Server API)
  54 server env = do
  55   -- orchestrator <- scrapyOrchestrator env
  56   pure $  swaggerSchemaUIServer swaggerDoc
  57      :<|> hoistServerWithContext
  58             (Proxy :: Proxy GargAPI)
  59             (Proxy :: Proxy AuthContext)
  60             transform
  61             (serverGargAPI (env ^. hasConfig . gc_url_backend_api))
  62      :<|> frontEndServer
  63   where
  64     transform :: forall a. GargM env GargError a -> Handler a
  65     transform = Handler . withExceptT showAsServantErr . (`runReaderT` env)
  66
  67
  68 showAsServantErr :: GargError -> ServerError
  69 showAsServantErr (GargServerError err) = err
  70 showAsServantErr a = err500 { errBody = BL8.pack $ show a }