aboutsummaryrefslogtreecommitdiff
path: root/src/client/elm/Utils/Http.elm
blob: 4edc23347873fc29b16d18d3d4dee2e71bb7606c (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
module Utils.Http exposing
  ( jsonRequest
  , request
  , requestWithBody
  , decodeHttpValue
  , errorKey
  )

import Http exposing (..)
import Task exposing (..)
import Json.Decode as JsonDecode exposing (Decoder)
import Json.Encode as JsonEncode

jsonRequest : String -> String -> JsonEncode.Value -> Task Error Value
jsonRequest method url json =
  json
    |> JsonEncode.encode 0
    |> Http.string
    |> requestWithBody method url

request : String -> String -> Task Error Value
request method url = requestWithBody method url empty

requestWithBody : String -> String -> Body -> Task Error Value
requestWithBody method url body =
  { verb = method
  , headers = []
  , url = url
  , body = body
  }
    |> Http.send defaultSettings
    |> mapError promoteError
    |> flip Task.andThen handleResponse

promoteError : RawError -> Error
promoteError rawError =
  case rawError of
    RawTimeout -> Timeout
    RawNetworkError -> NetworkError

handleResponse : Response -> Task Error Value
handleResponse response =
  if 200 <= response.status && response.status < 300
    then Task.succeed response.value
    else fail (BadResponse response.status (responseString response.value))

responseString : Value -> String
responseString value =
  case value of
    Text str -> str
    _ -> ""

decodeHttpValue : Decoder a -> Value -> Task Error a
decodeHttpValue decoder value =
  case value of
    Text str ->
      case JsonDecode.decodeString decoder str of
        Ok v -> succeed v
        Err msg -> fail (UnexpectedPayload msg)
    _ ->
      fail (UnexpectedPayload "Response body is a blob, expecting a string.")

errorKey : Error -> String
errorKey error =
  case error of
    Timeout -> "Timeout"
    NetworkError -> "NetworkError"
    UnexpectedPayload _ -> "UnexpectedPayload"
    BadResponse _ key -> key