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