nri-http 0.1.1.0 → 0.2.0.0

raw patch · 6 files changed

+104/−75 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• nri-http.cabal +1/−1
• src/Http.hs +19/−13
• src/Http/Internal.hs +10/−10
• src/Http/Mock.hs +36/−25
• test/Main.hs +34/−22
• test/golden-results/expected-http-span +4/−4

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           nri-http-version:        0.1.1.0+version:        0.2.0.0 synopsis:       Make Elm style HTTP requests description:    Please see the README at <https://github.com/NoRedInk/haskell-libraries/tree/trunk/nri-http#readme>. category:       Web

@@ -108,7 +108,7 @@ -- QUICKS  -- | Create a @GET@ request.-get :: (Dynamic.Typeable a) => Handler -> Text -> Expect a -> Task Error a+get :: (Dynamic.Typeable x, Dynamic.Typeable a) => Handler -> Text -> Expect x a -> Task x a get handler' url expect =   request     handler'@@ -122,7 +122,7 @@       }  -- | Create a @POST@ request.-post :: (Dynamic.Typeable a) => Handler -> Text -> Body -> Expect a -> Task Error a+post :: (Dynamic.Typeable x, Dynamic.Typeable a) => Handler -> Text -> Body -> Expect x a -> Task x a post handler' url body expect =   request     handler'@@ -187,13 +187,15 @@  -- | Create a custom request. request ::-  (Dynamic.Typeable expect) =>+  ( Dynamic.Typeable x,+    Dynamic.Typeable expect+  ) =>   Handler ->-  Internal.Request expect ->-  Task Error expect+  Internal.Request x expect ->+  Task x expect request Internal.Handler {Internal.handlerRequest} settings = handlerRequest settings -_request :: Platform.DoAnythingHandler -> HTTP.Manager -> Internal.Request expect -> Task Error expect+_request :: Platform.DoAnythingHandler -> HTTP.Manager -> Internal.Request x expect -> Task x expect _request doAnythingHandler manager settings = do   requestManager <- prepareManagerForRequest manager   Platform.doAnything doAnythingHandler <| do@@ -222,7 +224,7 @@         HTTP.httpLbs finalRequest requestManager     pure <| handleResponse (Internal.expect settings) response -handleResponse :: Expect a -> Either HTTP.HttpException (HTTP.Response Data.ByteString.Lazy.ByteString) -> Result Error a+handleResponse :: Expect x a -> Either HTTP.HttpException (HTTP.Response Data.ByteString.Lazy.ByteString) -> Result x a handleResponse expect response =   case response of     Right okResponse ->@@ -247,8 +249,12 @@           exception             |> exceptionToResponse identity             |> mkResult-        _ ->+        Internal.ExpectJson ->           Err (exceptionToError exception)+        Internal.ExpectText ->+          Err (exceptionToError exception)+        Internal.ExpectWhatever ->+          Err (exceptionToError exception)  exceptionToError :: HTTP.HttpException -> Error exceptionToError exception =@@ -319,27 +325,27 @@  -- | -- Expect the response body to be JSON.-expectJson :: Aeson.FromJSON a => Expect a+expectJson :: Aeson.FromJSON a => Expect Error a expectJson = Internal.ExpectJson  -- | -- Expect the response body to be a `Text`.-expectText :: Expect Text+expectText :: Expect Error Text expectText = Internal.ExpectText  -- | -- Expect the response body to be whatever. It does not matter. Ignore it!-expectWhatever :: Expect ()+expectWhatever :: Expect Error () expectWhatever = Internal.ExpectWhatever  -- | -- Expect a `Response` with a `Text` body.-expectTextResponse :: (Internal.Response Text -> Result Error a) -> Expect a+expectTextResponse :: (Internal.Response Text -> Result x a) -> Expect x a expectTextResponse = Internal.ExpectTextResponse  -- | -- Expect a `Response` with a `ByteString` body-expectBytesResponse :: (Internal.Response ByteString -> Result Error a) -> Expect a+expectBytesResponse :: (Internal.Response ByteString -> Result x a) -> Expect x a expectBytesResponse = Internal.ExpectBytesResponse  -- |

