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

   1 {-|
   2 Module      : Gargantext.API.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 DataKinds            #-}
  15 {-# LANGUAGE DeriveGeneric        #-}
  16 {-# LANGUAGE FlexibleContexts     #-}
  17 {-# LANGUAGE FlexibleInstances    #-}
  18 {-# LANGUAGE NoImplicitPrelude    #-}
  19 {-# LANGUAGE OverloadedStrings    #-}
  20 {-# LANGUAGE RankNTypes           #-}
  21 {-# LANGUAGE ScopedTypeVariables  #-}
  22 {-# LANGUAGE TemplateHaskell      #-}
  23 {-# LANGUAGE TypeOperators        #-}
  24
  25 module Gargantext.API.Corpus.New.File
  26   where
  27
  28 import Control.Lens ((.~), (?~))
  29 import Control.Monad (forM)
  30 import Control.Monad.IO.Class (liftIO)
  31 import Data.Maybe
  32 import Data.Aeson
  33 import Data.Monoid (mempty)
  34 import Data.Swagger
  35 import Data.Text (Text())
  36 import GHC.Generics (Generic)
  37 import Gargantext.API.Ngrams (TODO)
  38 import Gargantext.Database.Types.Node
  39 import Gargantext.Database.Utils -- (Cmd, CmdM)
  40 import Gargantext.Prelude
  41 import Gargantext.Prelude.Utils (sha)
  42 import Servant
  43 import Servant.Multipart
  44 import Servant.Swagger (HasSwagger(toSwagger))
  45 import Servant.Swagger.Internal
  46 import Test.QuickCheck (elements)
  47 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
  48
  49 -------------------------------------------------------------
  50 type Hash = Text
  51 data FileType = CSV | CSV_HAL | PresseRIS
  52   deriving (Eq, Show, Generic)
  53
  54 instance ToSchema FileType
  55 instance Arbitrary FileType
  56   where
  57     arbitrary = elements [CSV, PresseRIS]
  58 instance ToParamSchema FileType
  59
  60 instance FromJSON FileType
  61
  62 instance ToParamSchema (MultipartData Mem) where
  63   toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
  64
  65 instance FromHttpApiData FileType
  66   where
  67     parseUrlPiece "CSV"       = pure CSV
  68     parseUrlPiece "CSV_HAL"   = pure CSV_HAL
  69     parseUrlPiece "PresseRis" = pure PresseRIS
  70     parseUrlPiece _           = pure CSV -- TODO error here
  71
  72
  73 instance (ToParamSchema a, HasSwagger sub) =>
  74          HasSwagger (MultipartForm tag a :> sub) where
  75   -- TODO
  76   toSwagger _ = toSwagger (Proxy :: Proxy sub)
  77               & addParam param
  78     where
  79       param = mempty
  80             & required ?~ True
  81             & schema   .~ ParamOther sch
  82       sch = mempty
  83           & in_         .~ ParamFormData
  84           & paramSchema .~ toParamSchema (Proxy :: Proxy a)
  85
  86
  87 type WithUpload' = Summary "Upload file(s) to a corpus"
  88                 :> QueryParam "fileType"  FileType
  89                 :> MultipartForm Mem (MultipartData Mem)
  90                 :> Post '[JSON] [Hash]
  91
  92 --postUpload :: NodeId -> Maybe FileType ->  GargServer UploadAPI
  93 --postUpload :: NodeId -> GargServer UploadAPI
  94 postUpload :: NodeId
  95            -> Maybe FileType
  96            -> MultipartData Mem
  97            -> Cmd err [Hash]
  98 postUpload _ Nothing _ = panic "fileType is a required parameter"
  99 postUpload _ (Just fileType) multipartData = do
 100   putStrLn $ "File Type: " <> (show fileType)
 101   is <- liftIO $ do
 102     putStrLn ("Inputs:" :: Text)
 103     forM (inputs multipartData) $ \input -> do
 104       putStrLn $ ("iName  " :: Text) <> (iName input)
 105                <> ("iValue " :: Text) <> (iValue input)
 106       pure $ iName input
 107
 108   _ <- forM (files multipartData) $ \file -> do
 109     let content = fdPayload file
 110     putStrLn $ ("XXX " :: Text) <> (fdFileName file)
 111     putStrLn $ ("YYY " :: Text) <>  cs content
 112     --pure $ cs content
 113   -- is <- inputs multipartData
 114
 115   pure $ map (sha . cs) is
 116
 117 -------------------------------------------------------------------