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 MonoLocalBinds #-}
  12 {-# LANGUAGE ScopedTypeVariables  #-}
  13
  14 ---------------------------------------------------------------------
  15 module Gargantext.API.Server where
  16 ---------------------------------------------------------------------
  17 import Control.Lens ((^.))
  18 import Control.Monad.Except (withExceptT)
  19 import Control.Monad.Reader (runReaderT)
  20 import Data.Text (Text)
  21 import Data.Version (showVersion)
  22 import Servant
  23 import Servant.Swagger.UI (swaggerSchemaUIServer)
  24 import qualified Data.ByteString.Lazy.Char8 as BL8
  25 import qualified Paths_gargantext           as PG -- cabal magic build module
  26
  27 import qualified Gargantext.API.Public      as Public
  28
  29 import Gargantext.API.Admin.Auth.Types (AuthContext)
  30 import Gargantext.API.Admin.Auth (auth, forgotPassword, forgotPasswordAsync)
  31 import Gargantext.API.Admin.EnvTypes (Env)
  32 import Gargantext.API.Admin.FrontEnd (frontEndServer)
  33 import qualified Gargantext.API.GraphQL as GraphQL
  34 import Gargantext.API.Prelude
  35 import Gargantext.API.Routes
  36 import Gargantext.API.Swagger (swaggerDoc)
  37 import Gargantext.API.ThrowAll (serverPrivateGargAPI)
  38 import Gargantext.Database.Query.Table.Node.Error (NodeError(..))
  39 import Gargantext.Database.Prelude (hasConfig)
  40 import Gargantext.Prelude
  41 import Gargantext.Prelude.Config (gc_url_backend_api)
  42
  43
  44 serverGargAPI :: Text -> ServerT GargAPI (GargM Env GargError)
  45 serverGargAPI baseUrl -- orchestrator
  46        =  auth
  47      :<|> forgotPassword
  48      :<|> forgotPasswordAsync
  49      :<|> gargVersion
  50      :<|> serverPrivateGargAPI
  51      :<|> Public.api baseUrl
  52
  53   --   :<|> orchestrator
  54   where
  55     gargVersion :: GargServer GargVersion
  56     gargVersion = pure (cs $ showVersion PG.version)
  57
  58 -- | Server declarations
  59 server :: Env -> IO (Server API)
  60 server env = do
  61   -- orchestrator <- scrapyOrchestrator env
  62   pure $  swaggerSchemaUIServer swaggerDoc
  63      :<|> hoistServerWithContext
  64             (Proxy :: Proxy GargAPI)
  65             (Proxy :: Proxy AuthContext)
  66             transform
  67             (serverGargAPI (env ^. hasConfig . gc_url_backend_api))
  68      :<|> hoistServerWithContext
  69             (Proxy :: Proxy GraphQL.API)
  70             (Proxy :: Proxy AuthContext)
  71             transform
  72             GraphQL.api
  73      :<|> frontEndServer
  74   where
  75     transform :: forall a. GargM Env GargError a -> Handler a
  76     transform = Handler . withExceptT showAsServantErr . (`runReaderT` env)
  77
  78
  79 showAsServantErr :: GargError -> ServerError
  80 showAsServantErr (GargNodeError err@NoListFound) = err404 { errBody = BL8.pack $ show err }
  81 showAsServantErr (GargNodeError err@NoRootFound) = err404 { errBody = BL8.pack $ show err }
  82 showAsServantErr (GargNodeError err@NoCorpusFound) = err404 { errBody = BL8.pack $ show err }
  83 showAsServantErr (GargNodeError err@NoUserFound) = err404 { errBody = BL8.pack $ show err }
  84 showAsServantErr (GargNodeError err@(DoesNotExist _)) = err404 { errBody = BL8.pack $ show err }
  85 showAsServantErr (GargServerError err) = err
  86 showAsServantErr a = err500 { errBody = BL8.pack $ show a }