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
  25 {-# LANGUAGE NoImplicitPrelude    #-}
  26 {-# LANGUAGE DataKinds            #-}
  27 {-# LANGUAGE DeriveGeneric        #-}
  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 import           Gargantext.Prelude
  41
  42 import           System.IO (FilePath)
  43
  44 import           GHC.Generics (D1, Meta (..), Rep)
  45 import           GHC.TypeLits (AppendSymbol, Symbol)
  46
  47 import           Control.Lens
  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.API.FrontEnd (FrontEndAPI, frontEndServer)
  67
  68 import Gargantext.API.Node ( Roots    , roots
  69                            , NodeAPI  , nodeAPI
  70                            , NodesAPI , nodesAPI
  71                            , GraphAPI , graphAPI
  72                            , TreeAPI  , treeAPI
  73                            , HyperdataAny
  74                            , HyperdataCorpus
  75                            , HyperdataAnnuaire
  76                            )
  77 import Gargantext.Database.Types.Node ()
  78 import Gargantext.API.Count  ( CountAPI, count, Query)
  79 import Gargantext.API.Search ( SearchAPI, search, SearchQuery)
  80 --import Gargantext.API.Orchestrator
  81 --import Gargantext.API.Orchestrator.Types
  82
  83 ---------------------------------------------------------------------
  84
  85 import GHC.Base (Applicative)
  86 -- import Control.Lens
  87
  88 import Data.List (lookup)
  89 import Data.Text.Encoding (encodeUtf8)
  90
  91 --import Network.Wai (Request, requestHeaders, responseLBS)
  92 import Network.Wai (Request, requestHeaders)
  93 --import qualified Network.Wai.Handler.Warp as Warp
  94 import Network.Wai.Middleware.Cors
  95
  96 import Network.Wai.Middleware.RequestLogger
  97 -- import qualified Network.Wai.Middleware.RequestLogger as RequestLogger
  98
  99 import Network.HTTP.Types hiding (Query)
 100
 101
 102 import Gargantext.API.Settings
 103
 104 fireWall :: Applicative f => Request -> FireWall -> f Bool
 105 fireWall req fw = do
 106     let origin = lookup "Origin" (requestHeaders req)
 107     let host   = lookup "Host"   (requestHeaders req)
 108
 109     let hostOk   = Just (encodeUtf8 "localhost:3000")
 110     let originOk = Just (encodeUtf8 "http://localhost:8008")
 111
 112     if  origin == originOk
 113        && host == hostOk
 114        || (not $ unFireWall fw)
 115
 116        then pure True
 117        else pure False
 118
 119
 120 -- makeMockApp :: Env -> IO (Warp.Settings, Application)
 121 makeMockApp :: MockEnv -> IO Application
 122 makeMockApp env = do
 123     let serverApp = appMock
 124
 125     -- logWare <- mkRequestLogger def { destination = RequestLogger.Logger $ env^.logger }
 126     --logWare <- mkRequestLogger def { destination = RequestLogger.Logger "/tmp/logs.txt" }
 127     let checkOriginAndHost app req resp = do
 128             blocking <- fireWall req (env ^. menv_firewall)
 129             case blocking  of
 130                 True  -> app req resp
 131                 False -> resp ( responseLBS status401 []
 132                               "Invalid Origin or Host header")
 133
 134     let corsMiddleware = cors $ \_ -> Just CorsResourcePolicy
 135 --          { corsOrigins        = Just ([env^.settings.allowedOrigin], False)
 136             { corsOrigins        = Nothing --  == /*
 137             , corsMethods        = [ methodGet   , methodPost   , methodPut
 138                                    , methodDelete, methodOptions, methodHead]
 139             , corsRequestHeaders = ["authorization", "content-type"]
 140             , corsExposedHeaders = Nothing
 141             , corsMaxAge         = Just ( 60*60*24 ) -- one day
 142             , corsVaryOrigin     = False
 143             , corsRequireOrigin  = False
 144             , corsIgnoreFailures = False
 145             }
 146
 147     --let warpS = Warp.setPort (8008 :: Int)   -- (env^.settings.appPort)
 148     --          $ Warp.defaultSettings
 149
 150     --pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp)
 151     pure $ logStdoutDev $ checkOriginAndHost $ corsMiddleware $ serverApp
 152
 153
 154 --
 155 makeDevApp :: Env -> IO Application
 156 makeDevApp env = do
 157     serverApp <- makeApp env
 158
 159     -- logWare <- mkRequestLogger def { destination = RequestLogger.Logger $ env^.logger }
 160     --logWare <- mkRequestLogger def { destination = RequestLogger.Logger "/tmp/logs.txt" }
 161 --    let checkOriginAndHost app req resp = do
 162 --            blocking <- fireWall req (env ^. menv_firewall)
 163 --            case blocking  of
 164 --                True  -> app req resp
 165 --                False -> resp ( responseLBS status401 []
 166 --                              "Invalid Origin or Host header")
 167 --
 168     let corsMiddleware = cors $ \_ -> Just CorsResourcePolicy
 169 --          { corsOrigins        = Just ([env^.settings.allowedOrigin], False)
 170             { corsOrigins        = Nothing --  == /*
 171             , corsMethods        = [ methodGet   , methodPost   , methodPut
 172                                    , methodDelete, methodOptions, methodHead]
 173             , corsRequestHeaders = ["authorization", "content-type"]
 174             , corsExposedHeaders = Nothing
 175             , corsMaxAge         = Just ( 60*60*24 ) -- one day
 176             , corsVaryOrigin     = False
 177             , corsRequireOrigin  = False
 178             , corsIgnoreFailures = False
 179             }
 180
 181     --let warpS = Warp.setPort (8008 :: Int)   -- (env^.settings.appPort)
 182     --          $ Warp.defaultSettings
 183
 184     --pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp)
 185     pure $ logStdoutDev $ corsMiddleware $ serverApp
 186
 187 --
 188
 189 ---------------------------------------------------------------------
 190 -- | API Global
 191
 192 -- | API for serving @swagger.json@
 193 type SwaggerAPI = SwaggerSchemaUI "swagger-ui" "swagger.json"
 194
 195 -- | API for serving main operational routes of @gargantext.org@
 196
 197
 198 type GargAPI = "api" :> Summary "API " :> GargAPIVersion
 199 -- | TODO          :<|> Summary "Latest API" :> GargAPI'
 200
 201
 202 type GargAPIVersion = "v1.0" :> Summary "v1.0: " :> GargAPI'
 203
 204 type GargAPI' =
 205
 206            -- Roots endpoint
 207                 "user"  :> Summary "First user endpoint"
 208                         :> Roots
 209
 210            -- Node endpoint
 211            :<|> "node"  :> Summary "Node endpoint"
 212                         :> Capture "id" Int      :> NodeAPI HyperdataAny
 213
 214            -- Corpus endpoint
 215            :<|> "corpus":> Summary "Corpus endpoint"
 216                         :> Capture "id" Int      :> NodeAPI HyperdataCorpus
 217
 218            -- Annuaire endpoint
 219            :<|> "annuaire":> Summary "Annuaire endpoint"
 220                           :> Capture "id" Int      :> NodeAPI HyperdataAnnuaire
 221
 222            -- Corpus endpoint
 223            :<|> "nodes" :> Summary "Nodes endpoint"
 224                         :> ReqBody '[JSON] [Int] :> NodesAPI
 225
 226         -- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI
 227            -- Corpus endpoint
 228            :<|> "count" :> Summary "Count endpoint"
 229                         :> ReqBody '[JSON] Query :> CountAPI
 230
 231            -- Corpus endpoint
 232            :<|> "search":> Summary "Search endpoint"
 233                         :> ReqBody '[JSON] SearchQuery :> SearchAPI
 234
 235            :<|> "graph" :> Summary "Graph endpoint"
 236                         :> Capture "id" Int         :> GraphAPI
 237
 238            -- Tree endpoint
 239            :<|> "tree" :> Summary "Tree endpoint"
 240                        :> Capture "id" Int          :> TreeAPI
 241
 242
 243        --    :<|> "scraper" :> WithCallbacks ScraperAPI
 244
 245 -- /mv/<id>/<id>
 246 -- /merge/<id>/<id>
 247 -- /rename/<id>
 248        -- :<|> "static"
 249        -- :<|> "list"     :> Capture "id" Int  :> NodeAPI
 250        -- :<|> "ngrams"   :> Capture "id" Int  :> NodeAPI
 251        -- :<|> "auth"     :> Capture "id" Int  :> NodeAPI
 252 ---------------------------------------------------------------------
 253 type SwaggerFrontAPI = SwaggerAPI :<|> FrontEndAPI
 254
 255 type API = SwaggerFrontAPI :<|> GargAPI
 256
 257 ---------------------------------------------------------------------
 258 -- | Server declaration
 259 server :: Env -> IO (Server API)
 260 server env = do
 261   -- orchestrator <- scrapyOrchestrator env
 262   pure $ swaggerFront
 263      :<|> roots    conn
 264      :<|> nodeAPI  conn (Proxy :: Proxy HyperdataAny)
 265      :<|> nodeAPI  conn (Proxy :: Proxy HyperdataCorpus)
 266      :<|> nodeAPI  conn (Proxy :: Proxy HyperdataAnnuaire)
 267      :<|> nodesAPI conn
 268      :<|> count -- TODO: undefined
 269      :<|> search   conn
 270      :<|> graphAPI conn -- TODO: mock
 271      :<|> treeAPI  conn
 272   --   :<|> orchestrator
 273   where
 274     conn = env ^. env_conn
 275
 276 ---------------------------------------------------------------------
 277 swaggerFront :: Server SwaggerFrontAPI
 278 swaggerFront = schemaUiServer swaggerDoc
 279            :<|> frontEndServer
 280
 281 gargMock :: Server GargAPI
 282 gargMock = mock apiGarg Proxy
 283
 284 ---------------------------------------------------------------------
 285 makeApp :: Env -> IO Application
 286 makeApp = fmap (serve api) . server
 287
 288 appMock :: Application
 289 appMock = serve api (swaggerFront :<|> gargMock)
 290
 291 ---------------------------------------------------------------------
 292 api :: Proxy API
 293 api  = Proxy
 294
 295 apiGarg :: Proxy GargAPI
 296 apiGarg  = Proxy
 297 ---------------------------------------------------------------------
 298
 299 schemaUiServer :: (Server api ~ Handler Swagger)
 300         => Swagger -> Server (SwaggerSchemaUI' dir api)
 301 schemaUiServer = swaggerSchemaUIServer
 302
 303
 304 -- Type Family for the Documentation
 305 type family TypeName (x :: *) :: Symbol where
 306     TypeName Int  = "Int"
 307     TypeName Text = "Text"
 308     TypeName x    = GenericTypeName x (Rep x ())
 309
 310 type family GenericTypeName t (r :: *) :: Symbol where
 311     GenericTypeName t (D1 ('MetaData name mod pkg nt) f x) = name
 312
 313 type Desc t n = Description (AppendSymbol (TypeName t) (AppendSymbol " | " n))
 314
 315
 316 -- | Swagger Specifications
 317 swaggerDoc :: Swagger
 318 swaggerDoc = toSwagger (Proxy :: Proxy GargAPI)
 319   & info.title       .~ "Gargantext"
 320   & info.version     .~ "0.1.0"
 321   -- & info.base_url     ?~ (URL "http://gargantext.org/")
 322   & info.description ?~ "REST API specifications"
 323   -- & tags             .~ Set.fromList [Tag "Garg" (Just "Main perations") Nothing]
 324   & applyTagsFor (subOperations (Proxy :: Proxy GargAPI)(Proxy :: Proxy GargAPI))
 325                  ["Gargantext" & description ?~ "Main operations"]
 326   & info.license     ?~ ("AGPLV3 (English) and CECILL (French)" & url ?~ URL urlLicence )
 327     where
 328         urlLicence = "https://gitlab.iscpif.fr/gargantext/haskell-gargantext/blob/master/LICENSE"
 329
 330 -- | Output generated @swagger.json@ file for the @'TodoAPI'@.
 331 swaggerWriteJSON :: IO ()
 332 swaggerWriteJSON = BL8.writeFile "swagger.json" (encodePretty swaggerDoc)
 333
 334 portRouteInfo :: PortNumber -> IO ()
 335 portRouteInfo port = do
 336   T.putStrLn "      ----Main Routes-----      "
 337   T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/index.html"
 338   T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/swagger-ui"
 339
 340 -- | startGargantext takes as parameters port number and Ini file.
 341 startGargantext :: PortNumber -> FilePath -> IO ()
 342 startGargantext port file = do
 343   env <- newEnv port file
 344   portRouteInfo port
 345   app <- makeDevApp env
 346   run port app
 347
 348 startGargantextMock :: PortNumber -> IO ()
 349 startGargantextMock port = do
 350   portRouteInfo port
 351   application <- makeMockApp . MockEnv $ FireWall False
 352   run port application
 353