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