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.Aeson
  24 import Data.Maybe
  25 import Data.Monoid (mempty)
  26 import Data.Swagger
  27 import Data.Text (Text())
  28 import GHC.Generics (Generic)
  29
  30 import Servant
  31 import Servant.Multipart
  32 import Servant.Swagger.Internal
  33 import Test.QuickCheck (elements)
  34 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
  35
  36 import Gargantext.Core.Types (TODO)
  37 import Gargantext.Database.Admin.Types.Node
  38 import Gargantext.Database.Prelude -- (Cmd, CmdM)
  39 import Gargantext.Prelude
  40 import Gargantext.Prelude.Crypto.Hash (hash)
  41
  42 -------------------------------------------------------------
  43 type Hash = Text
  44 data FileType = CSV
  45               | CSV_HAL
  46               | PresseRIS
  47               | WOS
  48               | ZIP
  49   deriving (Eq, Show, Generic)
  50
  51 instance ToSchema FileType
  52 instance Arbitrary FileType where arbitrary = elements [CSV, PresseRIS]
  53 instance ToParamSchema FileType
  54
  55 instance FromJSON FileType
  56 instance ToJSON FileType
  57
  58 instance ToParamSchema (MultipartData Mem) where toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
  59
  60 instance FromHttpApiData FileType
  61   where
  62     parseUrlPiece "CSV"       = pure CSV
  63     parseUrlPiece "CSV_HAL"   = pure CSV_HAL
  64     parseUrlPiece "PresseRis" = pure PresseRIS
  65     parseUrlPiece "ZIP"       = pure ZIP
  66     parseUrlPiece "WOS"       = pure WOS
  67     parseUrlPiece _           = pure CSV -- TODO error here
  68 instance ToHttpApiData FileType where
  69   toUrlPiece t = case t of
  70     CSV -> "CSV"
  71     CSV_HAL -> "CSV_HAL"
  72     PresseRIS -> "PresseRis"
  73     ZIP -> "ZIP"
  74     WOS -> "WOS"
  75
  76 instance (ToParamSchema a, HasSwagger sub) =>
  77          HasSwagger (MultipartForm tag a :> sub) where
  78   -- TODO
  79   toSwagger _ = toSwagger (Proxy :: Proxy sub)
  80               & addParam param
  81     where
  82       param = mempty
  83             & required ?~ True
  84             & schema   .~ ParamOther sch
  85       sch = mempty
  86           & in_         .~ ParamFormData
  87           & paramSchema .~ toParamSchema (Proxy :: Proxy a)
  88
  89
  90 type WithUpload' = Summary "Upload file(s) to a corpus"
  91                 :> QueryParam "fileType"  FileType
  92                 :> MultipartForm Mem (MultipartData Mem)
  93                 :> Post '[JSON] [Hash]
  94
  95 --postUpload :: NodeId -> Maybe FileType ->  GargServer UploadAPI
  96 --postUpload :: NodeId -> GargServer UploadAPI
  97 postUpload :: NodeId
  98            -> Maybe FileType
  99            -> MultipartData Mem
 100            -> Cmd err [Hash]
 101 postUpload _ Nothing _ = panic "fileType is a required parameter"
 102 postUpload _ (Just fileType) multipartData = do
 103   printDebug "File Type: " fileType
 104   is <- liftBase $ do
 105     printDebug "Inputs:" ()
 106     forM (inputs multipartData) $ \input -> do
 107       printDebug "iName  " (iName input)
 108       printDebug "iValue " (iValue input)
 109       pure $ iName input
 110
 111   _ <- forM (files multipartData) $ \file -> do
 112     let content = fdPayload file
 113     printDebug "XXX " (fdFileName file)
 114     printDebug "YYY " content
 115     --pure $ cs content
 116   -- is <- inputs multipartData
 117
 118   pure $ map hash is
 119
 120 -------------------------------------------------------------------