REST.purs 5.44 KB
Newer Older
1
module Gargantext.Config.REST where
2

3
import Affjax (defaultRequest, printError, request)
4
import Affjax.RequestBody (RequestBody(..), formData, formURLEncoded)
5
import Affjax.RequestHeader as ARH
Sudhir Kumar's avatar
Sudhir Kumar committed
6
import Affjax.ResponseFormat as ResponseFormat
7
import DOM.Simple.Console (log, log2)
8
import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson)
9
import Data.Either (Either(..))
10 11
import Data.Foldable (foldMap)
import Data.FormURLEncoded as FormURLEncoded
Sudhir Kumar's avatar
Sudhir Kumar committed
12
import Data.HTTP.Method (Method(..))
13
import Data.Maybe (Maybe(..))
14
import Data.MediaType.Common (applicationFormURLEncoded, applicationJSON, multipartFormData)
15 16
import Data.Tuple (Tuple(..))
import DOM.Simple.Console (log2)
17
import Effect.Aff (Aff, throwError)
18
import Effect.Class (liftEffect)
19
import Effect.Exception (error)
20 21 22 23
import Milkis as Milkis
import Unsafe.Coerce (unsafeCoerce)
import Web.XHR.FormData as XHRFormData

24 25 26
import Gargantext.Prelude
import Gargantext.Utils.Reactix as R2

27 28 29
type Token = String

-- TODO too much duplicate code in `postWwwUrlencoded`
30
send :: forall a b. EncodeJson a => DecodeJson b =>
31 32
        Method -> Maybe Token -> String -> Maybe a -> Aff b
send m mtoken url reqbody = do
33
  let req = defaultRequest
34 35 36
         { url = url
         , responseFormat = ResponseFormat.json
         , method = Left m
37 38
         , headers =  [ ARH.ContentType applicationJSON
                      , ARH.Accept applicationJSON
39 40
                      ] <>
                      foldMap (\token ->
41
                        [ARH.RequestHeader "Authorization" $  "Bearer " <> token]
42
                      ) mtoken
43 44
         , content  = (Json <<< encodeJson) <$> reqbody
         }
45 46

  affResp <- request req
47 48 49 50 51
  case mtoken of
    Nothing -> pure unit
    Just token -> liftEffect $ do
      let cookie = "JWT-Cookie=" <> token <> "; Path=/;" --" HttpOnly; Secure; SameSite=Lax"
      R2.setCookie cookie
52
  case affResp of
53
    Left err -> do
54 55 56
      _ <-  liftEffect $ log $ printError err
      throwError $ error $ printError err
    Right resp -> do
57 58 59
      --_ <-  liftEffect $ log json.status
      --_ <-  liftEffect $ log json.headers
      --_ <-  liftEffect $ log json.body
60 61
      case decodeJson resp.body of
        Left err -> throwError $ error $ "decodeJson affResp.body: " <> show err
62 63 64 65 66
        Right b -> pure b

noReqBody :: Maybe Unit
noReqBody = Nothing

67 68
get :: forall a. DecodeJson a => Maybe Token -> String -> Aff a
get mtoken url = send GET mtoken url noReqBody
69

70 71
put :: forall a b. EncodeJson a => DecodeJson b => Maybe Token -> String -> a -> Aff b
put mtoken url = send PUT mtoken url <<< Just
72

73 74 75
put_ :: forall a. DecodeJson a => Maybe Token -> String -> Aff a
put_ mtoken url = send PUT mtoken url noReqBody

76 77
delete :: forall a. DecodeJson a => Maybe Token -> String -> Aff a
delete mtoken url = send DELETE mtoken url noReqBody
78

79 80
-- This might not be a good idea:
-- https://stackoverflow.com/questions/14323716/restful-alternatives-to-delete-request-body
81 82
deleteWithBody :: forall a b. EncodeJson a => DecodeJson b => Maybe Token -> String -> a -> Aff b
deleteWithBody mtoken url = send DELETE mtoken url <<< Just
83

84 85
post :: forall a b. EncodeJson a => DecodeJson b => Maybe Token -> String -> a -> Aff b
post mtoken url = send POST mtoken url <<< Just
86

87 88
type FormDataParams = Array (Tuple String (Maybe String))

89
-- TODO too much duplicate code with `send`
90 91
postWwwUrlencoded :: forall b. DecodeJson b => Maybe Token -> String -> FormDataParams -> Aff b
postWwwUrlencoded mtoken url bodyParams = do
92 93 94 95
  affResp <- request $ defaultRequest
             { url = url
             , responseFormat = ResponseFormat.json
             , method = Left POST
96 97
             , headers =  [ ARH.ContentType applicationFormURLEncoded
                          , ARH.Accept applicationJSON
98 99
                          ] <>
                          foldMap (\token ->
100
                            [ARH.RequestHeader "Authorization" $  "Bearer " <> token]
101
                          ) mtoken
102
             , content  = Just $ formURLEncoded urlEncodedBody
103
             }
104
  case affResp of
105
    Left err -> do
106 107 108
      _ <-  liftEffect $ log $ printError err
      throwError $ error $ printError err
    Right resp -> do
109 110 111
      --_ <- liftEffect $ log json.status
      --_ <- liftEffect $ log json.headers
      --_ <- liftEffect $ log json.body
112 113
      case decodeJson resp.body of
        Left err -> throwError $ error $ "decodeJson affResp.body: " <> show err
114
        Right b -> pure b
115
  where
116
    urlEncodedBody = FormURLEncoded.fromArray bodyParams
117 118 119 120 121 122 123 124 125

postMultipartFormData :: forall b. DecodeJson b => Maybe Token -> String -> String -> Aff b
postMultipartFormData mtoken url body = do
  fd <- liftEffect $ XHRFormData.new
  _ <- liftEffect $ XHRFormData.append (XHRFormData.EntryName "body") body fd
  affResp <- request $ defaultRequest
             { url = url
             , responseFormat = ResponseFormat.json
             , method = Left POST
126 127
             , headers = [ ARH.ContentType multipartFormData
                         , ARH.Accept applicationJSON
128 129
                         ] <>
                         foldMap (\token ->
130
                           [ ARH.RequestHeader "Authorization" $ "Bearer " <> token ]
131 132 133
                         ) mtoken
             , content = Just $ formData fd
             }
134
  case affResp of
135
    Left err -> do
136 137 138 139 140
      _ <-  liftEffect $ log $ printError err
      throwError $ error $ printError err
    Right resp -> do
      case decodeJson resp.body of
        Left err -> throwError $ error $ "decodeJson affResp.body: " <> show err
141
        Right b -> pure b
142