affjax-errors.purs

statusOk :: StatusCode -> Boolean
statusOk (StatusCode n) = n >= 200 && n < 300

_parseError = SProxy :: SProxy "parseError"
_badRequest = SProxy :: SProxy "badRequest"
_unAuthorized = SProxy :: SProxy "unAuthorized"
_forbidden = SProxy :: SProxy "forbidden"
_notFound = SProxy :: SProxy "notFound"
_methodNotAllowed = SProxy :: SProxy "methodNotAllowed"
_formatError = SProxy :: SProxy "formatError"
_serverError = SProxy :: SProxy "serverError"

type ParseError = (parseError :: MultipleErrors)
type BasicError' e =
  Variant
    ( badRequest :: String
    , unAuthorized :: Unit
    , forbidden :: Unit
    , notFound :: Unit
    , methodNotAllowed :: Unit
    , formatError :: ForeignError
    , serverError :: String
    | e
    )

mapBasicError :: StatusCode -> String -> BasicError' ()
mapBasicError (StatusCode n) m
  | n == 400 = inj _badRequest m
  | n == 401 = inj _unAuthorized unit
  | n == 403 = inj _forbidden unit
  | n == 404 = inj _notFound unit
  | n == 405 = inj _methodNotAllowed unit
  | otherwise = inj _serverError m

parseError :: MultipleErrors -> Variant ParseError
parseError = inj _parseError

-- | Default BlueMoon request
sDefaultRequest_ :: String -> Request String
sDefaultRequest_ cookie = { method: Left GET
                          , url: "/"
                          , content: Nothing
                          , headers: [ RequestHeader "X-XSRF-TOKEN" cookie
                                     , RequestHeader "X-Requested-With" "XMLHttpRequest"
                                     , Accept (MediaType "application/json")
                                     ]
                          , username: Nothing
                          , password: Nothing
                          , withCredentials: true
                          , responseFormat: ResponseFormat.string
                          }

getXSRFToken :: Effect String
getXSRFToken = getCookie "XSRF-TOKEN"

sDefaultRequest :: Aff (Request String)
sDefaultRequest = do
  cookie <- liftEffect getXSRFToken
  pure $ sDefaultRequest_ cookie

--type E b = Either MultipleErrors b
type E b = Either (BasicError' ParseError) b
type E_  = Either (BasicError' ()) Unit


handleResponse :: forall b. ReadForeign b
               => Either Error (Response (Either ResponseFormat.ResponseFormatError String))
               -> E b
handleResponse res = case res of
  Left e -> Left $ inj _serverError $ show e -- Left $ singleton $ ForeignError $ show e
  Right response ->
    case response.body of
      Left (ResponseFormat.ResponseFormatError err _) -> Left $ inj _formatError err
      Right j
        | statusOk response.status -> lmap (expand <<< parseError) (readJSON j)
        | otherwise -> Left $ expand $ mapBasicError response.status j

handleResponse_ :: Either Error (Response (Either ResponseFormat.ResponseFormatError String)) -> E_
handleResponse_ res = case res of
  Left e -> Left $ inj _serverError $ show e -- Left $ singleton $ ForeignError $ show e
  Right response -> case response.body of -- -> --Right unit
      Left (ResponseFormat.ResponseFormatError err _) -> Left $ inj _formatError err
      Right j
        | statusOk response.status -> Right unit
        | otherwise -> Left $ expand $ mapBasicError response.status j

sRequest_ :: forall a. WriteForeign a => Either Method CustomMethod -> URL -> Maybe a -> Aff E_
sRequest_ method url content = do
  defaultRequest <- sDefaultRequest
  res <- try $ request $ defaultRequest { method = method
                                        , url = url
                                        , content = RequestBody.string <<< writeJSON <$> content
                                        }

  pure $ handleResponse_ res

sRequest :: forall a b. WriteForeign a => ReadForeign b => Either Method CustomMethod -> URL -> Maybe a -> Aff (E b)
sRequest method url content = do
  defaultRequest <- sDefaultRequest
  res <- try $ request $ defaultRequest { method = method
                                        , url = url
                                        , content = RequestBody.string <<< writeJSON <$> content
                                        , responseFormat = ResponseFormat.string
                                        }
  pure $ handleResponse res