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