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

Sudhir Kumar's avatar
Sudhir Kumar committed
3
import Affjax (defaultRequest, printResponseFormatError, 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
Sudhir Kumar's avatar
Sudhir Kumar committed
52
  case affResp.body of
53
    Left err -> do
54
      _ <-  liftEffect $ log $ printResponseFormatError err
55 56
      throwError $ error $ printResponseFormatError err
    Right json -> do
57 58 59
      --_ <-  liftEffect $ log json.status
      --_ <-  liftEffect $ log json.headers
      --_ <-  liftEffect $ log json.body
60 61 62 63 64 65 66
      case decodeJson json of
        Left err -> throwError $ error $ "decodeJson affResp.body: " <> err
        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 105
             }
  case affResp.body of
    Left err -> do
106
      _ <-  liftEffect $ log $ printResponseFormatError err
107 108
      throwError $ error $ printResponseFormatError err
    Right json -> do
109 110 111
      --_ <- liftEffect $ log json.status
      --_ <- liftEffect $ log json.headers
      --_ <- liftEffect $ log json.body
112 113 114
      case decodeJson json of
        Left err -> throwError $ error $ "decodeJson affResp.body: " <> err
        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 134 135 136 137 138 139 140 141
                         ) mtoken
             , content = Just $ formData fd
             }
  case affResp.body of
    Left err -> do
      _ <-  liftEffect $ log $ printResponseFormatError err
      throwError $ error $ printResponseFormatError err
    Right json -> do
      case decodeJson json of
        Left err -> throwError $ error $ "decodeJson affResp.body: " <> err
        Right b -> pure b
142