src/Gargantext/API.hs

   1 {-|
   2 Module      : Gargantext.API
   3 Description : Server API
   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 Provide config, state, logs and IO
  14  type App m a =  ( MonadState AppState m
  15                  , MonadReader Conf m
  16                  , MonadLog (WithSeverity Doc) m
  17                  , MonadIO m) => m a
  18 Thanks @yannEsposito for this.
  19 -}
  20
  21 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
  22
  23 {-# LANGUAGE DataKinds                   #-}
  24 {-# LANGUAGE DeriveGeneric               #-}
  25 {-# LANGUAGE FlexibleInstances           #-}
  26 {-# LANGUAGE OverloadedStrings           #-}
  27 {-# LANGUAGE TemplateHaskell             #-}
  28 {-# LANGUAGE TypeOperators               #-}
  29 {-# LANGUAGE KindSignatures              #-}
  30 {-# LANGUAGE TypeFamilies                #-}
  31 {-# LANGUAGE UndecidableInstances        #-}
  32
  33 ---------------------------------------------------------------------
  34 module Gargantext.API
  35       where
  36 ---------------------------------------------------------------------
  37 import           Gargantext.Prelude
  38
  39 import           System.IO (FilePath, print)
  40
  41 import           GHC.Generics (D1, Meta (..), Rep)
  42 import           GHC.TypeLits (AppendSymbol, Symbol)
  43
  44 import           Control.Lens
  45 import           Data.Aeson.Encode.Pretty (encodePretty)
  46 import qualified Data.ByteString.Lazy.Char8 as BL8
  47 import           Data.Swagger
  48 import           Data.Text (Text, pack)
  49 --import qualified Data.Set as Set
  50
  51 import           Database.PostgreSQL.Simple (Connection, connect)
  52
  53 import           Network.Wai
  54 import           Network.Wai.Handler.Warp
  55
  56 import           Servant
  57 import           Servant.Mock (mock)
  58 import           Servant.Swagger
  59 import           Servant.Swagger.UI
  60 -- import Servant.API.Stream
  61
  62 --import Gargantext.API.Swagger
  63 import Gargantext.API.FrontEnd (FrontEndAPI, frontEndServer)
  64
  65 import Gargantext.API.Node ( Roots    , roots
  66                            , NodeAPI  , nodeAPI
  67                            , NodesAPI , nodesAPI
  68                            )
  69 import Gargantext.API.Count ( CountAPI, count, Query)
  70 import Gargantext.Database.Utils (databaseParameters)
  71
  72 ---------------------------------------------------------------------
  73
  74
  75 import GHC.Base (Applicative)
  76 -- import Control.Lens
  77
  78 import Data.List (lookup)
  79 import Data.Text.Encoding (encodeUtf8)
  80
  81 --import Network.Wai (Request, requestHeaders, responseLBS)
  82 import Network.Wai (Request, requestHeaders)
  83 --import qualified Network.Wai.Handler.Warp as Warp
  84 import Network.Wai.Middleware.Cors
  85
  86 -- import Network.Wai.Middleware.RequestLogger
  87 -- import qualified Network.Wai.Middleware.RequestLogger as RequestLogger
  88
  89 import Network.HTTP.Types hiding (Query)
  90
  91
  92 -- import Gargantext.API.Settings
  93
  94 data FireWall = FireWall { unFireWall :: Bool }
  95
  96 fireWall :: Applicative f => Request -> FireWall -> f Bool
  97 fireWall req fw = do
  98     let origin = lookup "Origin" (requestHeaders req)
  99     let host   = lookup "Host"   (requestHeaders req)
 100
 101     let hostOk   = Just (encodeUtf8 "localhost:3000")
 102     let originOk = Just (encodeUtf8 "http://localhost:8008")
 103
 104     if origin == originOk && host == hostOk || (not $ unFireWall fw)
 105        then pure True
 106        else pure False
 107
 108
 109 -- makeApp :: Env -> IO (Warp.Settings, Application)
 110 makeApp :: FireWall -> IO Application
 111 makeApp fw = do
 112     let serverApp = appMock
 113
 114     -- logWare <- mkRequestLogger def { destination = RequestLogger.Logger $ env^.logger }
 115
 116     let checkOriginAndHost app req resp = do
 117             blocking <- fireWall req fw
 118             case blocking  of
 119                 True  -> app req resp
 120                 False -> resp ( responseLBS status401 [] "Invalid Origin or Host header" )
 121
 122     let corsMiddleware = cors $ \_ -> Just CorsResourcePolicy
 123 --          { corsOrigins        = Just ([env^.settings.allowedOrigin], False)
 124             { corsOrigins        = Nothing --  == /*
 125             , corsMethods        = [ methodGet   , methodPost   , methodPut
 126                                    , methodDelete, methodOptions, methodHead]
 127             , corsRequestHeaders = ["authorization", "content-type"]
 128             , corsExposedHeaders = Nothing
 129             , corsMaxAge         = Just ( 60*60*24 ) -- one day
 130             , corsVaryOrigin     = False
 131             , corsRequireOrigin  = False
 132             , corsIgnoreFailures = False
 133             }
 134
 135     --let warpS = Warp.setPort (8008 :: Int)   -- (env^.settings.appPort)
 136     --          $ Warp.defaultSettings
 137
 138     --pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp)
 139     pure $ checkOriginAndHost $ corsMiddleware $ serverApp
 140
 141
 142
 143 ---------------------------------------------------------------------
 144 type PortNumber = Int
 145 ---------------------------------------------------------------------
 146 -- | API Global
 147
 148 -- | API for serving @swagger.json@
 149 type SwaggerAPI = SwaggerSchemaUI "swagger-ui" "swagger.json"
 150
 151 -- | API for serving main operational routes of @gargantext.org@
 152 type GargAPI =  "user"  :> Summary "First user endpoint"
 153                         :> Roots
 154
 155            :<|> "node"  :> Summary "Node endpoint"
 156                         :> Capture "id" Int      :> NodeAPI
 157
 158            :<|> "corpus":> Summary "Corpus endpoint"
 159                         :> Capture "id" Int      :> NodeAPI
 160
 161            :<|> "nodes" :> Summary "Nodes endpoint"
 162                         :> ReqBody '[JSON] [Int] :> NodesAPI
 163
 164        -- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI
 165            :<|> "count" :> Summary "Count endpoint"
 166                         :> ReqBody '[JSON] Query :> CountAPI
 167
 168 -- /mv/<id>/<id>
 169 -- /merge/<id>/<id>
 170 -- /rename/<id>
 171        -- :<|> "static"
 172        -- :<|> "list"     :> Capture "id" Int  :> NodeAPI
 173        -- :<|> "ngrams"   :> Capture "id" Int  :> NodeAPI
 174        -- :<|> "auth"     :> Capture "id" Int  :> NodeAPI
 175 ---------------------------------------------------------------------
 176 type SwaggerFrontAPI = SwaggerAPI :<|> FrontEndAPI
 177
 178 type API = SwaggerFrontAPI :<|> GargAPI
 179
 180 ---------------------------------------------------------------------
 181 -- | Server declaration
 182 server :: Connection -> Server API
 183 server conn = swaggerFront
 184           :<|> roots    conn
 185           :<|> nodeAPI  conn
 186           :<|> nodeAPI  conn
 187           :<|> nodesAPI conn
 188           :<|> count
 189
 190 ---------------------------------------------------------------------
 191 swaggerFront :: Server SwaggerFrontAPI
 192 swaggerFront = schemaUiServer swaggerDoc
 193            :<|> frontEndServer
 194
 195 gargMock :: Server GargAPI
 196 gargMock = mock apiGarg Proxy
 197
 198 ---------------------------------------------------------------------
 199 app :: Connection -> Application
 200 app  = serve api . server
 201
 202 appMock :: Application
 203 appMock = serve api (swaggerFront :<|> gargMock)
 204
 205 ---------------------------------------------------------------------
 206 api :: Proxy API
 207 api  = Proxy
 208
 209 apiGarg :: Proxy GargAPI
 210 apiGarg  = Proxy
 211 ---------------------------------------------------------------------
 212
 213 schemaUiServer :: (Server api ~ Handler Swagger)
 214         => Swagger -> Server (SwaggerSchemaUI' dir api)
 215 schemaUiServer = swaggerSchemaUIServer
 216
 217
 218 -- Type Familiy for the Documentation
 219 type family TypeName (x :: *) :: Symbol where
 220     TypeName Int  = "Int"
 221     TypeName Text = "Text"
 222     TypeName x    = GenericTypeName x (Rep x ())
 223
 224 type family GenericTypeName t (r :: *) :: Symbol where
 225     GenericTypeName t (D1 ('MetaData name mod pkg nt) f x) = name
 226
 227 type Desc t n = Description (AppendSymbol (TypeName t) (AppendSymbol " | " n))
 228
 229
 230 -- | Swagger Specifications
 231 swaggerDoc :: Swagger
 232 swaggerDoc = toSwagger (Proxy :: Proxy GargAPI)
 233   & info.title       .~ "Gargantext"
 234   & info.version     .~ "0.1.0"
 235   -- & info.base_url     ?~ (URL "http://gargantext.org/")
 236   & info.description ?~ "REST API specifications"
 237   -- & tags             .~ Set.fromList [Tag "Garg" (Just "Main perations") Nothing]
 238   & applyTagsFor (subOperations (Proxy :: Proxy GargAPI)(Proxy :: Proxy GargAPI))
 239                  ["Garg" & description ?~ "Main operations"]
 240   & info.license     ?~ ("AGPLV3 (English) and CECILL (French)" & url ?~ URL urlLicence )
 241     where
 242         urlLicence = "https://gitlab.iscpif.fr/gargantext/haskell-gargantext/blob/master/LICENSE"
 243
 244 -- | Output generated @swagger.json@ file for the @'TodoAPI'@.
 245 swaggerWriteJSON :: IO ()
 246 swaggerWriteJSON = BL8.writeFile "swagger.json" (encodePretty swaggerDoc)
 247
 248 portRouteInfo :: PortNumber -> IO ()
 249 portRouteInfo port = do
 250    print (pack "      ----Main Routes-----      ")
 251    print      ("http://localhost:" <> show port <> "/index.html")
 252    print      ("http://localhost:" <> show port <> "/swagger-ui")
 253
 254 -- | startGargantext takes as parameters port number and Ini file.
 255 startGargantext :: PortNumber -> FilePath -> IO ()
 256 startGargantext port file = do
 257
 258   param <- databaseParameters file
 259   conn  <- connect param
 260
 261   portRouteInfo port
 262   run port (app conn)
 263
 264 startGargantextMock :: PortNumber -> IO ()
 265 startGargantextMock port = do
 266   portRouteInfo port
 267
 268   application <- makeApp (FireWall False)
 269
 270   run port application
 271
 272