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