src/Data/Gargantext/Server.hs

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