Handle Stream HTTP errors.

.gitignore

@@ -12,3 +12,4 @@ cypress/screenshots
 .idea
 generated/
 
+elm-review-report.gz.json

examples/end-to-end/script/src/BackendTaskTest.elm

@@ -45,9 +45,9 @@ run toTest =
                                                         failures
                                                             |> List.map
                                                                 (\( label, failure ) ->
-                                                                    label ++ " | " ++ failure
+                                                                    "X " ++ label ++ "\n>>>>>> \n " ++ failure ++ "\n<<<<<<\n"
                                                                 )
-                                                            |> String.join "\n"
+                                                            |> String.join "\n\n"
                                                     }
                                                 )
 
@@ -153,7 +153,7 @@ viewReason : Reason -> String
 viewReason reason =
     case reason of
         Custom ->
-            ""
+            "Custom"
 
         Equality expected actual ->
             "Expected: " ++ expected ++ " | Actual: " ++ actual

examples/end-to-end/script/src/StreamTests.elm

@@ -2,14 +2,17 @@ module StreamTests exposing (run)
 
 import BackendTask exposing (BackendTask)
 import BackendTask.Custom
-import BackendTask.Http
+import BackendTask.Http exposing (Error(..))
 import BackendTask.Stream as Stream exposing (Stream, defaultCommandOptions)
 import BackendTaskTest exposing (testScript)
+import Dict
 import Expect
 import FatalError exposing (FatalError)
 import Json.Decode as Decode
 import Json.Encode as Encode
+import Pages.Internal.FatalError exposing (FatalError(..))
 import Pages.Script as Script exposing (Script)
+import TerminalText exposing (fromAnsiString)
 import Test
 
 
@@ -117,16 +120,42 @@ b =
             |> try
             |> test "stderr"
                 (.body >> Expect.equal "Unable to parse file <STDIN>:1:13 To see a detailed explanation, run elm make on the file.\n")
-        , Stream.commandWithOptions
-            (defaultCommandOptions
-                |> Stream.allowNon0Status
-            )
-            "elm-review"
-            [ "--report=json" ]
-            |> Stream.readJson (Decode.field "type" Decode.string)
+        , Stream.http
+            { url = "https://jsonplaceholder.typicode.com/posts/124"
+            , timeoutInMs = Nothing
+            , body = BackendTask.Http.emptyBody
+            , retries = Nothing
+            , headers = []
+            , method = "GET"
+            }
+            |> Stream.read
+            |> BackendTask.mapError .recoverable
+            |> BackendTask.toResult
+            |> test "output from HTTP"
+                (\result ->
+                    case result of
+                        Ok _ ->
+                            Expect.fail ("Expected a failure, but got success!\n\n" ++ Debug.toString result)
+
+                        Err (Stream.CustomError (BadStatus meta _) _) ->
+                            meta.statusCode
+                                |> Expect.equal 404
+
+                        _ ->
+                            Expect.fail ("Unexpected error\n\n" ++ Debug.toString result)
+                )
+        , Stream.http
+            { url = "https://jsonplaceholder.typicode.com/posts/124"
+            , timeoutInMs = Nothing
+            , body = BackendTask.Http.emptyBody
+            , retries = Nothing
+            , headers = []
+            , method = "GET"
+            }
+            |> Stream.read
             |> try
-            |> test "elm-review"
-                (.body >> Expect.equal "review-errors")
+            |> expectError "HTTP FatalError message"
+                "BadStatus: 404 Not Found"
         ]
 
 
@@ -155,13 +184,14 @@ expectError name message task =
                                 Expect.fail "Expected a failure, but got success!"
 
                             Err error ->
-                                error
-                                    |> Expect.equal
-                                        (FatalError.build
-                                            { title = "Stream Error"
-                                            , body = message
-                                            }
-                                        )
+                                let
+                                    (FatalError info) =
+                                        error
+                                in
+                                info.body
+                                    |> TerminalText.fromAnsiString
+                                    |> TerminalText.toPlainString
+                                    |> Expect.equal message
             )
 
 

src/BackendTask/Http.elm

@@ -641,6 +641,24 @@ toResultThing ( expect, body, maybeResponse ) =
             Err (BadBody Nothing "Unexpected combination, internal error")
 
 
+{-| -}
+type alias Metadata =
+    { url : String
+    , statusCode : Int
+    , statusText : String
+    , headers : Dict String String
+    }
+
+
+{-| -}
+type Error
+    = BadUrl String
+    | Timeout
+    | NetworkError
+    | BadStatus Metadata String
+    | BadBody (Maybe Json.Decode.Error) String
+
+
 errorToString : Error -> { title : String, body : String }
 errorToString error =
     { title = "HTTP Error"
@@ -658,8 +676,10 @@ errorToString error =
                 [ TerminalText.text "NetworkError"
                 ]
 
-            BadStatus _ string ->
-                [ TerminalText.text ("BadStatus: " ++ string)
+            BadStatus metadata string ->
+                [ TerminalText.text "BadStatus: "
+                , TerminalText.red (String.fromInt metadata.statusCode)
+                , TerminalText.text (" " ++ metadata.statusText)
                 ]
 
             BadBody _ string ->
@@ -668,21 +688,3 @@ errorToString error =
         )
             |> TerminalText.toString
     }
