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