src/Gargantext/Server.hs

   1
   2 {-|
   3 Module      : Gargantext.Server
   4 Description : Server API
   5 Copyright   : (c) CNRS, 2017-Present
   6 License     : AGPL + CECILL v3
   7 Maintainer  : team@gargantext.org
   8 Stability   : experimental
   9 Portability : POSIX
  10
  11 -}
  12
  13 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
  14 {-# LANGUAGE DataKinds       #-}
  15 {-# LANGUAGE TemplateHaskell #-}
  16 {-# LANGUAGE TypeOperators   #-}
  17 module Gargantext.Server
  18 --    ( startApp
  19 --    , app
  20 --    )
  21       where
  22
  23 import Prelude hiding (null)
  24 import Control.Monad
  25 import Control.Monad.IO.Class
  26 import Data.Aeson
  27 import Network.Wai
  28 import Network.Wai.Handler.Warp
  29 import Servant
  30 import Servant.Multipart
  31 import Database.PostgreSQL.Simple (Connection, connect)
  32 import Opaleye
  33 import System.IO (FilePath)
  34
  35 import Gargantext.Types.Main (Node, NodeId)
  36 import Gargantext.Database.Node (getNodesWithParentId, getNode)
  37 import Gargantext.Database.Private (databaseParameters)
  38
  39 -- | TODO, use MOCK feature of Servant to generate fake data (for tests)
  40
  41 type NodeAPI = Get '[JSON] (Node Value)
  42            :<|> "children" :> Get '[JSON] [Node Value]
  43
  44 type API =  "roots"  :> Get '[JSON] [Node Value]
  45        :<|> "node"   :> Capture "id" Int            :> NodeAPI
  46        :<|> "echo"   :> Capture "string" String     :> Get '[JSON] String
  47        :<|> "upload" :> MultipartForm MultipartData :> Post '[JSON] String
  48
  49        -- :<|> "node"  :> Capture "id" Int        :> Get '[JSON] Node
  50
  51 server :: Connection -> Server API
  52 server conn
  53     = liftIO (getNodesWithParentId conn 0)
  54   :<|> nodeAPI conn
  55   :<|> echo
  56   :<|> upload
  57     where
  58         echo s = pure s
  59
  60 startGargantext :: FilePath -> IO ()
  61 startGargantext file = do
  62
  63   print ("Starting server on port " ++ show port)
  64   param <- databaseParameters file
  65   conn  <- connect param
  66
  67   run port $ app conn
  68     where
  69         port = 8008
  70
  71 -- | TODO App type, the main monad in which the bot code is written with.
  72 -- Provide config, state, logs and IO
  73 -- type App m a =  ( MonadState AppState m
  74 --                 , MonadReader Conf m
  75 --                 , MonadLog (WithSeverity Doc) m
  76 --                 , MonadIO m) => m a
  77 -- Thanks @yannEsposito for this.
  78 app :: Connection -> Application
  79 app = serve api . server
  80
  81 api :: Proxy API
  82 api = Proxy
  83
  84 nodeAPI :: Connection -> NodeId -> Server NodeAPI
  85 nodeAPI conn id
  86     =  liftIO (getNode conn id')
  87   :<|> liftIO (getNodesWithParentId conn id)
  88     where
  89         id' = pgInt4 id
  90
  91 -- | Upload files
  92 -- TODO Is it possible to adapt the function according to iValue input ?
  93 upload :: MultipartData -> Handler String
  94 upload multipartData = do
  95   liftIO $ do
  96     putStrLn "Inputs:"
  97     forM_ (inputs multipartData) $ \input ->
  98       putStrLn $ "  " ++ show (iName input)
  99             ++ " -> " ++ show (iValue input)
 100
 101     forM_ (files multipartData) $ \file -> do
 102       content <- readFile (fdFilePath file)
 103       putStrLn $ "Content of " ++ show (fdFileName file)
 104               ++ " at " ++ fdFilePath file
 105       putStrLn content
 106   pure "Data loaded"