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.Aeson
  21 import Data.Text (Text)
  22 import Data.Version (showVersion)
  23 import Servant
  24 import Servant.Swagger.UI (swaggerSchemaUIServer)
  25 import qualified Data.ByteString.Lazy.Char8 as BL8
  26 import qualified Paths_gargantext           as PG -- cabal magic build module
  27
  28 import qualified Gargantext.API.Public      as Public
  29
  30 import Gargantext.API.Admin.Auth.Types (AuthContext)
  31 import Gargantext.API.Admin.Auth (auth)
  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 :: ToJSON err => Text -> GargServerM env err GargAPI
  45 serverGargAPI baseUrl -- orchestrator
  46        =  auth
  47      :<|> gargVersion
  48      :<|> serverPrivateGargAPI
  49      :<|> Public.api baseUrl
  50
  51   --   :<|> orchestrator
  52   where
  53     gargVersion :: GargServer GargVersion
  54     gargVersion = pure (cs $ showVersion PG.version)
  55
  56 -- | Server declarations
  57 server :: forall env. (Typeable env, EnvC env) => env -> IO (Server API)
  58 server env = do
  59   -- orchestrator <- scrapyOrchestrator env
  60   pure $  swaggerSchemaUIServer swaggerDoc
  61      :<|> hoistServerWithContext
  62             (Proxy :: Proxy GargAPI)
  63             (Proxy :: Proxy AuthContext)
  64             transform
  65             (serverGargAPI (env ^. hasConfig . gc_url_backend_api))
  66      :<|> hoistServerWithContext
  67             (Proxy :: Proxy GraphQL.API)
  68             (Proxy :: Proxy AuthContext)
  69             transform
  70             GraphQL.api
  71      :<|> frontEndServer
  72   where
  73     transform :: forall a. GargM env GargError a -> Handler a
  74     transform = Handler . withExceptT showAsServantErr . (`runReaderT` env)
  75
  76
  77 showAsServantErr :: GargError -> ServerError
  78 showAsServantErr (GargNodeError err@NoListFound) = err404 { errBody = BL8.pack $ show err }
  79 showAsServantErr (GargNodeError err@NoRootFound) = err404 { errBody = BL8.pack $ show err }
  80 showAsServantErr (GargNodeError err@NoCorpusFound) = err404 { errBody = BL8.pack $ show err }
  81 showAsServantErr (GargNodeError err@NoUserFound) = err404 { errBody = BL8.pack $ show err }
  82 showAsServantErr (GargNodeError err@(DoesNotExist _)) = err404 { errBody = BL8.pack $ show err }
  83 showAsServantErr (GargServerError err) = err
  84 showAsServantErr a = err500 { errBody = BL8.pack $ show a }