packages feed

nri-http 0.2.0.0 → 0.3.0.0

raw patch · 6 files changed

+45/−38 lines, 6 files

Files

nri-http.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           nri-http-version:        0.2.0.0+version:        0.3.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
src/Http.hs view
@@ -11,10 +11,11 @@     get,     post,     request,-    Internal.Request (..),+    Internal.Request' (..),+    Internal.Request,     Internal.Error (..), -    -- * Header,+    -- * Header     Internal.Header,     header, @@ -32,6 +33,7 @@     expectWhatever,      -- * Elaborate Expectations+    Expect',     expectTextResponse,     expectBytesResponse,     Internal.Response (..),@@ -56,7 +58,7 @@ import qualified Data.Text.Lazy import qualified Data.Text.Lazy.Encoding import qualified Dict-import Http.Internal (Body, Expect, Handler)+import Http.Internal (Body, Expect, Handler, Expect') import qualified Http.Internal as Internal import qualified Log.HttpRequest as HttpRequest import qualified Maybe@@ -108,7 +110,7 @@ -- QUICKS  -- | Create a @GET@ request.-get :: (Dynamic.Typeable x, Dynamic.Typeable a) => Handler -> Text -> Expect x a -> Task x a+get :: (Dynamic.Typeable x, Dynamic.Typeable a) => Handler -> Text -> Expect' x a -> Task x a get handler' url expect =   request     handler'@@ -122,7 +124,7 @@       }  -- | Create a @POST@ request.-post :: (Dynamic.Typeable x, Dynamic.Typeable a) => Handler -> Text -> Body -> Expect x a -> Task x a+post :: (Dynamic.Typeable x, Dynamic.Typeable a) => Handler -> Text -> Body -> Expect' x a -> Task x a post handler' url body expect =   request     handler'@@ -191,11 +193,11 @@     Dynamic.Typeable expect   ) =>   Handler ->-  Internal.Request x expect ->+  Internal.Request' x expect ->   Task x expect request Internal.Handler {Internal.handlerRequest} settings = handlerRequest settings -_request :: Platform.DoAnythingHandler -> HTTP.Manager -> Internal.Request x expect -> Task x 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@@ -224,7 +226,7 @@         HTTP.httpLbs finalRequest requestManager     pure <| handleResponse (Internal.expect settings) response -handleResponse :: Expect x a -> Either HTTP.HttpException (HTTP.Response Data.ByteString.Lazy.ByteString) -> Result x 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 ->@@ -325,27 +327,27 @@  -- | -- Expect the response body to be JSON.-expectJson :: Aeson.FromJSON a => Expect Error a+expectJson :: Aeson.FromJSON a => Expect a expectJson = Internal.ExpectJson  -- | -- Expect the response body to be a `Text`.-expectText :: Expect Error Text+expectText :: Expect Text expectText = Internal.ExpectText  -- | -- Expect the response body to be whatever. It does not matter. Ignore it!-expectWhatever :: Expect Error ()+expectWhatever :: Expect () expectWhatever = Internal.ExpectWhatever  -- | -- Expect a `Response` with a `Text` body.-expectTextResponse :: (Internal.Response Text -> Result x a) -> Expect x 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 x a) -> Expect x a+expectBytesResponse :: (Internal.Response ByteString -> Result x a) -> Expect' x a expectBytesResponse = Internal.ExpectBytesResponse  -- |
src/Http/Internal.hs view
@@ -17,25 +17,28 @@  -- | A handler for making HTTP requests. data Handler = Handler-  { handlerRequest :: forall e expect. (Dynamic.Typeable expect, Dynamic.Typeable e) => Request e expect -> Task e expect,+  { 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 simple request with the built-in 'Error' type.+type Request a = Request' Error a+ -- | A custom request.-data Request x a = Request+data Request' x a = Request   { -- | The request method, like @"GET"@ or @"PUT"@.     method :: Text,     -- | A list of request headers.     headers :: [Header],-    -- | The url, like @"https://fishes.com/salmon"@.+    -- | The url, like @\"https://fishes.com/salmon\"@.     url :: Text,     -- | The request body.     body :: Body,     -- | 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 x a+    expect :: Expect' x a   }  -- | An HTTP header for configuration requests.@@ -48,14 +51,16 @@     bodyContentType :: Maybe Mime.MimeType   } --- |--- Logic for interpreting a response body.-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 simple logic for interpreting a response body with the built-in 'Error' type.+type Expect a = Expect' Error a++-- | Logic for interpreting a response body.+data Expect' x a where+  ExpectJson :: Aeson.FromJSON a => Expect a+  ExpectText :: Expect Text+  ExpectWhatever :: Expect ()+  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: --
src/Http/Mock.hs view
@@ -37,13 +37,13 @@ data Stub a where   Stub ::     (Dynamic.Typeable e, Dynamic.Typeable expect) =>-    (Internal.Request e expect -> Task e (a, expect)) ->+    (Internal.Request' e expect -> Task e (a, expect)) ->     Stub a  -- | Create a 'Stub'. mkStub ::   (Dynamic.Typeable e, Dynamic.Typeable expect) =>-  (Internal.Request e expect -> Task e (a, expect)) ->+  (Internal.Request' e expect -> Task e (a, expect)) ->   Stub a mkStub = Stub @@ -97,7 +97,7 @@ -- submitted inside a 'stub' function. -- -- This will return 'Nothing' if the body cannot be parsed as UTF8 text.-getTextBody :: Internal.Request Internal.Error expect -> Maybe Text+getTextBody :: Internal.Request expect -> Maybe Text getTextBody req =   Data.Text.Encoding.decodeUtf8' (getBytesBody req)     |> eitherToMaybe@@ -106,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 Internal.Error expect -> Result Text a+getJsonBody :: Aeson.FromJSON a => Internal.Request expect -> Result Text a getJsonBody req =   case Aeson.eitherDecodeStrict (getBytesBody req) of     Prelude.Left err -> Err (Text.fromList err)@@ -114,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 Internal.Error expect -> ByteString+getBytesBody :: Internal.Request expect -> ByteString getBytesBody req =   Internal.body req     |> Internal.bodyContents@@ -125,7 +125,7 @@ -- -- This will return 'Nothing' if no header with that name was set on the -- request.-getHeader :: Text -> Internal.Request Internal.Error expect -> Maybe Text+getHeader :: Text -> Internal.Request expect -> Maybe Text getHeader name req =   Internal.headers req     |> List.map Internal.unHeader@@ -140,11 +140,11 @@  tryRespond ::   ( Dynamic.Typeable expect,-    Dynamic.Typeable a,-    Dynamic.Typeable e+    Dynamic.Typeable e,+    Dynamic.Typeable a   ) =>   List (Stub a) ->-  Internal.Request e expect ->+  Internal.Request' e expect ->   Task e (a, expect) tryRespond [] req =   let msg =
test/Main.hs view
@@ -58,7 +58,7 @@           (constant "12" Status.ok200)           ( \http url -> do               err <--                Http.get http url (Http.expectJson :: Http.Expect Http.Error Text)+                Http.get http url (Http.expectJson :: Http.Expect Text)                   |> Expect.fails               err                 |> Expect.equal (Http.BadBody "Error in $: parsing Text failed, expected String, but encountered Number")
test/golden-results/expected-http-span view
@@ -31,9 +31,9 @@                     { srcLocPackage = "main"                     , srcLocModule = "Http"                     , srcLocFile = "src/Http.hs"-                    , srcLocStartLine = 434+                    , srcLocStartLine = 436                     , srcLocStartCol = 11-                    , srcLocEndLine = 446+                    , srcLocEndLine = 448                     , srcLocEndCol = 14                     }                 )