@@ -17,13 +17,13 @@  -- | A handler for making HTTP requests. data Handler = Handler-  { handlerRequest :: forall expect. Dynamic.Typeable expect => Request expect -> Task Error expect,-    handlerWithThirdParty :: forall a e. (HTTP.Manager -> Task e a) -> Task e a,+  { handlerRequest :: forall e expect. (Dynamic.Typeable expect, Dynamic.Typeable e) => Request e expect -> Task e expect,+    handlerWithThirdParty :: forall e a. (HTTP.Manager -> Task e a) -> Task e a,     handlerWithThirdPartyIO :: forall a. Platform.LogHandler -> (HTTP.Manager -> IO a) -> IO a   }  -- | A custom request.-data Request a = Request+data Request x a = Request   { -- | The request method, like @"GET"@ or @"PUT"@.     method :: Text,     -- | A list of request headers.@@ -35,7 +35,7 @@     -- | The amount of microseconds you're willing to wait before giving up.     timeout :: Maybe Int,     -- | The type of response you expect back from the request.-    expect :: Expect a+    expect :: Expect x a   }  -- | An HTTP header for configuration requests.@@ -50,12 +50,12 @@  -- | -- Logic for interpreting a response body.-data Expect a where-  ExpectJson :: Aeson.FromJSON a => Expect a-  ExpectText :: Expect Text-  ExpectWhatever :: Expect ()-  ExpectTextResponse :: (Response Text -> Result Error a) -> Expect a-  ExpectBytesResponse :: (Response Data.ByteString.ByteString -> Result Error a) -> Expect a+data Expect x a where+  ExpectJson :: Aeson.FromJSON a => Expect Error a+  ExpectText :: Expect Error Text+  ExpectWhatever :: Expect Error ()+  ExpectTextResponse :: (Response Text -> Result x a) -> Expect x a+  ExpectBytesResponse :: (Response Data.ByteString.ByteString -> Result x a) -> Expect x a  -- | A 'Request' can fail in a couple of ways: --

@@ -1,3 +1,4 @@+{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} @@ -35,14 +36,14 @@ -- different kinds of http requests, you'll want one of these per request type. data Stub a where   Stub ::-    Dynamic.Typeable expect =>-    (Internal.Request expect -> Task Internal.Error (a, expect)) ->+    (Dynamic.Typeable e, Dynamic.Typeable expect) =>+    (Internal.Request e expect -> Task e (a, expect)) ->     Stub a  -- | Create a 'Stub'. mkStub ::-  Dynamic.Typeable expect =>-  (Internal.Request expect -> Task Internal.Error (a, expect)) ->+  (Dynamic.Typeable e, Dynamic.Typeable expect) =>+  (Internal.Request e expect -> Task e (a, expect)) ->   Stub a mkStub = Stub @@ -80,16 +81,7 @@   let mockHandler =         Internal.Handler           ( \req -> do-              (log, res) <--                tryRespond-                  responders-                  ( Internal.NetworkError-                      ( "Http request was made with expected return type "-                          ++ printType req-                          ++ ", but I don't how to create a mock response of this type. Please add a `mkStub` entry for this type in the test."-                      )-                  )-                  req+              (log, res) <- tryRespond responders req               Data.IORef.modifyIORef' logRef (\prev -> log : prev)                 |> map Ok                 |> Platform.doAnything doAnything@@ -105,7 +97,7 @@ -- submitted inside a 'stub' function. -- -- This will return 'Nothing' if the body cannot be parsed as UTF8 text.-getTextBody :: Internal.Request expect -> Maybe Text+getTextBody :: Internal.Request Internal.Error expect -> Maybe Text getTextBody req =   Data.Text.Encoding.decodeUtf8' (getBytesBody req)     |> eitherToMaybe@@ -114,7 +106,7 @@ -- submitted inside a 'stub' function. -- -- This will return an error if parsing the JSON body fails.-getJsonBody :: Aeson.FromJSON a => Internal.Request expect -> Result Text a+getJsonBody :: Aeson.FromJSON a => Internal.Request Internal.Error expect -> Result Text a getJsonBody req =   case Aeson.eitherDecodeStrict (getBytesBody req) of     Prelude.Left err -> Err (Text.fromList err)@@ -122,7 +114,7 @@  -- | Read the body of the request as bytes. Useful to check what data got -- submitted inside a 'stub' function.-getBytesBody :: Internal.Request expect -> ByteString+getBytesBody :: Internal.Request Internal.Error expect -> ByteString getBytesBody req =   Internal.body req     |> Internal.bodyContents@@ -133,7 +125,7 @@ -- -- This will return 'Nothing' if no header with that name was set on the -- request.-getHeader :: Text -> Internal.Request expect -> Maybe Text+getHeader :: Text -> Internal.Request Internal.Error expect -> Maybe Text getHeader name req =   Internal.headers req     |> List.map Internal.unHeader@@ -148,17 +140,36 @@  tryRespond ::   ( Dynamic.Typeable expect,-    Dynamic.Typeable a+    Dynamic.Typeable a,+    Dynamic.Typeable e   ) =>   List (Stub a) ->-  Internal.Error ->-  Internal.Request expect ->-  Task Internal.Error (a, expect)-tryRespond [] err _ = Task.fail err-tryRespond (Stub respond : rest) err req =+  Internal.Request e expect ->+  Task e (a, expect)+tryRespond [] req =+  let msg =+        "Http request was made with expected return type "+          ++ printType req+          ++ ", but I don't how to create a mock response of this type. Please add a `mkStub` entry for this type in the test."+      handleCustomResponse :: (Internal.Response s -> Result e expect) -> Task e (a, expect)+      handleCustomResponse f = case f (Internal.NetworkError_ msg) of+        Err err -> Task.fail err+        Ok _ -> Debug.todo "Since we manually craft the Response as an Error, this case will not run."+   in case Internal.expect req of+        Internal.ExpectJson ->+          Task.fail (Internal.NetworkError msg)+        Internal.ExpectText ->+          Task.fail (Internal.NetworkError msg)+        Internal.ExpectWhatever ->+          Task.fail (Internal.NetworkError msg)+        Internal.ExpectTextResponse f ->+          handleCustomResponse f+        Internal.ExpectBytesResponse f ->+          handleCustomResponse f+tryRespond (Stub respond : rest) req =   Dynamic.dynApply (Dynamic.toDyn respond) (Dynamic.toDyn req)     |> Maybe.andThen Dynamic.fromDynamic-    |> Maybe.withDefault (tryRespond rest err req)+    |> Maybe.withDefault (tryRespond rest req)  printType :: Dynamic.Typeable expect => proxy expect -> Text printType expect =

@@ -58,7 +58,7 @@           (constant "12" Status.ok200)           ( \http url -> do               err <--                Http.get http url (Http.expectJson :: Http.Expect Text)+                Http.get http url (Http.expectJson :: Http.Expect Http.Error Text)                   |> Expect.fails               err                 |> Expect.equal (Http.BadBody "Error in $: parsing Text failed, expected String, but encountered Number")@@ -114,7 +114,7 @@       test "Http.Mock.stub" <| \_ -> do         urlsAccessed <-           Http.Mock.stub-            [Http.Mock.mkStub (\req -> Task.succeed (Http.url req, "Response!" :: Text))]+            [Http.Mock.mkStub (\req -> Task.succeed (Http.url req, "Response!") :: Task Http.Error (Text, Text))]             ( \http ->                 Expect.succeeds <| do                   _ <- Http.get http "example.com/one" Http.expectText@@ -127,33 +127,45 @@         withServer           (constant "Some text" Status.ok200)           ( \http url -> do-            res <--              Http.get http url (Http.expectTextResponse Ok)-                |> Expect.succeeds-            case res of-              Http.GoodStatus_ metadata body -> do-                Expect.equal 200 (Http.metadataStatusCode metadata)-                Expect.equal "OK" (Http.metadataStatusText metadata)-                Expect.equal "Some text" body-              other ->-                Expect.fail <| "Unexpected response: " ++ (Text.fromList <| Prelude.show other)+              res <-+                Http.get http url (Http.expectTextResponse Ok)+                  |> Expect.succeeds+              case res of+                Http.GoodStatus_ metadata body -> do+                  Expect.equal 200 (Http.metadataStatusCode metadata)+                  Expect.equal "OK" (Http.metadataStatusText metadata)+                  Expect.equal "Some text" body+                other ->+                  Expect.fail <| "Unexpected response: " ++ (Text.fromList <| Prelude.show other)           ),       test "Using expectBytesResponse, we can read the body when the request is not successful" <| \() ->         withServer           (constant "This is a bad request" Status.badRequest400)           ( \http url -> do-            res <--              Http.get http url (Http.expectBytesResponse Ok)-                |> Expect.succeeds-            case res of-              Http.BadStatus_ metadata body -> do-                Expect.equal 400 (Http.metadataStatusCode metadata)-                Expect.equal "Bad Request" (Http.metadataStatusText metadata)-                Expect.equal "This is a bad request" body-              other ->-                Expect.fail <| "Unexpected response: " ++ (Text.fromList <| Prelude.show other)+              res <-+                Http.get http url (Http.expectBytesResponse Ok)+                  |> Expect.succeeds+              case res of+                Http.BadStatus_ metadata body -> do+                  Expect.equal 400 (Http.metadataStatusCode metadata)+                  Expect.equal "Bad Request" (Http.metadataStatusText metadata)+                  Expect.equal "This is a bad request" body+                other ->+                  Expect.fail <| "Unexpected response: " ++ (Text.fromList <| Prelude.show other)+          ),+      test "We can use a custom error type" <| \() ->+        withServer+          (constant "This is a bad request" Status.badRequest400)+          ( \http url -> do+              res <-+                Http.get http url (Http.expectTextResponse (\_ -> Err CustomResponseError)) |> Expect.fails+              case res of+                CustomResponseError ->+                  Expect.pass           )     ]++data CustomResponseError = CustomResponseError  -- # Wai applications to test against -- WAI NOT?

@@ -9,9 +9,9 @@             { srcLocPackage = "main"             , srcLocModule = "Main"             , srcLocFile = "test/Main.hs"-            , srcLocStartLine = 221+            , srcLocStartLine = 233             , srcLocStartCol = 7-            , srcLocEndLine = 225+            , srcLocEndLine = 237             , srcLocEndCol = 40             }         )@@ -31,9 +31,9 @@                     { srcLocPackage = "main"                     , srcLocModule = "Http"                     , srcLocFile = "src/Http.hs"-                    , srcLocStartLine = 428+                    , srcLocStartLine = 434                     , srcLocStartCol = 11-                    , srcLocEndLine = 440+                    , srcLocEndLine = 446                     , srcLocEndCol = 14                     }                 )