-
-
-{-| -}
-type alias Metadata =
-    { url : String
-    , statusCode : Int
-    , statusText : String
-    , headers : Dict String String
-    }
-
-
-{-| -}
-type Error
-    = BadUrl String
-    | Timeout
-    | NetworkError
-    | BadStatus Metadata String
-    | BadBody (Maybe Json.Decode.Error) String

src/BackendTask/Stream.elm

@@ -79,12 +79,14 @@ End example
 import BackendTask exposing (BackendTask)
 import BackendTask.Http exposing (Body)
 import BackendTask.Internal.Request
+import Base64
 import Bytes exposing (Bytes)
 import FatalError exposing (FatalError)
 import Json.Decode as Decode exposing (Decoder)
 import Json.Encode as Encode
 import Pages.Internal.StaticHttpBody
 import RequestsAndPending
+import TerminalText
 
 
 {-| -}
@@ -239,7 +241,18 @@ httpMetadataDecoder : ( String, Decoder (Result (Recoverable BackendTask.Http.Er
 httpMetadataDecoder =
     ( "http"
     , RequestsAndPending.responseDecoder
-        |> Decode.map Ok
+        |> Decode.map
+            (\thing ->
+                toBadResponse (Just thing) RequestsAndPending.WhateverBody
+                    |> Maybe.map
+                        (\httpError ->
+                            FatalError.recoverable
+                                (errorToString httpError)
+                                httpError
+                                |> Err
+                        )
+                    |> Maybe.withDefault (Ok thing)
+            )
     )
 
 
@@ -544,3 +557,87 @@ type StderrOutput
     | PrintStderr
     | MergeStderrAndStdout
     | StderrInsteadOfStdout
+
+
+toBadResponse : Maybe BackendTask.Http.Metadata -> RequestsAndPending.ResponseBody -> Maybe BackendTask.Http.Error
+toBadResponse maybeResponse body =
+    case maybeResponse of
+        Just response ->
+            if not (response.statusCode >= 200 && response.statusCode < 300) then
+                case body of
+                    RequestsAndPending.StringBody s ->
+                        BackendTask.Http.BadStatus
+                            { url = response.url
+                            , statusCode = response.statusCode
+                            , statusText = response.statusText
+                            , headers = response.headers
+                            }
+                            s
+                            |> Just
+
+                    RequestsAndPending.BytesBody bytes ->
+                        BackendTask.Http.BadStatus
+                            { url = response.url
+                            , statusCode = response.statusCode
+                            , statusText = response.statusText
+                            , headers = response.headers
+                            }
+                            (Base64.fromBytes bytes |> Maybe.withDefault "")
+                            |> Just
+
+                    RequestsAndPending.JsonBody value ->
+                        BackendTask.Http.BadStatus
+                            { url = response.url
+                            , statusCode = response.statusCode
+                            , statusText = response.statusText
+                            , headers = response.headers
+                            }
+                            (Encode.encode 0 value)
+                            |> Just
+
+                    RequestsAndPending.WhateverBody ->
+                        BackendTask.Http.BadStatus
+                            { url = response.url
+                            , statusCode = response.statusCode
+                            , statusText = response.statusText
+                            , headers = response.headers
+                            }
+                            ""
+                            |> Just
+
+            else
+                Nothing
+
+        Nothing ->
+            Nothing
+
+
+errorToString : BackendTask.Http.Error -> { title : String, body : String }
+errorToString error =
+    { title = "HTTP Error"
+    , body =
+        (case error of
+            BackendTask.Http.BadUrl string ->
+                [ TerminalText.text ("BadUrl " ++ string)
+                ]
+
+            BackendTask.Http.Timeout ->
+                [ TerminalText.text "Timeout"
+                ]
+
+            BackendTask.Http.NetworkError ->
+                [ TerminalText.text "NetworkError"
+                ]
+
+            BackendTask.Http.BadStatus metadata string ->
+                [ TerminalText.text "BadStatus: "
+                , TerminalText.red (String.fromInt metadata.statusCode)
+                , TerminalText.text (" " ++ metadata.statusText)
+                ]
+
+            BackendTask.Http.BadBody _ string ->
+                [ TerminalText.text ("BadBody: " ++ string)
+                ]
+        )
+            |> TerminalText.toString
+    }

src/TerminalText.elm

@@ -11,6 +11,7 @@ module TerminalText exposing
     , red
     , resetColors
     , text
+    , toPlainString
     , toString
     , toString_
     , yellow
@@ -109,6 +110,13 @@ toString_ (Style ansiStyle innerText) =
         ]
 
 
+toPlainString : List Text -> String
+toPlainString list =
+    list
+        |> List.map (\(Style _ inner) -> inner)
+        |> String.concat
+
+
 fromAnsiString : String -> List Text
 fromAnsiString ansiString =
     Ansi.parseInto ( blankStyle, [] ) parseInto ansiString