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