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, TableNgramsApi, apiNgramsTableDoc)
  75 import Gargantext.API.Node
  76 import Gargantext.API.Search (SearchPairsAPI, searchPairs)
  77 import Gargantext.API.Types
  78 import qualified Gargantext.API.Corpus.New as New
  79 import Gargantext.Core.Types (HasInvalidError(..))
  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" :> TableNgramsApi
 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 --> TODO rename s/search/filter/g
 265            :<|> "search":> Capture "corpus" NodeId :> SearchPairsAPI
 266
 267            -- TODO move to NodeAPI?
 268            :<|> "graph" :> Summary "Graph endpoint"
 269                         :> Capture "id" NodeId       :> GraphAPI
 270
 271            -- TODO move to NodeAPI?
 272            -- Tree endpoint
 273            :<|> "tree" :> Summary "Tree endpoint"
 274                        :> Capture "id" NodeId        :> TreeAPI
 275
 276            :<|> "new"  :> New.Api
 277
 278
 279        --    :<|> "scraper" :> WithCallbacks ScraperAPI
 280
 281 -- /mv/<id>/<id>
 282 -- /merge/<id>/<id>
 283 -- /rename/<id>
 284        -- :<|> "static"
 285        -- :<|> "list"     :> Capture "id" Int  :> NodeAPI
 286        -- :<|> "ngrams"   :> Capture "id" Int  :> NodeAPI
 287        -- :<|> "auth"     :> Capture "id" Int  :> NodeAPI
 288 ---------------------------------------------------------------------
 289 type SwaggerFrontAPI = SwaggerAPI :<|> FrontEndAPI
 290
 291 type API = SwaggerFrontAPI :<|> GargAPI :<|> Get '[HTML] Html
 292
 293 ---------------------------------------------------------------------
 294 -- | Server declarations
 295
 296 server :: forall env. (HasConnection env, HasRepo env, HasSettings env)
 297        => env -> IO (Server API)
 298 server env = do
 299   -- orchestrator <- scrapyOrchestrator env
 300   pure $  swaggerFront
 301      :<|> hoistServer (Proxy :: Proxy GargAPI) transform serverGargAPI
 302      :<|> serverStatic
 303   where
 304     transform :: forall a. ReaderT env (ExceptT GargError IO) a -> Handler a
 305     transform = Handler . withExceptT showAsServantErr . (`runReaderT` env)
 306
 307 serverGargAPI :: GargServer GargAPI
 308 serverGargAPI -- orchestrator
 309        =  auth
 310      :<|> roots
 311      :<|> nodeAPI  (Proxy :: Proxy HyperdataAny)      fakeUserId
 312      :<|> nodeAPI  (Proxy :: Proxy HyperdataCorpus)   fakeUserId
 313      :<|> nodeAPI  (Proxy :: Proxy HyperdataAnnuaire) fakeUserId
 314      :<|> apiNgramsTableDoc
 315      :<|> nodesAPI
 316      :<|> count -- TODO: undefined
 317      :<|> searchPairs -- TODO: move elsewhere
 318      :<|> graphAPI -- TODO: mock
 319      :<|> treeAPI
 320      :<|> New.api
 321      :<|> New.info fakeUserId
 322   --   :<|> orchestrator
 323   where
 324     fakeUserId = 1 -- TODO
 325
 326 serverStatic :: Server (Get '[HTML] Html)
 327 serverStatic = $(do
 328                 let path = "purescript-gargantext/dist/index.html"
 329                 Just s <- liftIO (fileTypeToFileTree (FileTypeFile path))
 330                 fileTreeToServer s
 331                 )
 332
 333 ---------------------------------------------------------------------
 334 swaggerFront :: Server SwaggerFrontAPI
 335 swaggerFront = schemaUiServer swaggerDoc
 336            :<|> frontEndServer
 337
 338 --gargMock :: Server GargAPI
 339 --gargMock = mock apiGarg Proxy
 340
 341 ---------------------------------------------------------------------
 342 makeApp :: (HasConnection env, HasRepo env, HasSettings env)
 343         => env -> IO Application
 344 makeApp = fmap (serve api) . server
 345
 346 --appMock :: Application
 347 --appMock = serve api (swaggerFront :<|> gargMock :<|> serverStatic)
 348
 349 ---------------------------------------------------------------------
 350 api :: Proxy API
 351 api  = Proxy
 352
 353 apiGarg :: Proxy GargAPI
 354 apiGarg  = Proxy
 355 ---------------------------------------------------------------------
 356
 357 schemaUiServer :: (Server api ~ Handler Swagger)
 358         => Swagger -> Server (SwaggerSchemaUI' dir api)
 359 schemaUiServer = swaggerSchemaUIServer
 360
 361
 362 -- Type Family for the Documentation
 363 type family TypeName (x :: *) :: Symbol where
 364     TypeName Int  = "Int"
 365     TypeName Text = "Text"
 366     TypeName x    = GenericTypeName x (Rep x ())
 367
 368 type family GenericTypeName t (r :: *) :: Symbol where
 369     GenericTypeName t (D1 ('MetaData name mod pkg nt) f x) = name
 370
 371 type Desc t n = Description (AppendSymbol (TypeName t) (AppendSymbol " | " n))
 372
 373
 374 -- | Swagger Specifications
 375 swaggerDoc :: Swagger
 376 swaggerDoc = toSwagger (Proxy :: Proxy GargAPI)
 377   & info.title       .~ "Gargantext"
 378   & info.version     .~ "4.0.2" -- TODO same version as Gargantext
 379   -- & info.base_url     ?~ (URL "http://gargantext.org/")
 380   & info.description ?~ "REST API specifications"
 381   -- & tags             .~ Set.fromList [Tag "Garg" (Just "Main perations") Nothing]
 382   & applyTagsFor (subOperations (Proxy :: Proxy GargAPI)(Proxy :: Proxy GargAPI))
 383                  ["Gargantext" & description ?~ "Main operations"]
 384   & info.license     ?~ ("AGPLV3 (English) and CECILL (French)" & url ?~ URL urlLicence )
 385     where
 386         urlLicence = "https://gitlab.iscpif.fr/gargantext/haskell-gargantext/blob/master/LICENSE"
 387
 388 -- | Output generated @swagger.json@ file for the @'TodoAPI'@.
 389 swaggerWriteJSON :: IO ()
 390 swaggerWriteJSON = BL8.writeFile "swagger.json" (encodePretty swaggerDoc)
 391
 392 portRouteInfo :: PortNumber -> IO ()
 393 portRouteInfo port = do
 394   T.putStrLn "      ----Main Routes-----      "
 395   T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/index.html"
 396   T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/swagger-ui"
 397
 398 stopGargantext :: HasRepoSaver env => env -> IO ()
 399 stopGargantext env = do
 400   T.putStrLn "----- Stopping gargantext -----"
 401   runReaderT saveRepo env
 402
 403 -- | startGargantext takes as parameters port number and Ini file.
 404 startGargantext :: PortNumber -> FilePath -> IO ()
 405 startGargantext port file = do
 406   env <- newEnv port file
 407   portRouteInfo port
 408   app <- makeApp env
 409   mid <- makeDevMiddleware
 410   run port (mid app) `finally` stopGargantext env
 411
 412 {-
 413 startGargantextMock :: PortNumber -> IO ()
 414 startGargantextMock port = do
 415   portRouteInfo port
 416   application <- makeMockApp . MockEnv $ FireWall False
 417   run port application
 418 -}
 419
 420
 421
 422