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