nri-http 0.1.0.4 → 0.1.1.0

raw patch · 5 files changed

+196/−41 lines, 5 filesdep +case-insensitivenew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: case-insensitive

API changes (from Hackage documentation)

Files

• nri-http.cabal +3/−1
• src/Http.hs +118/−34
• src/Http/Internal.hs +39/−0
• test/Main.hs +31/−1
• test/golden-results/expected-http-span +5/−5

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           nri-http-version:        0.1.0.4+version:        0.1.1.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@@ -57,6 +57,7 @@       aeson >=1.4.6.0 && <2.1     , base >=4.12.0.0 && <4.17     , bytestring >=0.10.8.2 && <0.12+    , case-insensitive >=1.1 && <2.0     , conduit >=1.3.0 && <1.4     , http-client >=0.6.0 && <0.8     , http-client-tls >=0.3.0 && <0.4@@ -101,6 +102,7 @@       aeson >=1.4.6.0 && <2.1     , base >=4.12.0.0 && <4.17     , bytestring >=0.10.8.2 && <0.12+    , case-insensitive >=1.1 && <2.0     , conduit >=1.3.0 && <1.4     , http-client >=0.6.0 && <0.8     , http-client-tls >=0.3.0 && <0.4

@@ -31,6 +31,12 @@     expectText,     expectWhatever, +    -- * Elaborate Expectations+    expectTextResponse,+    expectBytesResponse,+    Internal.Response (..),+    Internal.Metadata (..),+     -- * Use with external libraries     withThirdParty,     withThirdPartyIO,@@ -43,11 +49,13 @@ import qualified Data.Aeson as Aeson import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy+import qualified Data.CaseInsensitive as CI import qualified Data.Dynamic as Dynamic import Data.String (fromString) import qualified Data.Text.Encoding import qualified Data.Text.Lazy import qualified Data.Text.Lazy.Encoding+import qualified Dict import Http.Internal (Body, Expect, Handler) import qualified Http.Internal as Internal import qualified Log.HttpRequest as HttpRequest@@ -59,7 +67,7 @@ import qualified Network.URI import qualified Platform import qualified Task-import Prelude (Either (Left, Right), IO, fromIntegral, pure, show)+import Prelude (Either (Left, Right), IO, fromIntegral, pure)  -- | Create a 'Handler' for making HTTP requests. handler :: Conduit.Acquire Handler@@ -100,7 +108,7 @@ -- QUICKS  -- | Create a @GET@ request.-get :: Dynamic.Typeable a => Handler -> Text -> Expect a -> Task Error a+get :: (Dynamic.Typeable a) => Handler -> Text -> Expect a -> Task Error a get handler' url expect =   request     handler'@@ -114,7 +122,7 @@       }  -- | Create a @POST@ request.-post :: Dynamic.Typeable a => Handler -> Text -> Body -> Expect a -> Task Error a+post :: (Dynamic.Typeable a) => Handler -> Text -> Body -> Expect a -> Task Error a post handler' url body expect =   request     handler'@@ -179,7 +187,7 @@  -- | Create a custom request. request ::-  Dynamic.Typeable expect =>+  (Dynamic.Typeable expect) =>   Handler ->   Internal.Request expect ->   Task Error expect@@ -212,37 +220,103 @@                       |> HTTP.responseTimeoutMicro                 }         HTTP.httpLbs finalRequest requestManager-    pure <| case response of-      Right okResponse ->-        case decode (Internal.expect settings) (HTTP.responseBody okResponse) of-          Ok decodedBody ->-            Ok decodedBody-          Err message ->-            Err (Internal.BadBody message)-      Left (HTTP.HttpExceptionRequest _ content) ->-        case content of-          HTTP.StatusCodeException res _ ->-            let statusCode = fromIntegral << Status.statusCode << HTTP.responseStatus-             in Err (Internal.BadStatus (statusCode res))-          HTTP.ResponseTimeout ->-            Err Internal.Timeout-          HTTP.ConnectionTimeout ->-            Err (Internal.NetworkError "ConnectionTimeout")-          HTTP.ConnectionFailure err ->-            Err (Internal.NetworkError (Text.fromList (Exception.displayException err)))-          err ->-            Err (Internal.NetworkError (Text.fromList (show err)))-      Left (HTTP.InvalidUrlException _ message) ->-        Err (Internal.BadUrl (Text.fromList message))+    pure <| handleResponse (Internal.expect settings) response -decode :: Expect a -> Data.ByteString.Lazy.ByteString -> Result Text a-decode Internal.ExpectJson bytes =-  case Aeson.eitherDecode bytes of-    Left err -> Err (Text.fromList err)-    Right x -> Ok x-decode Internal.ExpectText bytes = (Ok << Data.Text.Lazy.toStrict << Data.Text.Lazy.Encoding.decodeUtf8) bytes-decode Internal.ExpectWhatever _ = Ok ()+handleResponse :: Expect a -> Either HTTP.HttpException (HTTP.Response Data.ByteString.Lazy.ByteString) -> Result Error a+handleResponse expect response =+  case response of+    Right okResponse ->+      let bytes = HTTP.responseBody okResponse+          bodyAsText = Data.Text.Lazy.toStrict <| Data.Text.Lazy.Encoding.decodeUtf8 bytes+       in case expect of+            Internal.ExpectJson ->+              case Aeson.eitherDecode bytes of+                Left err -> Err (Internal.BadBody (Text.fromList err))+                Right x -> Ok x+            Internal.ExpectText -> Ok bodyAsText+            Internal.ExpectWhatever -> Ok ()+            Internal.ExpectTextResponse mkResult -> mkResult (Internal.GoodStatus_ (mkMetadata okResponse) bodyAsText)+            Internal.ExpectBytesResponse mkResult -> mkResult (Internal.GoodStatus_ (mkMetadata okResponse) (Data.ByteString.Lazy.toStrict bytes))+    Left exception ->+      case expect of+        Internal.ExpectTextResponse mkResult ->+          exception+            |> exceptionToResponse Data.Text.Encoding.decodeUtf8+            |> mkResult+        Internal.ExpectBytesResponse mkResult ->+          exception+            |> exceptionToResponse identity+            |> mkResult+        _ ->+          Err (exceptionToError exception) +exceptionToError :: HTTP.HttpException -> Error+exceptionToError exception =+  case exception of+    HTTP.InvalidUrlException _ message ->+      Internal.BadUrl (Text.fromList message)+    HTTP.HttpExceptionRequest _ content ->+      case content of+        HTTP.StatusCodeException res _ ->+          res+            |> HTTP.responseStatus+            |> Status.statusCode+            |> fromIntegral+            |> Internal.BadStatus+        HTTP.ResponseTimeout ->+          Internal.Timeout+        HTTP.ConnectionTimeout ->+          Internal.NetworkError "ConnectionTimeout"+        HTTP.ConnectionFailure err ->+          Exception.displayException err+            |> Text.fromList+            |> Internal.NetworkError+        err ->+          Internal.NetworkError (Debug.toString err)++exceptionToResponse :: (ByteString -> a) -> HTTP.HttpException -> Internal.Response a+exceptionToResponse toBody exception =+  case exception of+    HTTP.InvalidUrlException _ message ->+      Internal.BadUrl_ (Text.fromList message)+    HTTP.HttpExceptionRequest _ content ->+      case content of+        HTTP.StatusCodeException res bytes ->+          Internal.BadStatus_ (mkMetadata res) (toBody bytes)+        HTTP.ResponseTimeout ->+          Internal.Timeout_+        HTTP.ConnectionTimeout ->+          Internal.NetworkError_ "ConnectionTimeout"+        HTTP.ConnectionFailure err ->+          Internal.NetworkError_ (Text.fromList (Exception.displayException err))+        err ->+          Internal.NetworkError_ (Debug.toString err)++mkMetadata :: HTTP.Response a -> Internal.Metadata+mkMetadata response =+  let status = HTTP.responseStatus response+   in Internal.Metadata+        { Internal.metadataStatusCode = fromIntegral <| Status.statusCode status,+          Internal.metadataStatusText =+            status+              |> Status.statusMessage+              |> Data.Text.Encoding.decodeUtf8,+          Internal.metadataHeaders =+            List.foldl+              ( \(name, valueBS) ->+                  let value = Data.Text.Encoding.decodeUtf8 valueBS+                   in Dict.update+                        (Data.Text.Encoding.decodeUtf8 <| CI.original name)+                        ( \current ->+                            Just <| case current of+                              Just current_ -> current_ ++ ", " ++ value+                              Nothing -> value+                        )+              )+              Dict.empty+              (HTTP.responseHeaders response)+        }+ -- | -- Expect the response body to be JSON. expectJson :: Aeson.FromJSON a => Expect a@@ -259,6 +333,16 @@ expectWhatever = Internal.ExpectWhatever  -- |+-- Expect a `Response` with a `Text` body.+expectTextResponse :: (Internal.Response Text -> Result Error a) -> Expect a+expectTextResponse = Internal.ExpectTextResponse++-- |+-- Expect a `Response` with a `ByteString` body+expectBytesResponse :: (Internal.Response ByteString -> Result Error a) -> Expect a+expectBytesResponse = Internal.ExpectBytesResponse++-- | type Error = Internal.Error  -- Our Task type carries around some context values which should influence in@@ -343,7 +427,7 @@               |> (\showS -> Text.fromList (showS ""))        in Platform.tracingSpanIO             log-            "Outoing HTTP Request"+            "Outgoing HTTP Request"             ( \log' ->                 Exception.finally                   io

@@ -5,8 +5,10 @@  import qualified Control.Exception.Safe as Exception import qualified Data.Aeson as Aeson+import qualified Data.ByteString import qualified Data.ByteString.Lazy import qualified Data.Dynamic as Dynamic+import Dict (Dict) import qualified Network.HTTP.Client as HTTP import qualified Network.HTTP.Types.Header as Header import qualified Network.Mime as Mime@@ -52,6 +54,8 @@   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  -- | A 'Request' can fail in a couple of ways: --@@ -71,3 +75,38 @@ instance Exception.Exception Error  instance Aeson.ToJSON Error++-- | A 'Response' can come back a couple different ways:+--+-- - 'BadUrl_' — you did not provide a valid URL.+-- - 'Timeout_' — it took too long to get a response.+-- - 'NetworkError_' — the user turned off their wifi, went in a cave, etc.+-- - 'BadStatus_' — a response arrived, but the status code indicates failure.+-- - 'GoodStatus_' — a response arrived with a nice status code!+-- - The type of the body depends on whether you use expectStringResponse or expectBytesResponse.+data Response body+  = BadUrl_ Text+  | Timeout_+  | NetworkError_ Text+  | BadStatus_ Metadata body+  | GoodStatus_ Metadata body+  deriving (Generic, Eq, Show)++instance (Dynamic.Typeable body, Show body) => Exception.Exception (Response body)++instance (Aeson.ToJSON body) => Aeson.ToJSON (Response body)++-- Extra information about the response:+--+-- Note: It is possible for a response to have the same header multiple times. In that case, all the values end up in a single entry in the headers dictionary. The values are separated by commas, following the rules outlined [here](https://stackoverflow.com/questions/4371328/are-duplicate-http-response-headers-acceptable).+data Metadata = Metadata+  { -- statusCode like 200 or 404+    metadataStatusCode :: Int,+    -- statusText describing what the statusCode means a little+    metadataStatusText :: Text,+    -- headers like Content-Length and Expires+    metadataHeaders :: Dict Text Text+  }+  deriving (Generic, Eq, Show)++instance Aeson.ToJSON Metadata

@@ -122,7 +122,37 @@                   Task.succeed ()             )         urlsAccessed-          |> Expect.equal ["example.com/one", "example.com/two"]+          |> Expect.equal ["example.com/one", "example.com/two"],+      test "Using expectTextResponse, metadata returns the correct status" <| \() ->+        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)+          ),+      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)+          )     ]  -- # Wai applications to test against

@@ -9,9 +9,9 @@             { srcLocPackage = "main"             , srcLocModule = "Main"             , srcLocFile = "test/Main.hs"-            , srcLocStartLine = 191+            , srcLocStartLine = 221             , srcLocStartCol = 7-            , srcLocEndLine = 195+            , srcLocEndLine = 225             , srcLocEndCol = 40             }         )@@ -21,7 +21,7 @@   , allocated = 0   , children =       [ TracingSpan-          { name = "Outoing HTTP Request"+          { name = "Outgoing HTTP Request"           , started = MonotonicTime { inMicroseconds = 0 }           , finished = MonotonicTime { inMicroseconds = 0 }           , frame =@@ -31,9 +31,9 @@                     { srcLocPackage = "main"                     , srcLocModule = "Http"                     , srcLocFile = "src/Http.hs"-                    , srcLocStartLine = 344+                    , srcLocStartLine = 428                     , srcLocStartCol = 11-                    , srcLocEndLine = 356+                    , srcLocEndLine = 440                     , srcLocEndCol = 14                     }                 )