src/Gargantext/API/Upload.hs

   1 {-|
   2 Module      : Gargantext.API.Upload
   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 MultiParamTypeClasses #-}
  20 {-# LANGUAGE OverloadedStrings     #-}
  21 {-# LANGUAGE RankNTypes            #-}
  22 {-# LANGUAGE ScopedTypeVariables   #-}
  23 {-# LANGUAGE TemplateHaskell       #-}
  24 {-# LANGUAGE TypeOperators         #-}
  25
  26 module Gargantext.API.Upload
  27   where
  28
  29 import Control.Lens ((.~), (?~))
  30 import qualified Data.Text as Text
  31 import GHC.Generics (Generic)
  32 import Gargantext.Prelude
  33 import Data.Text (Text)
  34 import Data.Aeson
  35 import Data.Monoid
  36 import Servant
  37 import Servant.Multipart
  38 --import Servant.Mock (HasMock(mock))
  39 import Servant.Swagger (HasSwagger(toSwagger))
  40 import Servant.Swagger.Internal
  41 -- import qualified Data.ByteString.Lazy as LBS
  42 import Control.Monad
  43 import Control.Monad.IO.Class
  44 import Gargantext.API.Types
  45 --import Servant.CSV.Cassava (CSV'(..))
  46 --import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
  47 import Data.Swagger
  48 import Gargantext.API.Ngrams (TODO)
  49 import Gargantext.Prelude.Utils (hash)
  50
  51 -- | Upload files
  52 -- TODO Is it possible to adapt the function according to iValue input ?
  53 --type API = MultipartForm Mem (MultipartData Mem) :> Post '[JSON] Integer
  54
  55 -- instance Generic Mem
  56
  57 --instance ToSchema Mem
  58 --instance Arbitrary Mem
  59
  60 instance ToParamSchema (MultipartData Mem) where
  61   toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
  62
  63 --instance Arbitrary ( MultipartData Mem)
  64
  65 instance (ToParamSchema a, HasSwagger sub) =>
  66          HasSwagger (MultipartForm tag a :> sub) where
  67   -- TODO
  68   toSwagger _ = toSwagger (Proxy :: Proxy sub)
  69     & addParam param
  70     where
  71       param = mempty
  72         & required ?~ True
  73         & schema   .~ ParamOther sch
  74       sch = mempty
  75         & in_         .~ ParamFormData
  76         & paramSchema .~ toParamSchema (Proxy :: Proxy a)
  77 --declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
  78 --instance Arbitrary (MultipartForm Mem (MultipartData Mem))
  79
  80 {-
  81 instance (FromMultipart tag a, MultipartBackend tag, Servant.Multipart.LookupContext context (MultipartOptions tag))
  82       => HasMock (MultipartForm tag a :> sub) context where
  83   mock _ _ = undefined
  84
  85 instance HasMock (MultipartForm Mem (MultipartData Mem) :> sub) context where
  86   mock _ _ = undefined
  87 -}
  88
  89 data Upload = Upload { up :: [Text] }
  90   deriving (Generic)
  91
  92 instance ToJSON Upload
  93
  94 type Hash = Text
  95
  96 type ApiUpload = MultipartForm Mem (MultipartData Mem) :> Post '[JSON] Hash
  97 -- MultipartData consists in textual inputs,
  98 -- accessible through its "inputs" field, as well
  99 -- as files, accessible through its "files" field.
 100 upload :: GargServer ApiUpload
 101 upload multipartData = do
 102
 103 --{-
 104   is <- liftIO $ do
 105     putStrLn ("Inputs:" :: Text)
 106     forM (inputs multipartData) $ \input -> do
 107       putStrLn $ ("iName  " :: Text) <> (iName input)
 108             <> ("iValue " :: Text) <> (iValue input)
 109       pure $ iName input
 110
 111 --{-
 112   _ <- forM (files multipartData) $ \file -> do
 113     let content = fdPayload file
 114     putStrLn $ ("XXX " :: Text) <> (fdFileName file)
 115     putStrLn $ ("YYY " :: Text) <>  cs content
 116     --pure $ cs content
 117   -- is <- inputs multipartData
 118 --}
 119
 120   pure $ hash $ Text.concat $ map cs is
 121 -------------------------------------------------------------------------------
 122
 123