restman 0.7.3.0 → 0.7.3.1
raw patch · 5 files changed
+226/−2 lines, 5 filesdep +aesondep +waidep +warp
Dependencies added: aeson, wai, warp
Files
- CHANGELOG.md +11/−0
- restman.cabal +8/−2
- test/HTTP/ClientIntegrationSpec.hs +148/−0
- test/HTTP/EchoServer.hs +57/−0
- test/Spec.hs +2/−0
CHANGELOG.md view
@@ -1,3 +1,14 @@+# v7.3.1 (2026-05-03)++## ✨ New Features++## 🐛 Bug Fixes++## 🏗️ Architecture Changes++## 📝 Administrivia Changes+- [`07d96e8`](https://gitlab.com/krakrjak/restman/-/commit/07d96e8) ✅ Add Local HTTP Echo Server+ # v7.3.0 (2026-05-02) ## ✨ New Features
restman.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.12 name: restman-version: 0.7.3.0+version: 0.7.3.1 license: BSD2 license-file: LICENSE copyright: Zac Slade or Boyd Stephen Smith Jr, 2024@@ -84,7 +84,9 @@ main-is: Spec.hs hs-source-dirs: test other-modules:+ HTTP.ClientIntegrationSpec HTTP.ClientSpec+ HTTP.EchoServer LibSpec TypesSpec UISpec@@ -98,12 +100,14 @@ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall build-depends: base >=4.7 && <5,+ aeson >=2.2.4.1 && <2.3, brick >=2.9 && <2.10, bytestring >=0.12.2.0 && <0.13, case-insensitive >=1.2.1.0 && <1.3, containers >=0.7 && <0.8, hedgehog >=1.5 && <1.6, http-client >=0.7.19 && <0.8,+ http-types >=0.12.4 && <0.13, restman, skylighting >=0.14.7 && <0.15, tasty >=1.5.4 && <1.6,@@ -111,4 +115,6 @@ tasty-hedgehog >=1.4.0.2 && <1.5, tasty-hunit >=0.10.2 && <0.11, text >=2.1.3 && <2.2,- vty >=6.4 && <6.5+ vty >=6.4 && <6.5,+ wai >=3.2.4 && <3.3,+ warp >=3.4.9 && <3.5
+ test/HTTP/ClientIntegrationSpec.hs view
@@ -0,0 +1,148 @@+{-# language OverloadedStrings #-}+module HTTP.ClientIntegrationSpec (tests) where++import Data.Aeson (FromJSON(..), eitherDecode, withObject, (.:))+import qualified Data.ByteString.Char8 as BS8+import qualified Data.ByteString.Lazy as BL+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import qualified Data.Text as T++import Test.Tasty+import Test.Tasty.HUnit++import qualified Network.HTTP.Client as HC++import Network.Wai.Handler.Warp (Port)++import HTTP.Client (Header, knownMethods, robustSettings)+import HTTP.EchoServer (withEchoServer)++-- ---------------------------------------------------------------------------+-- EchoResponse — mirrors the JSON produced by HTTP.EchoServer+-- ---------------------------------------------------------------------------++data EchoResponse = EchoResponse+ { echoMethod :: T.Text+ , echoPath :: T.Text+ , echoQuery :: T.Text+ , echoHeaders :: Map T.Text T.Text+ , echoBody :: T.Text+ } deriving (Eq, Show)++instance FromJSON EchoResponse where+ parseJSON = withObject "EchoResponse" $ \o ->+ EchoResponse+ <$> o .: "method"+ <*> o .: "path"+ <*> o .: "query"+ <*> o .: "headers"+ <*> o .: "body"++-- ---------------------------------------------------------------------------+-- Helpers+-- ---------------------------------------------------------------------------++echoURL :: Port -> String -> String+echoURL port path = "http://localhost:" <> show port <> path++-- | Build and send an HTTP request using the restman 'robustSettings' manager,+-- then decode the echo server's JSON response.+sendRequest+ :: HC.Manager+ -> String -- ^ Absolute URL+ -> String -- ^ HTTP method string+ -> [Header] -- ^ Extra request headers+ -> BL.ByteString -- ^ Request body (may be empty)+ -> IO EchoResponse+sendRequest mgr url method extraHdrs body = do+ req <- HC.parseRequest url+ let req' = req+ { HC.method = BS8.pack method+ , HC.requestBody = HC.RequestBodyLBS body+ , HC.requestHeaders = extraHdrs <> HC.requestHeaders req+ }+ resp <- HC.httpLbs req' mgr+ case eitherDecode (HC.responseBody resp) of+ Left err -> assertFailure ("Failed to decode echo response: " <> err)+ Right er -> pure er++-- ---------------------------------------------------------------------------+-- Tests+-- ---------------------------------------------------------------------------++tests :: TestTree+tests = testGroup "HTTP.Client (integration)"+ [ methodTests+ , headerTests+ , bodyTests+ ]++-- CONNECT requires proxy tunnelling semantics; HEAD strips the response body.+-- Both are excluded from the generic reflection test.+testableMethods :: [String]+testableMethods = filter (`notElem` ["CONNECT", "HEAD"]) knownMethods++methodTests :: TestTree+methodTests = testGroup "method reflection"+ [ testCase ("reflects " <> m) $ withEchoServer $ \port -> do+ mgr <- HC.newManager robustSettings+ er <- sendRequest mgr (echoURL port "/") m [] ""+ echoMethod er @?= T.pack m+ | m <- testableMethods+ ]++headerTests :: TestTree+headerTests = testGroup "header reflection"+ [ testCase "single custom header is echoed" $ withEchoServer $ \port -> do+ mgr <- HC.newManager robustSettings+ er <- sendRequest mgr (echoURL port "/") "GET"+ [("X-Restman-Test", "hello")] ""+ Map.lookup "x-restman-test" (echoHeaders er) @?= Just "hello"++ , testCase "multiple custom headers are all echoed" $ withEchoServer $ \port -> do+ mgr <- HC.newManager robustSettings+ er <- sendRequest mgr (echoURL port "/") "GET"+ [("X-Foo", "foo-value"), ("X-Bar", "bar-value")] ""+ Map.lookup "x-foo" (echoHeaders er) @?= Just "foo-value"+ Map.lookup "x-bar" (echoHeaders er) @?= Just "bar-value"++ , testCase "header value is preserved verbatim" $ withEchoServer $ \port -> do+ mgr <- HC.newManager robustSettings+ er <- sendRequest mgr (echoURL port "/") "GET"+ [("X-Custom", "value with spaces")] ""+ Map.lookup "x-custom" (echoHeaders er) @?= Just "value with spaces"+ ]++bodyTests :: TestTree+bodyTests = testGroup "body and path reflection"+ [ testCase "POST body is echoed" $ withEchoServer $ \port -> do+ mgr <- HC.newManager robustSettings+ er <- sendRequest mgr (echoURL port "/echo") "POST" [] "hello world"+ echoBody er @?= "hello world"++ , testCase "PUT body is echoed" $ withEchoServer $ \port -> do+ mgr <- HC.newManager robustSettings+ er <- sendRequest mgr (echoURL port "/data") "PUT" [] "{\"key\":\"value\"}"+ echoBody er @?= "{\"key\":\"value\"}"++ , testCase "PATCH body is echoed" $ withEchoServer $ \port -> do+ mgr <- HC.newManager robustSettings+ er <- sendRequest mgr (echoURL port "/patch") "PATCH" [] "patch-body"+ echoBody er @?= "patch-body"++ , testCase "path is reflected correctly" $ withEchoServer $ \port -> do+ mgr <- HC.newManager robustSettings+ er <- sendRequest mgr (echoURL port "/some/path") "GET" [] ""+ echoPath er @?= "/some/path"++ , testCase "query string is reflected correctly" $ withEchoServer $ \port -> do+ mgr <- HC.newManager robustSettings+ er <- sendRequest mgr (echoURL port "/search?q=restman&limit=10") "GET" [] ""+ echoQuery er @?= "?q=restman&limit=10"++ , testCase "empty body is reflected as empty text" $ withEchoServer $ \port -> do+ mgr <- HC.newManager robustSettings+ er <- sendRequest mgr (echoURL port "/") "GET" [] ""+ echoBody er @?= ""+ ]
+ test/HTTP/EchoServer.hs view
@@ -0,0 +1,57 @@+{-# language OverloadedStrings #-}+-- | A minimal WAI echo application and Tasty test fixture.+--+-- The server accepts any HTTP request and responds with a JSON object+-- reflecting the method, path, query string, request headers, and body.+-- Header names are normalised to lowercase for predictable assertions.+module HTTP.EchoServer (withEchoServer) where++import Data.Aeson (encode, object, (.=))+import qualified Data.ByteString.Lazy as BL+import qualified Data.CaseInsensitive as CI+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import Network.HTTP.Types (status200)+import Network.Wai+ ( Application+ , rawPathInfo+ , rawQueryString+ , requestHeaders+ , requestMethod+ , responseLBS+ , strictRequestBody+ )+import Network.Wai.Handler.Warp (Port, testWithApplication)++-- | WAI application that echoes request details back as JSON.+echoApp :: Application+echoApp req respond = do+ body <- strictRequestBody req+ let method = TE.decodeUtf8 (requestMethod req)+ path = TE.decodeUtf8 (rawPathInfo req)+ query = TE.decodeUtf8 (rawQueryString req)+ hdrs = Map.fromList+ [ (TE.decodeUtf8 (CI.foldedCase k), TE.decodeUtf8 v)+ | (k, v) <- requestHeaders req+ ] :: Map T.Text T.Text+ bodyTxt = TE.decodeUtf8 (BL.toStrict body)+ payload = object+ [ "method" .= method+ , "path" .= path+ , "query" .= query+ , "headers" .= hdrs+ , "body" .= bodyTxt+ ]+ respond $ responseLBS status200+ [("Content-Type", "application/json")]+ (encode payload)++-- | Bracket helper: spin up an echo server on a free OS-assigned port,+-- run the supplied action with that port number, then tear down the server.+--+-- Safe to use inside 'Test.Tasty.HUnit.testCase' — the server is+-- terminated even if the action throws an exception.+withEchoServer :: (Port -> IO a) -> IO a+withEchoServer = testWithApplication (pure echoApp)
test/Spec.hs view
@@ -24,6 +24,7 @@ import Skylighting.Format.Vty (attrColor, attrStyle, colorDistance, formatVty, vtyStyleAttr) +import qualified HTTP.ClientIntegrationSpec import qualified HTTP.ClientSpec import qualified LibSpec import qualified Props.HTTPClientProps@@ -49,6 +50,7 @@ tests :: TestTree tests = testGroup "restman" [ HTTP.ClientSpec.tests+ , HTTP.ClientIntegrationSpec.tests , LibSpec.tests , TypesSpec.tests , UISpec.tests