diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,8 @@ -## [_Unreleased_](https://github.com/freckle/freckle-app/compare/freckle-http-v0.0.0.0...main) +## [_Unreleased_](https://github.com/freckle/freckle-app/compare/freckle-http-v0.1.0.0...main) + +## [v0.1.0.0](https://github.com/freckle/freckle-app/compare/freckle-http-v0.0.0.0...freckle-http-v0.1.0.0) + +Removes `Freckle.App.HttpSpec` which had been included by mistake. ## [v0.0.0.0](https://github.com/freckle/freckle-app/tree/freckle-http-v0.0.0.0/freckle-http) diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,1 +1,7 @@ # freckle-http + +`freckle-http` is a general-purpose toolkit for making HTTP requests. + +--- + +[CHANGELOG](./CHANGELOG.md) | [LICENSE](./LICENSE) diff --git a/freckle-http.cabal b/freckle-http.cabal --- a/freckle-http.cabal +++ b/freckle-http.cabal @@ -1,14 +1,14 @@ cabal-version: 1.18 name: freckle-http -version: 0.0.0.0 +version: 0.1.0.0 license: MIT license-file: LICENSE maintainer: Freckle Education homepage: https://github.com/freckle/freckle-app#readme bug-reports: https://github.com/freckle/freckle-app/issues -synopsis: ... +synopsis: Toolkit for making HTTP requests description: Please see README.md -category: Utils +category: HTTP build-type: Simple extra-source-files: package.yaml extra-doc-files: @@ -29,7 +29,6 @@ Freckle.App.Http.Header Freckle.App.Http.Paginate Freckle.App.Http.Retry - Freckle.App.HttpSpec Freckle.App.Test.Http Freckle.App.Test.Http.MatchRequest @@ -51,7 +50,7 @@ -Wno-safe -Wno-unsafe build-depends: - Blammo >=2.0.0.0, + Blammo >=2.1.0.0, Glob >=0.10.2, aeson >=2.0.3.0, annotated-exception >=0.2.0.4, @@ -63,15 +62,13 @@ errors >=2.3.0, extra >=1.7.13, filepath >=1.4.2.2, - freckle-memcached >=0.0.0.1, + freckle-memcached >=0.0.0.2, hs-opentelemetry-api >=0.1.0.0, - hspec >=2.8.1, http-client >=0.7.13.1, http-conduit >=2.3.5, http-link-header >=1.2.1, http-types >=0.12.3, lens >=5.1.1, - lens-aeson >=1.2.2, memcache >=0.3.0.1, monad-logger >=0.3.40, monad-validate >=1.3.0.0, @@ -97,6 +94,8 @@ hs-source-dirs: tests other-modules: Freckle.App.Http.CacheSpec + Freckle.App.HttpSpec + Freckle.App.Test.Http.MatchRequestSpec Paths_freckle_http default-language: GHC2021 @@ -119,11 +118,13 @@ base >=4.16.4.0 && <5, bytestring >=0.11.4.0, freckle-http, - hspec >=2.10.10, + freckle-prelude >=0.0.1.1, + hspec >=2.8.1, hspec-expectations-json >=1.0.0.7, hspec-expectations-lifted >=0.10.0, http-types >=0.12.3, lens >=5.1.1, + lens-aeson >=1.2.2, mtl >=2.2.2, time >=1.11.1.1, unordered-containers >=0.2.19.1, diff --git a/library/Freckle/App/HttpSpec.hs b/library/Freckle/App/HttpSpec.hs deleted file mode 100644 --- a/library/Freckle/App/HttpSpec.hs +++ /dev/null @@ -1,51 +0,0 @@ -module Freckle.App.HttpSpec - ( spec - ) where - -import Prelude - -import Control.Lens (to, (^?), _Left, _Right) -import Data.Aeson -import Data.Aeson.Lens -import Data.List.NonEmpty qualified as NE -import Freckle.App.Http -import Freckle.App.Test.Http -import Network.HTTP.Types.Status (status200) -import Test.Hspec - -spec :: Spec -spec = do - describe "httpJson" $ do - stubs <- runIO $ loadHttpStubsDirectory "tests/files" - - it "fetches JSON via HTTP" $ do - resp <- - flip runHttpStubsT stubs - . httpJson @_ @Value - $ parseRequest_ "https://www.stackage.org/lts-17.10" - - getResponseStatus resp `shouldBe` status200 - getResponseBody resp - ^? _Right - . key "snapshot" - . key "ghc" - . _String - `shouldBe` Just "8.10.4" - - it "places JSON parse errors in a Left body" $ do - resp <- - flip runHttpStubsT stubs - . httpJson @_ @[()] - $ parseRequest_ "https://www.stackage.org/lts-17.10" - - let expectedErrorMessages = - [ "Error in $: expected [a], encountered Object" - , "Error in $: parsing [] failed, expected Array, but encountered Object" - ] - - getResponseStatus resp `shouldBe` status200 - getResponseBody resp - ^? _Left - . to hdeErrors - . to NE.head - `shouldSatisfy` maybe False (`elem` expectedErrorMessages) diff --git a/library/Freckle/App/Test/Http.hs b/library/Freckle/App/Test/Http.hs --- a/library/Freckle/App/Test/Http.hs +++ b/library/Freckle/App/Test/Http.hs @@ -191,7 +191,7 @@ -- | Load stubs from the filesystem -- -- Within the given directory, files are expected to be named for scheme, then --- host, then path/port/query. +-- host, then path\/port\/query. -- -- Given, -- diff --git a/package.yaml b/package.yaml --- a/package.yaml +++ b/package.yaml @@ -1,9 +1,9 @@ name: freckle-http -version: 0.0.0.0 +version: 0.1.0.0 maintainer: Freckle Education -category: Utils +category: HTTP github: freckle/freckle-app -synopsis: ... +synopsis: Toolkit for making HTTP requests description: Please see README.md extra-doc-files: @@ -58,7 +58,7 @@ source-dirs: library dependencies: - Glob - - Blammo >= 2.0.0.0 + - Blammo - aeson - annotated-exception - bytestring @@ -70,13 +70,11 @@ - filepath - freckle-memcached - hs-opentelemetry-api - - hspec >= 2.8.1 - http-client - http-conduit >= 2.3.5 # addToRequestQueryString - http-link-header - http-types - lens - - lens-aeson - memcache - monad-logger - monad-validate @@ -101,11 +99,13 @@ - aeson - bytestring - freckle-http - - hspec + - freckle-prelude + - hspec >= 2.8.1 - hspec-expectations-json - hspec-expectations-lifted - http-types - lens + - lens-aeson - mtl - time - unordered-containers diff --git a/tests/Freckle/App/HttpSpec.hs b/tests/Freckle/App/HttpSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Freckle/App/HttpSpec.hs @@ -0,0 +1,51 @@ +module Freckle.App.HttpSpec + ( spec + ) where + +import Prelude + +import Control.Lens (to, (^?), _Left, _Right) +import Data.Aeson +import Data.Aeson.Lens +import Data.List.NonEmpty qualified as NE +import Freckle.App.Http +import Freckle.App.Test.Http +import Network.HTTP.Types.Status (status200) +import Test.Hspec + +spec :: Spec +spec = do + describe "httpJson" $ do + stubs <- runIO $ loadHttpStubsDirectory "tests/files" + + it "fetches JSON via HTTP" $ do + resp <- + flip runHttpStubsT stubs + . httpJson @_ @Value + $ parseRequest_ "https://www.stackage.org/lts-17.10" + + getResponseStatus resp `shouldBe` status200 + getResponseBody resp + ^? _Right + . key "snapshot" + . key "ghc" + . _String + `shouldBe` Just "8.10.4" + + it "places JSON parse errors in a Left body" $ do + resp <- + flip runHttpStubsT stubs + . httpJson @_ @[()] + $ parseRequest_ "https://www.stackage.org/lts-17.10" + + let expectedErrorMessages = + [ "Error in $: expected [a], encountered Object" + , "Error in $: parsing [] failed, expected Array, but encountered Object" + ] + + getResponseStatus resp `shouldBe` status200 + getResponseBody resp + ^? _Left + . to hdeErrors + . to NE.head + `shouldSatisfy` maybe False (`elem` expectedErrorMessages) diff --git a/tests/Freckle/App/Test/Http/MatchRequestSpec.hs b/tests/Freckle/App/Test/Http/MatchRequestSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Freckle/App/Test/Http/MatchRequestSpec.hs @@ -0,0 +1,115 @@ +module Freckle.App.Test.Http.MatchRequestSpec + ( spec + ) where + +import Freckle.App.Prelude + +import Freckle.App.Http + ( Request + , addAcceptHeader + , addRequestHeader + , parseRequest_ + , setRequestPath + ) +import Freckle.App.Test.Http.MatchRequest +import Network.HTTP.Types.Header (hAccept) +import Test.Hspec + +spec :: Spec +spec = do + describe "matchRequestFromUrl" $ do + context "matching complete requests" $ do + let + url = "https://localhost:3000/hello?world" + mr = matchRequestFromUrl url + + it "matches the same request" $ do + mr `shouldMatchRequest` parseRequest_ url + + it "matches on path, even if built relative" $ do + let req = parseRequest_ "https://localhost:3000/world?world" + mr `shouldMatchRequest` setRequestPath "hello" req + + it "matches on method" $ do + mr `shouldNotMatchRequest` parseRequest_ ("POST " <> url) + + it "matches on scheme" $ do + mr `shouldNotMatchRequest` parseRequest_ "http://localhost:3000/hello?world" + + it "matches on host" $ do + mr `shouldNotMatchRequest` parseRequest_ "https://localhost2:3000/hello?world" + + it "matches on port" $ do + mr `shouldNotMatchRequest` parseRequest_ "https://localhost:3001/hello?world" + + it "matches on path" $ do + mr `shouldNotMatchRequest` parseRequest_ "https://localhost:3000/world?world" + + it "matches on query" $ do + mr `shouldNotMatchRequest` parseRequest_ "https://localhost:3000/hello?wut" + + it "can match on everything unspecified" $ do + let mr = matchRequestFromUrl "https://" + + mr `shouldMatchRequest` parseRequest_ "https://example.com" + mr `shouldMatchRequest` parseRequest_ "https://example.com/" + mr `shouldMatchRequest` parseRequest_ "https://example.com/foo" + mr `shouldMatchRequest` parseRequest_ "https://example.com/bar" + + it "can match any path" $ do + let mr = matchRequestFromUrl "https://example.com" + + mr `shouldMatchRequest` parseRequest_ "https://example.com" + mr `shouldMatchRequest` parseRequest_ "https://example.com/" + mr `shouldMatchRequest` parseRequest_ "https://example.com/foo" + mr `shouldMatchRequest` parseRequest_ "https://example.com/bar" + + it "can match the root path explicitly" $ do + let mr = matchRequestFromUrl "https://example.com/" + + mr `shouldMatchRequest` parseRequest_ "https://example.com/" + mr `shouldMatchRequest` parseRequest_ "https://example.com" + mr `shouldNotMatchRequest` parseRequest_ "https://example.com/foo" + mr `shouldNotMatchRequest` parseRequest_ "https://example.com/bar" + + context "matching headers" $ do + let + url = "https://example.com/" + accept = "text/plain" + hasNoHeaders = parseRequest_ url + hasOnlyTheHeader = addAcceptHeader accept hasNoHeaders + hasExtraHeaders = addRequestHeader "User-Agent" "me" hasOnlyTheHeader + + it "can match headers exactly" $ do + let mr = matchRequestFromUrl url <> MatchHeaders [(hAccept, accept)] + + mr `shouldMatchRequest` hasOnlyTheHeader + mr `shouldNotMatchRequest` hasExtraHeaders + mr `shouldNotMatchRequest` hasNoHeaders + + it "can match headers-include" $ do + let mr = matchRequestFromUrl url <> MatchHeader (hAccept, accept) + + mr `shouldMatchRequest` hasOnlyTheHeader + mr `shouldMatchRequest` hasExtraHeaders + mr `shouldNotMatchRequest` hasNoHeaders + +shouldMatchRequest :: HasCallStack => MatchRequest -> Request -> IO () +mr `shouldMatchRequest` req = do + case matchRequest req mr of + Left err -> do + let preamble = unlines ["Expected to match request, but did not", "", show req] + expectationFailure $ preamble <> err + Right () -> pure () + +infix 1 `shouldMatchRequest` + +shouldNotMatchRequest :: HasCallStack => MatchRequest -> Request -> IO () +mr `shouldNotMatchRequest` req = do + case matchRequest req mr of + Left {} -> pure () + Right () -> do + let preamble = unlines ["Expected to NOT match request, but did", "", show req] + expectationFailure $ preamble <> showMatchRequest mr + +infix 1 `shouldNotMatchRequest`