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)
  31 import Gargantext.API.Admin.FrontEnd (frontEndServer)
  32 import qualified Gargantext.API.GraphQL as GraphQL
  33 import Gargantext.API.Prelude
  34 import Gargantext.API.Routes
  35 import Gargantext.API.Swagger (swaggerDoc)
  36 import Gargantext.API.ThrowAll (serverPrivateGargAPI)
  37 import Gargantext.Database.Query.Table.Node.Error (NodeError(..))
  38 import Gargantext.Database.Prelude (hasConfig)
  39 import Gargantext.Prelude
  40 import Gargantext.Prelude.Config (gc_url_backend_api)
  41
  42
  43 serverGargAPI :: MimeRender JSON err => Text -> GargServerM env err GargAPI
  44 serverGargAPI baseUrl -- orchestrator
  45        =  auth
  46      :<|> gargVersion
  47      :<|> serverPrivateGargAPI
  48      :<|> Public.api baseUrl
  49
  50   --   :<|> orchestrator
  51   where
  52     gargVersion :: GargServer GargVersion
  53     gargVersion = pure (cs $ showVersion PG.version)
  54
  55 -- | Server declarations
  56 server :: forall env. (Typeable env, EnvC env) => env -> IO (Server API)
  57 server env = do
  58   -- orchestrator <- scrapyOrchestrator env
  59   pure $  swaggerSchemaUIServer swaggerDoc
  60      :<|> hoistServerWithContext
  61             (Proxy :: Proxy GargAPI)
  62             (Proxy :: Proxy AuthContext)
  63             transform
  64             (serverGargAPI (env ^. hasConfig . gc_url_backend_api))
  65      :<|> hoistServerWithContext
  66             (Proxy :: Proxy GraphQL.API)
  67             (Proxy :: Proxy AuthContext)
  68             transform
  69             GraphQL.api
  70      :<|> frontEndServer
  71   where
  72     transform :: forall a. GargM env GargError a -> Handler a
  73     transform = Handler . withExceptT showAsServantErr . (`runReaderT` env)
  74
  75
  76 showAsServantErr :: GargError -> ServerError
  77 showAsServantErr (GargNodeError err@NoListFound) = err404 { errBody = BL8.pack $ show err }
  78 showAsServantErr (GargNodeError err@NoRootFound) = err404 { errBody = BL8.pack $ show err }
  79 showAsServantErr (GargNodeError err@NoCorpusFound) = err404 { errBody = BL8.pack $ show err }
  80 showAsServantErr (GargNodeError err@NoUserFound) = err404 { errBody = BL8.pack $ show err }
  81 showAsServantErr (GargNodeError err@(DoesNotExist _)) = err404 { errBody = BL8.pack $ show err }
  82 showAsServantErr (GargServerError err) = err
  83 showAsServantErr a = err500 { errBody = BL8.pack $ show a }