1 files changed, 47 insertions, 0 deletions
diff --git a/src/client/elm/Utils/Http.elm b/src/client/elm/Utils/Http.elm
new file mode 100644
index 0000000..2cf1294
--- /dev/null
+++ b/src/client/elm/Utils/Http.elm
@@ -0,0 +1,47 @@
+module Utils.Http
+  ( 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 (responseString response.value))
+
+responseString : Value -> String
+responseString value =
+  case value of
+    Text str -> str
+    _ -> ""
+
+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.")