src/Gargantext/API/Node/Corpus/New/File.hs

   1 {-|
   2 Module      : Gargantext.API.Node.Corpus.New.File
   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 -}
  11
  12 {-# OPTIONS_GHC -fno-warn-orphans #-}
  13
  14 {-# LANGUAGE ScopedTypeVariables  #-}
  15 {-# LANGUAGE TemplateHaskell      #-}
  16 {-# LANGUAGE TypeOperators        #-}
  17
  18 module Gargantext.API.Node.Corpus.New.File
  19   where
  20
  21 import Control.Lens ((.~), (?~))
  22 import Control.Monad (forM)
  23 import Data.Maybe
  24 import Data.Monoid (mempty)
  25 import Data.Swagger
  26 import Data.Text (Text())
  27
  28 import Servant
  29 import Servant.Multipart
  30 import Servant.Swagger.Internal
  31
  32 import Gargantext.API.Node.Corpus.New.Types
  33 import Gargantext.Core.Types (TODO)
  34 import Gargantext.Database.Admin.Types.Node
  35 import Gargantext.Database.Prelude -- (Cmd, CmdM)
  36 import Gargantext.Prelude
  37 import Gargantext.Prelude.Crypto.Hash (hash)
  38
  39 -------------------------------------------------------------
  40 type Hash = Text
  41
  42 instance ToParamSchema (MultipartData Mem) where toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
  43
  44 instance (ToParamSchema a, HasSwagger sub) =>
  45          HasSwagger (MultipartForm tag a :> sub) where
  46   -- TODO
  47   toSwagger _ = toSwagger (Proxy :: Proxy sub)
  48               & addParam param
  49     where
  50       param = mempty
  51             & required ?~ True
  52             & schema   .~ ParamOther sch
  53       sch = mempty
  54           & in_         .~ ParamFormData
  55           & paramSchema .~ toParamSchema (Proxy :: Proxy a)
  56
  57
  58 type WithUpload' = Summary "Upload file(s) to a corpus"
  59                 :> QueryParam "fileType"  FileType
  60                 :> QueryParam "fileFormat" FileFormat
  61                 :> MultipartForm Mem (MultipartData Mem)
  62                 :> Post '[JSON] [Hash]
  63
  64 --postUpload :: NodeId -> Maybe FileType ->  GargServer UploadAPI
  65 --postUpload :: NodeId -> GargServer UploadAPI
  66 postUpload :: NodeId
  67            -> Maybe FileType
  68            -> Maybe FileFormat
  69            -> MultipartData Mem
  70            -> Cmd err [Hash]
  71 postUpload _ Nothing _ _ = panic "fileType is a required parameter"
  72 postUpload _ _ Nothing _ = panic "fileFormat is a required parameter"
  73 postUpload _ (Just fileType) (Just fileFormat) multipartData = do
  74   printDebug "File Type: " fileType
  75   printDebug "File format: " fileFormat
  76   is <- liftBase $ do
  77     printDebug "Inputs:" ()
  78     forM (inputs multipartData) $ \input -> do
  79       printDebug "iName  " (iName input)
  80       printDebug "iValue " (iValue input)
  81       pure $ iName input
  82
  83   _ <- forM (files multipartData) $ \file -> do
  84     let content = fdPayload file
  85     printDebug "XXX " (fdFileName file)
  86     printDebug "YYY " content
  87     --pure $ cs content
  88   -- is <- inputs multipartData
  89
  90   pure $ map hash is
  91
  92 -------------------------------------------------------------------