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
 192 ---------------------------------------------------------------------
 193 -- | API Global
 194
 195 -- | API for serving @swagger.json@
 196 type SwaggerAPI = SwaggerSchemaUI "swagger-ui" "swagger.json"
 197
 198 -- | API for serving main operational routes of @gargantext.org@
 199
 200
 201 type GargAPI = "api" :> Summary "API " :> GargAPIVersion
 202 -- | TODO          :<|> Summary "Latest API" :> GargAPI'
 203
 204
 205 type GargAPIVersion = "v1.0" :> Summary "v1.0: " :> GargAPI'
 206
 207 auth :: Connection -> AuthRequest -> Handler AuthResponse
 208 auth conn ar = liftIO $ auth' conn ar
 209
 210 type GargAPI' =
 211            -- Auth endpoint
 212            "auth"      :> Summary "AUTH API"
 213                        :> ReqBody '[JSON] AuthRequest
 214                        :> Post    '[JSON] AuthResponse
 215
 216            -- Roots endpoint
 217           :<|>  "user"  :> Summary "First user endpoint"
 218                         :> Roots
 219
 220            -- Node endpoint
 221            :<|> "node"  :> Summary "Node endpoint"
 222                         :> Capture "id" Int      :> NodeAPI HyperdataAny
 223
 224            -- Corpus endpoint
 225            :<|> "corpus":> Summary "Corpus endpoint"
 226                         :> Capture "id" Int      :> NodeAPI HyperdataCorpus
 227
 228            -- Annuaire endpoint
 229            :<|> "annuaire":> Summary "Annuaire endpoint"
 230                           :> Capture "id" Int      :> NodeAPI HyperdataAnnuaire
 231
 232            -- Corpus endpoint
 233            :<|> "nodes" :> Summary "Nodes endpoint"
 234                         :> ReqBody '[JSON] [Int] :> NodesAPI
 235
 236         -- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI
 237            -- Corpus endpoint
 238            :<|> "count" :> Summary "Count endpoint"
 239                         :> ReqBody '[JSON] Query :> CountAPI
 240
 241            -- Corpus endpoint
 242            :<|> "search":> Summary "Search endpoint"
 243                         :> ReqBody '[JSON] SearchQuery :> SearchAPI
 244
 245            :<|> "graph" :> Summary "Graph endpoint"
 246                         :> Capture "id" Int         :> GraphAPI
 247
 248            -- Tree endpoint
 249            :<|> "tree" :> Summary "Tree endpoint"
 250                        :> Capture "id" Int          :> TreeAPI
 251
 252
 253        --    :<|> "scraper" :> WithCallbacks ScraperAPI
 254
 255 -- /mv/<id>/<id>
 256 -- /merge/<id>/<id>
 257 -- /rename/<id>
 258        -- :<|> "static"
 259        -- :<|> "list"     :> Capture "id" Int  :> NodeAPI
 260        -- :<|> "ngrams"   :> Capture "id" Int  :> NodeAPI
 261        -- :<|> "auth"     :> Capture "id" Int  :> NodeAPI
 262 ---------------------------------------------------------------------
 263 type SwaggerFrontAPI = SwaggerAPI :<|> FrontEndAPI
 264
 265
 266 type API = SwaggerFrontAPI :<|> GargAPI
 267 ---------------------------------------------------------------------
 268 -- | Server declaration
 269 server :: Env -> IO (Server API)
 270 server env = do
 271   -- orchestrator <- scrapyOrchestrator env
 272   pure $ swaggerFront
 273      :<|> auth    conn
 274      :<|> roots    conn
 275      :<|> nodeAPI  conn (Proxy :: Proxy HyperdataAny)
 276      :<|> nodeAPI  conn (Proxy :: Proxy HyperdataCorpus)
 277      :<|> nodeAPI  conn (Proxy :: Proxy HyperdataAnnuaire)
 278      :<|> nodesAPI conn
 279      :<|> count -- TODO: undefined
 280      :<|> search   conn
 281      :<|> graphAPI conn -- TODO: mock
 282      :<|> treeAPI  conn
 283   --   :<|> orchestrator
 284   where
 285     conn = env ^. env_conn
 286
 287 ---------------------------------------------------------------------
 288 swaggerFront :: Server SwaggerFrontAPI
 289 swaggerFront = schemaUiServer swaggerDoc
 290            :<|> frontEndServer
 291
 292 gargMock :: Server GargAPI
 293 gargMock = mock apiGarg Proxy
 294
 295 ---------------------------------------------------------------------
 296 makeApp :: Env -> IO Application
 297 makeApp = fmap (serve api) . server
 298
 299 appMock :: Application
 300 appMock = serve api (swaggerFront :<|> gargMock)
 301
 302 ---------------------------------------------------------------------
 303 api :: Proxy API
 304 api  = Proxy
 305
 306 apiGarg :: Proxy GargAPI
 307 apiGarg  = Proxy
 308 ---------------------------------------------------------------------
 309
 310 schemaUiServer :: (Server api ~ Handler Swagger)
 311         => Swagger -> Server (SwaggerSchemaUI' dir api)
 312 schemaUiServer = swaggerSchemaUIServer
 313
 314
 315 -- Type Family for the Documentation
 316 type family TypeName (x :: *) :: Symbol where
 317     TypeName Int  = "Int"
 318     TypeName Text = "Text"
 319     TypeName x    = GenericTypeName x (Rep x ())
 320
 321 type family GenericTypeName t (r :: *) :: Symbol where
 322     GenericTypeName t (D1 ('MetaData name mod pkg nt) f x) = name
 323
 324 type Desc t n = Description (AppendSymbol (TypeName t) (AppendSymbol " | " n))
 325
 326
 327 -- | Swagger Specifications
 328 swaggerDoc :: Swagger
 329 swaggerDoc = toSwagger (Proxy :: Proxy GargAPI)
 330   & info.title       .~ "Gargantext"
 331   & info.version     .~ "4.0.2" -- TODO same version as Gargantext
 332   -- & info.base_url     ?~ (URL "http://gargantext.org/")
 333   & info.description ?~ "REST API specifications"
 334   -- & tags             .~ Set.fromList [Tag "Garg" (Just "Main perations") Nothing]
 335   & applyTagsFor (subOperations (Proxy :: Proxy GargAPI)(Proxy :: Proxy GargAPI))
 336                  ["Gargantext" & description ?~ "Main operations"]
 337   & info.license     ?~ ("AGPLV3 (English) and CECILL (French)" & url ?~ URL urlLicence )
 338     where
 339         urlLicence = "https://gitlab.iscpif.fr/gargantext/haskell-gargantext/blob/master/LICENSE"
 340
 341 -- | Output generated @swagger.json@ file for the @'TodoAPI'@.
 342 swaggerWriteJSON :: IO ()
 343 swaggerWriteJSON = BL8.writeFile "swagger.json" (encodePretty swaggerDoc)
 344
 345 portRouteInfo :: PortNumber -> IO ()
 346 portRouteInfo port = do
 347   T.putStrLn "      ----Main Routes-----      "
 348   T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/index.html"
 349   T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/swagger-ui"
 350
 351 -- | startGargantext takes as parameters port number and Ini file.
 352 startGargantext :: PortNumber -> FilePath -> IO ()
 353 startGargantext port file = do
 354   env <- newEnv port file
 355   portRouteInfo port
 356   app <- makeDevApp env
 357   run port app
 358
 359 startGargantextMock :: PortNumber -> IO ()
 360 startGargantextMock port = do
 361   portRouteInfo port
 362   application <- makeMockApp . MockEnv $ FireWall False
 363   run port application
 364