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