1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
{-|
Module : Gargantext.API.Server
Description : REST API declaration
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
---------------------------------------------------------------------
module Gargantext.API.Server where
---------------------------------------------------------------------
import Control.Lens ((^.))
import Control.Monad.Except (withExceptT)
import Control.Monad.Reader (runReaderT)
import Data.Text (Text)
import Data.Version (showVersion)
import Servant
import Servant.Swagger.UI (swaggerSchemaUIServer)
import qualified Data.ByteString.Lazy.Char8 as BL8
import qualified Paths_gargantext as PG -- cabal magic build module
import qualified Gargantext.API.Public as Public
import Gargantext.API.Admin.Auth.Types (AuthContext)
import Gargantext.API.Admin.Auth (auth)
import Gargantext.API.Admin.FrontEnd (frontEndServer)
import Gargantext.API.Prelude
import Gargantext.API.Routes
import Gargantext.API.Swagger (swaggerDoc)
import Gargantext.API.ThrowAll (serverPrivateGargAPI)
import Gargantext.Database.Query.Table.Node.Error (NodeError(..))
import Gargantext.Database.Prelude (hasConfig)
import Gargantext.Prelude
import Gargantext.Prelude.Config (gc_url_backend_api)
serverGargAPI :: MimeRender JSON err => Text -> GargServerM env err GargAPI
serverGargAPI baseUrl -- orchestrator
= auth
:<|> gargVersion
:<|> serverPrivateGargAPI
:<|> Public.api baseUrl
-- :<|> orchestrator
where
gargVersion :: GargServer GargVersion
gargVersion = pure (cs $ showVersion PG.version)
-- | Server declarations
server :: forall env. EnvC env => env -> IO (Server API)
server env = do
-- orchestrator <- scrapyOrchestrator env
pure $ swaggerSchemaUIServer swaggerDoc
:<|> hoistServerWithContext
(Proxy :: Proxy GargAPI)
(Proxy :: Proxy AuthContext)
transform
(serverGargAPI (env ^. hasConfig . gc_url_backend_api))
:<|> frontEndServer
where
transform :: forall a. GargM env GargError a -> Handler a
transform = Handler . withExceptT showAsServantErr . (`runReaderT` env)
showAsServantErr :: GargError -> ServerError
showAsServantErr (GargNodeError err@NoListFound) = err404 { errBody = BL8.pack $ show err }
showAsServantErr (GargNodeError err@NoRootFound) = err404 { errBody = BL8.pack $ show err }
showAsServantErr (GargNodeError err@NoCorpusFound) = err404 { errBody = BL8.pack $ show err }
showAsServantErr (GargNodeError err@NoUserFound) = err404 { errBody = BL8.pack $ show err }
showAsServantErr (GargNodeError err@(DoesNotExist _)) = err404 { errBody = BL8.pack $ show err }
showAsServantErr (GargServerError err) = err
showAsServantErr a = err500 { errBody = BL8.pack $ show a }