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 qualified Data.Aeson as Aeson
  21 import Data.Text (Text, pack)
  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, forgotPassword, forgotPasswordAsync)
  32 import Gargantext.API.Admin.EnvTypes (Env)
  33 import Gargantext.API.Admin.FrontEnd (frontEndServer)
  34 import qualified Gargantext.API.GraphQL as GraphQL
  35 import Gargantext.API.Prelude
  36 import Gargantext.API.Routes
  37 import Gargantext.API.Swagger (swaggerDoc)
  38 import Gargantext.API.ThrowAll (serverPrivateGargAPI)
  39 import Gargantext.Database.Query.Table.Node.Error (NodeError(..))
  40 import Gargantext.Database.Prelude (hasConfig)
  41 import Gargantext.Prelude
  42 import Gargantext.Prelude.Config (gc_url_backend_api)
  43
  44
  45 serverGargAPI :: Text -> ServerT GargAPI (GargM Env GargError)
  46 serverGargAPI baseUrl -- orchestrator
  47        =  auth
  48      :<|> forgotPassword
  49      :<|> forgotPasswordAsync
  50      :<|> gargVersion
  51      :<|> serverPrivateGargAPI
  52      :<|> Public.api baseUrl
  53
  54   --   :<|> orchestrator
  55   where
  56     gargVersion :: GargServer GargVersion
  57     gargVersion = pure (cs $ showVersion PG.version)
  58
  59 -- | Server declarations
  60 server :: Env -> IO (Server API)
  61 server env = do
  62   -- orchestrator <- scrapyOrchestrator env
  63   pure $  swaggerSchemaUIServer swaggerDoc
  64      :<|> hoistServerWithContext
  65             (Proxy :: Proxy GargAPI)
  66             (Proxy :: Proxy AuthContext)
  67             transformJSON
  68             (serverGargAPI (env ^. hasConfig . gc_url_backend_api))
  69      :<|> hoistServerWithContext
  70             (Proxy :: Proxy GraphQL.API)
  71             (Proxy :: Proxy AuthContext)
  72             transformJSON
  73             GraphQL.api
  74      :<|> frontEndServer
  75   where
  76     -- transform :: forall a. GargM Env GargError a -> Handler a
  77     -- transform = Handler . withExceptT showAsServantErr . (`runReaderT` env)
  78     transformJSON :: forall a. GargM Env GargError a -> Handler a
  79     transformJSON = Handler . withExceptT showAsServantJSONErr . (`runReaderT` env)
  80
  81
  82 showAsServantErr :: GargError -> ServerError
  83 showAsServantErr (GargNodeError err@(NoListFound {})) = err404 { errBody = BL8.pack $ show err }
  84 showAsServantErr (GargNodeError err@NoRootFound) = err404 { errBody = BL8.pack $ show err }
  85 showAsServantErr (GargNodeError err@NoCorpusFound) = err404 { errBody = BL8.pack $ show err }
  86 showAsServantErr (GargNodeError err@NoUserFound) = err404 { errBody = BL8.pack $ show err }
  87 showAsServantErr (GargNodeError err@(DoesNotExist {})) = err404 { errBody = BL8.pack $ show err }
  88 showAsServantErr (GargServerError err) = err
  89 showAsServantErr a = err500 { errBody = BL8.pack $ show a }
  90
  91 showAsServantJSONErr :: GargError -> ServerError
  92 showAsServantJSONErr (GargNodeError err@(NoListFound {})) = err404 { errBody = Aeson.encode err }
  93 showAsServantJSONErr (GargNodeError err@NoRootFound) = err404 { errBody = Aeson.encode err }
  94 showAsServantJSONErr (GargNodeError err@NoCorpusFound) = err404 { errBody = Aeson.encode err }
  95 showAsServantJSONErr (GargNodeError err@NoUserFound) = err404 { errBody = Aeson.encode err }
  96 showAsServantJSONErr (GargNodeError err@(DoesNotExist {})) = err404 { errBody = Aeson.encode err }
  97 showAsServantJSONErr (GargServerError err) = err
  98 showAsServantJSONErr a = err500 { errBody = Aeson.encode $ Aeson.object [ ( "error", Aeson.String $ pack $ show a ) ] }