src/Gargantext/API.hs

   1 {-|
   2 Module      : Gargantext.API
   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 Main REST API of Gargantext (both Server and Client sides)
  11
  12 TODO App type, the main monad in which the bot code is written with.
  13
  14 Provide config, state, logs and IO
  15  type App m a =  ( MonadState AppState m
  16                  , MonadReader Conf m
  17                  , MonadLog (WithSeverity Doc) m
  18                  , MonadIO m) => m a
  19 Thanks @yannEsposito for this.
  20 -}
  21
  22 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
  23
  24 {-# LANGUAGE NoImplicitPrelude    #-}
  25 {-# LANGUAGE DataKinds            #-}
  26 {-# LANGUAGE DeriveGeneric        #-}
  27 {-# LANGUAGE FlexibleInstances    #-}
  28 {-# LANGUAGE OverloadedStrings    #-}
  29 {-# LANGUAGE TemplateHaskell      #-}
  30 {-# LANGUAGE TypeOperators        #-}
  31 {-# LANGUAGE KindSignatures       #-}
  32 {-# LANGUAGE TypeFamilies         #-}
  33 {-# LANGUAGE UndecidableInstances #-}
  34
  35 ---------------------------------------------------------------------
  36 module Gargantext.API
  37       where
  38 ---------------------------------------------------------------------
  39 import           Gargantext.Prelude
  40
  41 import           System.IO (FilePath)
  42
  43 import           GHC.Generics (D1, Meta (..), Rep)
  44 import           GHC.TypeLits (AppendSymbol, Symbol)
  45
  46 import           Control.Lens
  47 import           Data.Aeson.Encode.Pretty (encodePretty)
  48 import qualified Data.ByteString.Lazy.Char8 as BL8
  49 import           Data.Swagger
  50 import           Data.Text (Text)
  51 import qualified Data.Text.IO as T
  52 --import qualified Data.Set as Set
  53
  54 import           Network.Wai
  55 import           Network.Wai.Handler.Warp hiding (defaultSettings)
  56
  57 import           Servant
  58 import           Servant.Mock (mock)
  59 --import           Servant.Job.Server (WithCallbacks)
  60 import           Servant.Swagger
  61 import           Servant.Swagger.UI
  62 -- import Servant.API.Stream
  63
  64 --import Gargantext.API.Swagger
  65 import Gargantext.API.FrontEnd (FrontEndAPI, frontEndServer)
  66
  67 import Gargantext.API.Node ( Roots    , roots
  68                            , NodeAPI  , nodeAPI
  69                            , NodesAPI , nodesAPI
  70                            , GraphAPI , graphAPI
  71                            , TreeAPI  , treeAPI
  72                            , HyperdataAny
  73                            , HyperdataCorpus
  74                            , HyperdataAnnuaire
  75                            )
  76 import Gargantext.Database.Types.Node ()
  77 import Gargantext.API.Count  ( CountAPI, count, Query)
  78 import Gargantext.API.Search ( SearchAPI, search, SearchQuery)
  79 --import Gargantext.API.Orchestrator
  80 --import Gargantext.API.Orchestrator.Types
  81
  82 ---------------------------------------------------------------------
  83
  84 import GHC.Base (Applicative)
  85 -- import Control.Lens
  86
  87 import Data.List (lookup)
  88 import Data.Text.Encoding (encodeUtf8)
  89
  90 --import Network.Wai (Request, requestHeaders, responseLBS)
  91 import Network.Wai (Request, requestHeaders)
  92 --import qualified Network.Wai.Handler.Warp as Warp
  93 import Network.Wai.Middleware.Cors
  94
  95 import Network.Wai.Middleware.RequestLogger
  96 -- import qualified Network.Wai.Middleware.RequestLogger as RequestLogger
  97
  98 import Network.HTTP.Types hiding (Query)
  99
 100
 101 import Gargantext.API.Settings
 102
 103 fireWall :: Applicative f => Request -> FireWall -> f Bool
 104 fireWall req fw = do
 105     let origin = lookup "Origin" (requestHeaders req)
 106     let host   = lookup "Host"   (requestHeaders req)
 107
 108     let hostOk   = Just (encodeUtf8 "localhost:3000")
 109     let originOk = Just (encodeUtf8 "http://localhost:8008")
 110
 111     if  origin == originOk
 112        && host == hostOk
 113        || (not $ unFireWall fw)
 114
 115        then pure True
 116        else pure False
 117
 118
 119 -- makeMockApp :: Env -> IO (Warp.Settings, Application)
 120 makeMockApp :: MockEnv -> IO Application
 121 makeMockApp env = do
 122     let serverApp = appMock
 123
 124     -- logWare <- mkRequestLogger def { destination = RequestLogger.Logger $ env^.logger }
 125     --logWare <- mkRequestLogger def { destination = RequestLogger.Logger "/tmp/logs.txt" }
 126     let checkOriginAndHost app req resp = do
 127             blocking <- fireWall req (env ^. menv_firewall)
 128             case blocking  of
 129                 True  -> app req resp
 130                 False -> resp ( responseLBS status401 []
 131                               "Invalid Origin or Host header")
 132
 133     let corsMiddleware = cors $ \_ -> Just CorsResourcePolicy
 134 --          { corsOrigins        = Just ([env^.settings.allowedOrigin], False)
 135             { corsOrigins        = Nothing --  == /*
 136             , corsMethods        = [ methodGet   , methodPost   , methodPut
 137                                    , methodDelete, methodOptions, methodHead]
 138             , corsRequestHeaders = ["authorization", "content-type"]
 139             , corsExposedHeaders = Nothing
 140             , corsMaxAge         = Just ( 60*60*24 ) -- one day
 141             , corsVaryOrigin     = False
 142             , corsRequireOrigin  = False
 143             , corsIgnoreFailures = False
 144             }
 145
 146     --let warpS = Warp.setPort (8008 :: Int)   -- (env^.settings.appPort)
 147     --          $ Warp.defaultSettings
 148
 149     --pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp)
 150     pure $ logStdoutDev $ checkOriginAndHost $ corsMiddleware $ serverApp
 151
 152
 153 --
 154 makeDevApp :: Env -> IO Application
 155 makeDevApp env = do
 156     serverApp <- makeApp env
 157
 158     -- logWare <- mkRequestLogger def { destination = RequestLogger.Logger $ env^.logger }
 159     --logWare <- mkRequestLogger def { destination = RequestLogger.Logger "/tmp/logs.txt" }
 160 --    let checkOriginAndHost app req resp = do
 161 --            blocking <- fireWall req (env ^. menv_firewall)
 162 --            case blocking  of
 163 --                True  -> app req resp
 164 --                False -> resp ( responseLBS status401 []
 165 --                              "Invalid Origin or Host header")
 166 --
 167     let corsMiddleware = cors $ \_ -> Just CorsResourcePolicy
 168 --          { corsOrigins        = Just ([env^.settings.allowedOrigin], False)
 169             { corsOrigins        = Nothing --  == /*
 170             , corsMethods        = [ methodGet   , methodPost   , methodPut
 171                                    , methodDelete, methodOptions, methodHead]
 172             , corsRequestHeaders = ["authorization", "content-type"]
 173             , corsExposedHeaders = Nothing
 174             , corsMaxAge         = Just ( 60*60*24 ) -- one day
 175             , corsVaryOrigin     = False
 176             , corsRequireOrigin  = False
 177             , corsIgnoreFailures = False
 178             }
 179
 180     --let warpS = Warp.setPort (8008 :: Int)   -- (env^.settings.appPort)
 181     --          $ Warp.defaultSettings
 182
 183     --pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp)
 184     pure $ logStdoutDev $ corsMiddleware $ serverApp
 185
 186 --
 187
 188 ---------------------------------------------------------------------
 189 -- | API Global
 190
 191 -- | API for serving @swagger.json@
 192 type SwaggerAPI = SwaggerSchemaUI "swagger-ui" "swagger.json"
 193
 194 -- | API for serving main operational routes of @gargantext.org@
 195
 196
 197 type GargAPI = "api" :> Summary "API " :> GargAPIVersion
 198 -- | TODO          :<|> Summary "Latest API" :> GargAPI'
 199
 200
 201 type GargAPIVersion = "v1.0" :> Summary "v1.0: " :> GargAPI'
 202
 203 type GargAPI' =
 204
 205            -- Roots endpoint
 206                 "user"  :> Summary "First user endpoint"
 207                         :> Roots
 208
 209            -- Node endpoint
 210            :<|> "node"  :> Summary "Node endpoint"
 211                         :> Capture "id" Int      :> NodeAPI HyperdataAny
 212
 213            -- Corpus endpoint
 214            :<|> "corpus":> Summary "Corpus endpoint"
 215                         :> Capture "id" Int      :> NodeAPI HyperdataCorpus
 216
 217            -- Annuaire endpoint
 218            :<|> "annuaire":> Summary "Annuaire endpoint"
 219                           :> Capture "id" Int      :> NodeAPI HyperdataAnnuaire
 220
 221            -- Corpus endpoint
 222            :<|> "nodes" :> Summary "Nodes endpoint"
 223                         :> ReqBody '[JSON] [Int] :> NodesAPI
 224
 225         -- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI
 226            -- Corpus endpoint
 227            :<|> "count" :> Summary "Count endpoint"
 228                         :> ReqBody '[JSON] Query :> CountAPI
 229
 230            -- Corpus endpoint
 231            :<|> "search":> Summary "Search endpoint"
 232                         :> ReqBody '[JSON] SearchQuery :> SearchAPI
 233
 234            :<|> "graph" :> Summary "Graph endpoint"
 235                         :> Capture "id" Int         :> GraphAPI
 236
 237            -- Tree endpoint
 238            :<|> "tree" :> Summary "Tree endpoint"
 239                        :> Capture "id" Int          :> TreeAPI
 240
 241
 242        --    :<|> "scraper" :> WithCallbacks ScraperAPI
 243
 244 -- /mv/<id>/<id>
 245 -- /merge/<id>/<id>
 246 -- /rename/<id>
 247        -- :<|> "static"
 248        -- :<|> "list"     :> Capture "id" Int  :> NodeAPI
 249        -- :<|> "ngrams"   :> Capture "id" Int  :> NodeAPI
 250        -- :<|> "auth"     :> Capture "id" Int  :> NodeAPI
 251 ---------------------------------------------------------------------
 252 type SwaggerFrontAPI = SwaggerAPI :<|> FrontEndAPI
 253
 254 type API = SwaggerFrontAPI :<|> GargAPI
 255
 256 ---------------------------------------------------------------------
 257 -- | Server declaration
 258 server :: Env -> IO (Server API)
 259 server env = do
 260   -- orchestrator <- scrapyOrchestrator env
 261   pure $ swaggerFront
 262      :<|> roots    conn
 263      :<|> nodeAPI  conn (Proxy :: Proxy HyperdataAny)
 264      :<|> nodeAPI  conn (Proxy :: Proxy HyperdataCorpus)
 265      :<|> nodeAPI  conn (Proxy :: Proxy HyperdataAnnuaire)
 266      :<|> nodesAPI conn
 267      :<|> count -- TODO: undefined
 268      :<|> search   conn
 269      :<|> graphAPI conn -- TODO: mock
 270      :<|> treeAPI  conn
 271   --   :<|> orchestrator
 272   where
 273     conn = env ^. env_conn
 274
 275 ---------------------------------------------------------------------
 276 swaggerFront :: Server SwaggerFrontAPI
 277 swaggerFront = schemaUiServer swaggerDoc
 278            :<|> frontEndServer
 279
 280 gargMock :: Server GargAPI
 281 gargMock = mock apiGarg Proxy
 282
 283 ---------------------------------------------------------------------
 284 makeApp :: Env -> IO Application
 285 makeApp = fmap (serve api) . server
 286
 287 appMock :: Application
 288 appMock = serve api (swaggerFront :<|> gargMock)
 289
 290 ---------------------------------------------------------------------
 291 api :: Proxy API
 292 api  = Proxy
 293
 294 apiGarg :: Proxy GargAPI
 295 apiGarg  = Proxy
 296 ---------------------------------------------------------------------
 297
 298 schemaUiServer :: (Server api ~ Handler Swagger)
 299         => Swagger -> Server (SwaggerSchemaUI' dir api)
 300 schemaUiServer = swaggerSchemaUIServer
 301
 302
 303 -- Type Family for the Documentation
 304 type family TypeName (x :: *) :: Symbol where
 305     TypeName Int  = "Int"
 306     TypeName Text = "Text"
 307     TypeName x    = GenericTypeName x (Rep x ())
 308
 309 type family GenericTypeName t (r :: *) :: Symbol where
 310     GenericTypeName t (D1 ('MetaData name mod pkg nt) f x) = name
 311
 312 type Desc t n = Description (AppendSymbol (TypeName t) (AppendSymbol " | " n))
 313
 314
 315 -- | Swagger Specifications
 316 swaggerDoc :: Swagger
 317 swaggerDoc = toSwagger (Proxy :: Proxy GargAPI)
 318   & info.title       .~ "Gargantext"
 319   & info.version     .~ "4.0.2" -- TODO same version as Gargantext
 320   -- & info.base_url     ?~ (URL "http://gargantext.org/")
 321   & info.description ?~ "REST API specifications"
 322   -- & tags             .~ Set.fromList [Tag "Garg" (Just "Main perations") Nothing]
 323   & applyTagsFor (subOperations (Proxy :: Proxy GargAPI)(Proxy :: Proxy GargAPI))
 324                  ["Gargantext" & description ?~ "Main operations"]
 325   & info.license     ?~ ("AGPLV3 (English) and CECILL (French)" & url ?~ URL urlLicence )
 326     where
 327         urlLicence = "https://gitlab.iscpif.fr/gargantext/haskell-gargantext/blob/master/LICENSE"
 328
 329 -- | Output generated @swagger.json@ file for the @'TodoAPI'@.
 330 swaggerWriteJSON :: IO ()
 331 swaggerWriteJSON = BL8.writeFile "swagger.json" (encodePretty swaggerDoc)
 332
 333 portRouteInfo :: PortNumber -> IO ()
 334 portRouteInfo port = do
 335   T.putStrLn "      ----Main Routes-----      "
 336   T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/index.html"
 337   T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/swagger-ui"
 338
 339 -- | startGargantext takes as parameters port number and Ini file.
 340 startGargantext :: PortNumber -> FilePath -> IO ()
 341 startGargantext port file = do
 342   env <- newEnv port file
 343   portRouteInfo port
 344   app <- makeDevApp env
 345   run port app
 346
 347 startGargantextMock :: PortNumber -> IO ()
 348 startGargantextMock port = do
 349   portRouteInfo port
 350   application <- makeMockApp . MockEnv $ FireWall False
 351   run port application
 352