aboutsummaryrefslogtreecommitdiff
path: root/src/client/elm/SimpleHTTP.elm
diff options
context:
space:
mode:
Diffstat (limited to 'src/client/elm/SimpleHTTP.elm')
-rw-r--r--src/client/elm/SimpleHTTP.elm41
1 files changed, 41 insertions, 0 deletions
diff --git a/src/client/elm/SimpleHTTP.elm b/src/client/elm/SimpleHTTP.elm
new file mode 100644
index 0000000..99a7056
--- /dev/null
+++ b/src/client/elm/SimpleHTTP.elm
@@ -0,0 +1,41 @@
+module SimpleHTTP
+ ( post
+ , decodeHttpValue
+ ) where
+
+import Http exposing (..)
+import Task exposing (..)
+import Json.Decode as Json exposing (Decoder)
+
+post : String -> Task Error Value
+post url =
+ { verb = "POST"
+ , headers = []
+ , url = url
+ , body = empty
+ }
+ |> Http.send defaultSettings
+ |> mapError promoteError
+ |> flip Task.andThen handleResponse
+
+handleResponse : Response -> Task Error Value
+handleResponse response =
+ if 200 <= response.status && response.status < 300
+ then Task.succeed response.value
+ else fail (BadResponse response.status response.statusText)
+
+promoteError : RawError -> Error
+promoteError rawError =
+ case rawError of
+ RawTimeout -> Timeout
+ RawNetworkError -> NetworkError
+
+decodeHttpValue : Decoder a -> Value -> Task Error a
+decodeHttpValue decoder value =
+ case value of
+ Text str ->
+ case Json.decodeString decoder str of
+ Ok v -> succeed v
+ Err msg -> fail (UnexpectedPayload msg)
+ _ ->
+ fail (UnexpectedPayload "Response body is a blob, expecting a string.")