src/Gargantext/Core/Text/Upload.hs

   1 {-# LANGUAGE TypeOperators #-}
   2
   3 module Gargantext.Core.Text.Upload
   4   ( Host(..)
   5   , DocId(..)
   6   , Data(..)
   7   , ContentType (..)
   8   , ethercalc
   9   , codimd
  10   )
  11 where
  12
  13 import qualified Data.Map.Strict as Map
  14 import qualified Data.Text as T
  15 import qualified Data.Text.Encoding as TE
  16 import Gargantext.Utils.Servant (CSV, Markdown)
  17 import Network.HTTP.Client (newManager, Request(..))
  18 import Network.HTTP.Client.TLS (tlsManagerSettings)
  19 import Protolude
  20 import Servant.API
  21 import Servant.Client
  22
  23
  24 newtype Host = Host { fromHost :: Text }
  25 newtype DocId = DocId { fromDocId :: Text }
  26 newtype Data = Data { fromData :: Text }
  27 data ContentType a =
  28     CTPlain a
  29   | CTCSV a
  30   -- TODO SocialCalc, Excel XML ?
  31
  32 instance MimeRender CSV Data where
  33   mimeRender p (Data d) = mimeRender p d
  34 instance MimeRender PlainText Data where
  35   mimeRender p (Data d) = mimeRender p d
  36
  37 instance ToHttpApiData DocId where
  38   toUrlPiece (DocId docId) = docId
  39
  40
  41 -- https://github.com/audreyt/ethercalc/blob/master/API.md
  42 type EthercalcAPI =
  43   "_" :> (
  44        -- plain text
  45            ReqBody '[PlainText] Data
  46         :> Post '[PlainText] Text
  47       :<|>
  48            Capture "docId" DocId
  49         :> ReqBody '[PlainText] Data
  50         :> Put '[PlainText] Text
  51
  52       -- csv
  53       :<|>
  54            ReqBody '[CSV] Data
  55         :> Post '[PlainText, CSV] Text
  56       :<|>
  57            Capture "docId" DocId
  58         :> ReqBody '[CSV] Data
  59         :> Put '[PlainText, CSV] Text
  60   )
  61
  62 ethercalcAPI :: Proxy EthercalcAPI
  63 ethercalcAPI = Proxy
  64
  65 ethercalcNewPlain :: Data -> ClientM Text
  66 ethercalcUpdatePlain :: DocId -> Data -> ClientM Text
  67 ethercalcNewCSV :: Data -> ClientM Text
  68 ethercalcUpdateCSV :: DocId -> Data -> ClientM Text
  69 ethercalcNewPlain :<|> ethercalcUpdatePlain
  70   :<|> ethercalcNewCSV :<|> ethercalcUpdateCSV = client ethercalcAPI
  71
  72
  73 ------------------------------
  74
  75 -- | Create new or update existing Ethercalc document (depending on
  76 -- `Maybe DocId` constructor). `Data` can be in various formats (CSV,
  77 -- etc).
  78 ethercalc :: Host -> Maybe DocId -> ContentType Data -> IO (Either ClientError Text)
  79 ethercalc (Host host) mDocId ctD = do
  80   manager' <- newManager tlsManagerSettings
  81   let env = mkClientEnv manager' (BaseUrl Https (T.unpack host) 443 "")
  82   case (mDocId, ctD) of
  83     (Nothing, CTPlain d)    -> runClientM (ethercalcNewPlain d) env
  84     (Nothing, CTCSV d)      -> runClientM (ethercalcNewCSV d) env
  85     (Just docId, CTPlain d) -> runClientM (ethercalcUpdatePlain docId d) env
  86     (Just docId, CTCSV d)   -> runClientM (ethercalcUpdateCSV docId d) env
  87
  88 -----------------------------------
  89
  90 type CodiMDAPI =
  91   "new" :> (
  92       ReqBody '[Markdown] Data
  93    :> Post '[Markdown] Text
  94   )
  95
  96 instance MimeRender Markdown Data where
  97   mimeRender p (Data d) = mimeRender p d
  98
  99 codimdAPI :: Proxy CodiMDAPI
 100 codimdAPI = Proxy
 101
 102 codimdAPINew :: Data -> ClientM Text
 103 codimdAPINew = client codimdAPI
 104
 105
 106 -- | Create a new CodiMD document (with Markdown contents). Please
 107 -- note that AFAIK CodiMD update is not supported, see
 108 -- https://github.com/hackmdio/codimd/issues/1013
 109 codimd :: Host -> Data -> IO (Either Text Text)
 110 codimd (Host host) d = do
 111   manager' <- newManager tlsManagerSettings
 112   let env' = mkClientEnv manager' (BaseUrl Https (T.unpack host) 443 "")
 113   let env = env' { makeClientRequest = \burl req -> (defaultMakeClientRequest burl req) { redirectCount = 0 } }
 114   eRes <- runClientM (codimdAPINew d) env
 115   pure $ case eRes of
 116     -- NOTE We actually expect a redirect here (a 302 with the new
 117     -- page's URL). Hence we expect a `Left FailureResponse` because
 118     -- we have set `redirectCount = 0` above.
 119     Left (FailureResponse _req (Response { responseHeaders })) ->
 120       case Map.lookup "location" (Map.fromList $ toList responseHeaders) of
 121         Nothing -> Left "Cannot find 'Location' header in response"
 122         Just loc -> Right $ TE.decodeUtf8 loc
 123     err -> Left $ "Error creating codimd document: " <> show err