packages feed

restman 0.7.3.1 → 0.7.4.0

raw patch · 9 files changed

+232/−56 lines, 9 files

Files

CHANGELOG.md view
@@ -1,3 +1,17 @@+# v7.4.0 (2026-05-03)++## ✨ New Features++## 🐛 Bug Fixes++## 🏗️ Architecture Changes++## 📝 Administrivia Changes+- [`2f4e912`](https://gitlab.com/krakrjak/restman/-/commit/2f4e912) 📝  Improve cross-cutting Haddock documentation +- [`2d72200`](https://gitlab.com/krakrjak/restman/-/commit/2d72200) 📝  Fix Haddock doc typos and add export section grouping +- [`fadcc75`](https://gitlab.com/krakrjak/restman/-/commit/fadcc75) 📝  Improve Haddock documentation across all modules +- [`f59595d`](https://gitlab.com/krakrjak/restman/-/commit/f59595d) 🚨  resolve -Wtype-defaults warnings in LibSpec+ # v7.3.1 (2026-05-03)  ## ✨ New Features
app/TUI.hs view
@@ -1,4 +1,13 @@ {-# language DeriveGeneric #-}+{-|+Module: TUI++Legacy type definitions retained from the original project scaffold.++'Verb' and 'ReqConfig' were the initial design for the HTTP request abstraction.  They are+not currently used by the main application — see "HTTP.Client" and "Types" for the types+in active use.+-} module TUI where  -- ghc@@ -10,14 +19,27 @@ -- wreq import Network.Wreq (Options) --- Types of HTTP requests, extensible with Custom-data Verb = GET | HEAD | POST | PUT | DELETE | OPTIONS | PATCH | Custom T.Text+-- | Supported HTTP verbs, including an escape hatch for non-standard methods.+data Verb+  = GET     -- ^ HTTP GET+  | HEAD    -- ^ HTTP HEAD+  | POST    -- ^ HTTP POST+  | PUT     -- ^ HTTP PUT+  | DELETE  -- ^ HTTP DELETE+  | OPTIONS -- ^ HTTP OPTIONS+  | PATCH   -- ^ HTTP PATCH+  | Custom T.Text -- ^ Any non-standard method name.   deriving (Show, Eq, Generic) --- Resource Type for making requets+{-|+Configuration for a single HTTP request.++Bundles together the target URI, the wreq 'Options' (headers, auth, etc.), and the HTTP+verb to use.+-} data ReqConfig =   ReqConfig-    { _httpUri :: T.Text-    , _options :: Options-    , _verb :: Verb+    { _httpUri :: T.Text    -- ^ The request target URI.+    , _options :: Options   -- ^ wreq request options (headers, authentication, etc.).+    , _verb :: Verb         -- ^ The HTTP verb for the request.     } deriving (Show, Generic)
restman.cabal view
@@ -1,6 +1,6 @@ cabal-version:      1.12 name:               restman-version:            0.7.3.1+version:            0.7.4.0 license:            BSD2 license-file:       LICENSE copyright:          Zac Slade or Boyd Stephen Smith Jr, 2024@@ -10,7 +10,9 @@ bug-reports:        https://gitlab.com/krakrjak/restman/issues synopsis:           Web request TUI program. description:-    Please see the README on GitLab at <https://gitlab.com/krakrjak/restman#readme>+    A Brick-based TUI HTTP client powered by wreq. restman lets you compose+    and send HTTP requests from the terminal, with support for custom methods,+    headers, and inline syntax-highlighted response rendering via Skylighting.  category:           Web build-type:         Simple
src/HTTP/Client.hs view
@@ -1,15 +1,19 @@+{-# language OverloadedStrings #-} {-|-Create wreq options with a custom HTTP manager that has increased limits to handle captive portals and proxies.+Module: HTTP.Client -This sets:-- managerResponseTimeout to 30 seconds (prevents hanging on slow proxies)+Thin wrapper around wreq and http-client to provide a robust HTTP(S) connection manager+and re-export the subset of wreq and http-types symbols used throughout RESTman. -Note: The underlying http-client library has a hardcoded 8KB limit per header line that cannot-be configured in this version. Some sites (e.g., slashdot.org with its extensive Content-Security-Policy-header listing hundreds of domains) may exceed this limit. These sites will fail with an OverlongHeaders-exception. This is a known limitation of the http-client library version in use.+The key entry point is 'robustSettings', which configures an 'HC.ManagerSettings' with+a 30-second response timeout to prevent hangs on slow proxies or captive portals.++Note: The underlying http-client library has a hardcoded 8 KB limit per header line that+cannot be configured in this version. Some sites (e.g. slashdot.org with its extensive+@Content-Security-Policy@ header listing hundreds of domains) may exceed this limit and+will fail with an @OverlongHeaders@ exception. This is a known limitation of the+http-client library version in use. -}-{-# language OverloadedStrings #-} module HTTP.Client     ( -- * HTTP.Client helpers       UseDefaultHeaders(..)@@ -48,10 +52,18 @@  -- | Bool-ish (for now) with more descriptive names. data UseDefaultHeaders-  = ReplaceDefaultHeaders-  | AppendCustomToDefaultHeaders+  = ReplaceDefaultHeaders          -- ^ Discard wreq's default headers; use only custom headers.+  | AppendCustomToDefaultHeaders   -- ^ Keep wreq's default headers and append custom headers.   deriving (Eq, Ord, Enum, Bounded, Show, Read) +{-|+TLS-enabled 'HC.ManagerSettings' with a 30-second response timeout.++Use this when creating an 'HC.Manager' for RESTman so that requests do not+hang indefinitely on unresponsive proxies or captive portals.++> manager <- HC.newManager robustSettings+-} robustSettings :: HC.ManagerSettings robustSettings = HCT.tlsManagerSettings         { HC.managerResponseTimeout = HC.responseTimeoutMicro 30000000  -- 30 seconds
src/Lib.hs view
@@ -3,11 +3,10 @@ {-| Description: RESTman as a library -For the data inclined, I recommend starting with 'AppS', which is all the internal RESTman state.-For the logic inclined, I recommen starting with 'handleEvent', which is the main way the state is-manipulated over time.  The application handles command-line parsing and then calls into-'someFunc', which we never renamed from the stack template at it is responsible for building the-record of function required for a Bick application, also a reasonable starting place.+For the data inclined, start with 'AppS' in "Types", which holds all internal RESTman state.+For the logic inclined, start with 'handleEvent', which is the main entry point for state+changes over time.  'startUI' in "UI" is responsible for building the 'Brick.Main.App' record+and wiring everything together. -} module Lib     ( chooseCursor@@ -237,11 +236,13 @@ growTransparent = growWith backgroundFill -} --- | See 'growWith', this one uses ASCII SPC @' '@ to fill the padding.+{-|+Like 'growWith', but fills the padding with ASCII space characters @\' \'@.+-} growSpaces :: Int -> WideAlign -> Int -> VertAlign -> Image -> Image growSpaces = growWith (charFill currentAttr ' ') --- | Update a widget by changing the final render and no other properties (almost a lens)+-- | Apply a post-processing function to the rendered 'Image' of a widget without touching any other widget properties. postprocessImage :: (Image -> Image) -> Widget n -> Widget n postprocessImage process widget = widget{render = (imageL %~ process) <$> render widget} @@ -306,6 +307,12 @@ mainMenu :: Widget n mainMenu = hBox $ map (padLeftRight 2 . txt) [ "Headers", "Response Tools", "\x2026" ] +{-|+Intermediate record that bundles all focus-sensitive widgets built during a single 'draw' call.++Each field holds a pre-built widget; 'draw' selects the appropriate focused variant by+overriding the relevant field based on the current 'focus' in 'AppS'.+-} data FocusSensitive = MkFocusSensitive   { methodWidget :: Widget AppR   , urlWidget :: Widget AppR@@ -404,9 +411,11 @@         . vLimit 1         $ renderEditor (vBox . map txt) True hedit +-- | Toggle the @reverseVideo@ bit in a 'Style' to indicate keyboard focus. focusStyle :: Style -> Style focusStyle x = x `xor` reverseVideo +-- | Apply 'focusStyle' to the style component of an 'Attr', setting it explicitly if it was @Default@ or @KeepCurrent@. focusAttr :: Attr -> Attr focusAttr attr = attr { attrStyle = SetTo newStyle }  where@@ -415,14 +424,17 @@     KeepCurrent -> reverseVideo     SetTo style -> focusStyle style +-- | Modify the default attribute of a widget using 'focusAttr' to visually highlight it as focused. focusWidget :: Widget n -> Widget n focusWidget = modifyDefAttr focusAttr +-- | Render a raw UTF-8 'ByteString' as a fixed-size Brick widget using the current attribute. utf8 :: ByteString -> Widget n utf8 bytes = Widget Fixed Fixed $ do   c <- getContext   return emptyResult { image = utf8Bytestring' (c ^. attrL) bytes } +-- | Render a list of HTTP 'Header' pairs as a borderless two-column table. headersWidget :: [Header] -> Widget n headersWidget = renderTable . surroundingBorder False . rowBorders False . table . map headerRow  where@@ -720,6 +732,7 @@     updateExtent     zoom methodListL (handleListEvent e) +-- | Extract the concatenated text content of a 'Brick.Widgets.Edit.Editor' as a UTF-8 'ByteString'. getEditorUtf8 :: Editor Text n -> ByteString getEditorUtf8 = encodeUtf8 . mconcat . getEditContents @@ -758,11 +771,19 @@   exResponse ex = VI.text (VA.Attr VA.Default VA.Default VA.Default VA.Default) $ "[Exception: " <> LText.pack (show ex) <> "]"   responseContentType resp = fmap LBS.fromStrict $ resp ^? responseHeader "Content-Type" -{- Incoming ByteString for payload has not been pruned of invalid chacaters nor been tab expanded.+{-|+Render an HTTP response body (or an empty-body signal) as a Vty 'Image' with optional+syntax highlighting based on the @Content-Type@ header. -   - These operations are required to be compatible with Vty's text rendering. The require removing-   paticular characters like escape, tab, vertical tab, and new lines. The newslines are dealt with as part of the-   -}+The incoming payload 'ByteString' is passed through 'cleanPayload' before rendering to+strip characters that are incompatible with Vty's text rendering (e.g. @ESC@, vertical+tab).  Newlines are preserved — they are the line delimiters used by Vty's @vertCat@.++* If the body is 'Nothing', a placeholder @"-- No response body --"@ line is returned.+* If no @Content-Type@ is present, 'noSyntaxFound' is used.+* Otherwise the MIME type is looked up in the default extension map and the first matching+  skylighting 'Syntax' is used by 'highlighted'.+-} syntaxHighlightResponse :: Maybe LBS.ByteString -> Maybe LBS.ByteString -> Image syntaxHighlightResponse Nothing _ = VI.text (VA.Attr VA.Default VA.Default VA.Default VA.Default) "-- No response body --\n" syntaxHighlightResponse (Just payload) Nothing = noSyntaxFound $ cleanPayload payload@@ -775,12 +796,25 @@   mimeType = encodeUtf8 $ Text.takeWhile (/= ';') $ lbsToText contentType  +{-|+Sanitise a lazy 'ByteString' response body for display in Vty.++Decodes to 'Text' with lenient UTF-8 decoding, then:++* Strips @ESC@ (@\\ESC@) and vertical-tab (@\\v@) characters which would corrupt Vty output.+* Expands tab characters to four spaces.+-} cleanPayload :: LBS.ByteString -> Text cleanPayload = expandTabs . cleanText   where     cleanText = Text.filter (`notElem` ['\ESC', '\v']) . lbsToText     expandTabs = Text.replace "\t" "    " +{-|+Tokenise and render 'Text' using skylighting's 'pygments' theme for the given 'Syntax'.++Falls back to a plain error message image if tokenisation fails.+-} highlighted :: Syntax -> Text -> Image highlighted s t = case tokenize (TokenizerConfig defaultSyntaxMap False) s t of   Left err -> foldr ((<->) . VI.text (VA.Attr VA.Default VA.Default VA.Default VA.Default))@@ -788,12 +822,17 @@     ["-- Syntax highlighting error: ", LText.pack err, " --" , LText.fromStrict t]   Right sourceLines -> formatVty defaultFormatOpts pygments sourceLines +{-|+Render pre-cleaned 'Text' as a plain (unsyntaxed) Vty 'Image', one line per row.++Used when no matching 'Skylighting.Types.Syntax' can be found for the response content type.+-} noSyntaxFound :: Text -> Image noSyntaxFound payload = foldr     ((<->) . VI.text (VA.Attr VA.Default VA.Default VA.Default VA.Default))     VI.emptyImage     ("--Uknown Body Type --" : map LText.fromStrict (Text.lines payload)) --- Helper function to convert a lazy ByteString to Text in UTF-8 encoding+-- | Decode a lazy 'LBS.ByteString' to strict 'Text' using lenient UTF-8 decoding. lbsToText :: LBS.ByteString -> Text lbsToText = decodeUtf8With lenientDecode . toStrict
src/Skylighting/Format/Vty.hs view
@@ -6,6 +6,23 @@ {-# language FlexibleInstances #-} {-# language GeneralizedNewtypeDeriving #-} {-# language OverloadedStrings #-}+{-|+Module: Skylighting.Format.Vty++Converts skylighting token streams into Vty 'Image' values for display in the response+body viewport.++The public API mirrors the skylighting @Format@ convention:++* 'formatVty' is the top-level formatter analogous to @formatANSI@ / @formatHtml@.+* 'vtyStyleAttr' maps skylighting colour/style information to a Vty 'VA.Attr'.+* 'attrStyle' and 'attrColor' handle the individual style and colour components.+* 'colorDistance' computes a simple L1 distance between two 'Color' values, used by the+  colour-approximation instances when a terminal does not support true-colour.++The module also provides orphan 'ToColor' / 'FromColor' instances for+'Xterm256ColorCode' and @('ANSI.ColorIntensity', 'ANSI.Color')@.+-} module Skylighting.Format.Vty (          formatVty        , attrStyle@@ -60,10 +77,18 @@ import qualified Graphics.Vty.Image as VI  +{-|+Format a list of highlighted source lines as a Vty 'Image'.++This is the primary entry point for the Vty formatter.  It zips line numbers (starting+from 'startNumber' in 'FormatOptions') with the token-annotated source lines and+concatenates the resulting row images vertically.+-} formatVty :: FormatOptions -> Style -> [SourceLine] -> Image formatVty opts sty sls = foldr (<->) emptyImage $ zipWith (sourceLineToImage opts sty) [startNum..] sls     where startNum = LineNo $ startNumber opts +-- | Convert a single source line to a Vty 'Image', optionally prepending a line number. sourceLineToImage :: FormatOptions -> Style -> LineNo -> SourceLine -> Image sourceLineToImage opts sty lno = foldr (horizJoin . tokenToImage clv sty) prependLineNoImage     where prependLineNoImage = if numberLines opts@@ -74,15 +99,23 @@           lineNoBgc = lineNumberBackgroundColor sty `mplus` backgroundColor sty           clv = ansiColorLevel opts +-- | Convert a single skylighting 'Token' to a Vty 'Image' by looking up its 'TokenStyle'+-- in the active 'Style' and mapping it to a Vty attribute via 'vtyStyleAttr'. tokenToImage :: ANSIColorLevel -> Style -> Token -> Image tokenToImage clv sty (tokTy, tokText) = VI.text (vtyStyleAttr clv tokFgc tokBgc tokB tokI tokU) (LText.fromStrict tokText)     where TokenStyle tokFgcRaw tokBgcRaw tokB tokI tokU = fromMaybe defStyle . Map.lookup tokTy $ tokenStyles sty           tokFgc = tokFgcRaw `mplus` defaultColor sty           tokBgc = tokBgcRaw `mplus` backgroundColor sty -vtyStyleAttr :: ANSIColorLevel -- ^ color support level-            -> Maybe Color -- ^ foreground-            -> Maybe Color -- ^ background+{-|+Build a Vty 'VA.Attr' from skylighting style components.++The URL field of the attribute is always left at 'VA.Default' because Vty's hyperlink+support is not used by RESTman.+-}+vtyStyleAttr :: ANSIColorLevel -- ^ colour support level reported by the terminal+            -> Maybe Color -- ^ foreground colour (@Nothing@ → terminal default)+            -> Maybe Color -- ^ background colour (@Nothing@ → terminal default)             -> Bool -- ^ bold             -> Bool -- ^ italic             -> Bool -- ^ underlined@@ -93,6 +126,7 @@   (maybe VA.Default VA.SetTo (attrColor clv bgc))   VA.Default +-- | Combine bold, italic, and underline flags into a Vty 'VA.Style' bitmask. attrStyle :: Bool -> Bool -> Bool -> VA.Style attrStyle b i u = style     where@@ -101,6 +135,13 @@         italic = if i then VA.italic else VA.defaultStyleMask         style = bold .|. underline .|. italic +{-|+Map a skylighting 'Color' to a Vty 'VA.Color' at the requested colour-depth level.++Currently all three 'ANSIColorLevel' variants produce a true-colour @RGB@ value; the+distinction is preserved for future refinement (e.g. quantising to the nearest palette+entry for 16-colour terminals).+-} attrColor :: ANSIColorLevel -> Maybe Color -> Maybe VA.Color attrColor _clv Nothing = Nothing attrColor clv (Just (RGB r g b)) = case clv of@@ -129,6 +170,8 @@                   , ((ANSI.Vivid, ANSI.White  ), RGB 255 255 255)                   ] +-- | An xterm-256 palette index in the range @[0, 255]@.+-- Used when mapping skylighting 'Color' values to the nearest 256-colour terminal colour. newtype Xterm256ColorCode = Xterm256ColorCode { getXterm256ColorCode :: Word8 }     deriving (Show, Read, Eq, Ord, Enum, Bounded, Data, Typeable, Generic) @@ -409,13 +452,20 @@     -- Same algorithm as above     fromColor = findApproximateColor ansi256ColorList +-- | L1 (Manhattan) distance between two 'Color' values in RGB space.+-- Used by 'findApproximateColor' to find the nearest palette entry. colorDistance :: Color -> Color -> Int16 colorDistance (RGB r1 g1 b1) (RGB r2 g2 b2) = abs (fromIntegral r1 - fromIntegral r2)                                                 + abs (fromIntegral g1 - fromIntegral g2)                                                 + abs (fromIntegral b1 - fromIntegral b2) --- This is the most naïve possible nearest-neighbor search;--- it could almost certainly be optimized, if its speed matters at all.+{-|+Brute-force nearest-neighbour colour search using 'colorDistance'.++Scans the entire palette linearly and returns the palette key whose associated 'Color' is+closest to the query colour under the L1 metric.  The result is exact for palette colours+and an approximation otherwise.+-} findApproximateColor :: [(a, Color)] -> Color -> a findApproximateColor acs c = let ranked = map (\ac -> (ac, colorDistance c $ snd ac)) acs                       in fst . fst $ minimumBy (comparing snd) ranked
src/Types.hs view
@@ -1,3 +1,17 @@+{-|+Module: Types++Core data types for the RESTman TUI.++'AppS' is the top-level application state.  It is threaded through the Brick event loop and+holds all mutable information: the focused widget, editor contents, the HTTP connection+manager, and the last rendered response image.++'AppR' is the resource name type used to identify named Brick widgets (editors, viewports,+etc.).++See also 'Lib' for the functions that manipulate these types.+-} module Types     ( -- * Global Types for TUI manipulation       AppS(..)@@ -62,27 +76,34 @@   , methodList :: List AppR Method -- ^ Method selection   } --- | Application Resource Name+-- | Application Resource Name — identifies every named widget in the Brick widget tree. data AppR-  = MethodEditor-  | UrlEditor-  | DefaultHeadersToggle-  | ExistingCustomHeader CustomHeaderR-  | AddCustomHeader-  | ResponseBodyView-  | MethodSelector+  = MethodEditor       -- ^ The single-line editor for the HTTP method string.+  | UrlEditor          -- ^ The single-line editor for the target URL.+  | DefaultHeadersToggle -- ^ The checkbox-like widget for toggling default header use.+  | ExistingCustomHeader CustomHeaderR -- ^ One cell within the custom-headers table.+  | AddCustomHeader    -- ^ The @+@ button that creates a new custom header row.+  | ResponseBodyView   -- ^ The scrollable viewport that shows the response body.+  | MethodSelector     -- ^ The pop-up list used to pick an HTTP method.   deriving (Eq, Ord, Show) +{-|+Resource name for a single cell in the custom-headers table.++'listIndex' selects the row (0-based index into 'customHeaders' of 'AppS') and 'column'+selects which of the three cells in that row has focus.+-} data CustomHeaderR = MkCustomHeaderR   { listIndex :: !Int -- ^ target in 'customHeaders' from 'AppS'   , column :: !CustomHeaderColumn   }   deriving (Eq, Ord, Show) +-- | Which column of a custom-header row has focus. data CustomHeaderColumn-  = ActiveToggle-  | NameEditor-  | ValueEditor+  = ActiveToggle -- ^ The enabled/disabled checkbox column.+  | NameEditor   -- ^ The header-name editor column.+  | ValueEditor  -- ^ The header-value editor column.   deriving (Eq, Ord, Show)  -- | Alignment of one range strictly within another range both over a discete, totally ordered set.
src/UI.hs view
@@ -1,7 +1,19 @@ {-# language OverloadedStrings #-}+{-|+Module: UI +Top-level Brick application wiring for RESTman.++'mkInitialState' builds the initial 'AppS' from the values parsed on the command line.+'startUI' creates the HTTP manager, optionally performs an initial request when a URI is+supplied, and hands control to the Brick main loop.++The Brick 'App' record is assembled here; the individual draw, event-handling, and cursor+functions live in "Lib".+-} module UI-    ( mkInitialState+    ( -- * Application entry points+      mkInitialState     , startUI     ) where @@ -41,7 +53,8 @@ import Types  --- | Empty attribute map+-- | Attribute map for the application.  Sets reverse-video for the focused list item and+-- resets the border attribute to terminal defaults so borders inherit the terminal colour scheme. attrMap :: AppS -> AttrMap attrMap _ =   Brick.attrMap currentAttr@@ -79,8 +92,11 @@   }  {-|-As the poor name implies, not sure what to call the library entry point, or really even what it-should look like at this point.+Launch the RESTman TUI.++Creates a new HTTP 'HC.Manager' using 'robustSettings', builds the initial 'AppS' via+'mkInitialState', and — if a URI was supplied — fires an initial request before entering+the Brick event loop. -} startUI   :: String -- ^ Initial HTTP method
test/LibSpec.hs view
@@ -387,24 +387,24 @@       imageWidth img @?= 0       imageHeight img @?= 0   , testCase "image already wider than min: width unchanged" $ do-      let src = charFill VA.currentAttr '*' 10 1+      let src = charFill VA.currentAttr '*' (10 :: Int) 1           img = growWith (charFill VA.currentAttr ' ') 5 Min 1 Min src       imageWidth img @?= 10   , testCase "image already taller than min: height unchanged" $ do-      let src = charFill VA.currentAttr '*' 1 10+      let src = charFill VA.currentAttr '*' (1 :: Int) 10           img = growWith (charFill VA.currentAttr ' ') 1 Min 5 Min src       imageHeight img @?= 10   , testCase "Max wide alignment: grows to min width" $ do-      let img = growWith (charFill VA.currentAttr ' ') 10 Max 1 Min (charFill VA.currentAttr '*' 2 1)+      let img = growWith (charFill VA.currentAttr ' ') 10 Max 1 Min (charFill VA.currentAttr '*' (2 :: Int) 1)       imageWidth img @?= 10   , testCase "Max vert alignment: grows to min height" $ do-      let img = growWith (charFill VA.currentAttr ' ') 1 Min 5 Max (charFill VA.currentAttr '*' 1 2)+      let img = growWith (charFill VA.currentAttr ' ') 1 Min 5 Max (charFill VA.currentAttr '*' (1 :: Int) 2)       imageHeight img @?= 5   , testCase "MidL wide alignment: grows to min width" $ do-      let img = growWith (charFill VA.currentAttr ' ') 6 MidL 1 Min (charFill VA.currentAttr '*' 2 1)+      let img = growWith (charFill VA.currentAttr ' ') 6 MidL 1 Min (charFill VA.currentAttr '*' (2 :: Int) 1)       imageWidth img @?= 6   , testCase "MidG wide alignment: grows to min width" $ do-      let img = growWith (charFill VA.currentAttr ' ') 6 MidG 1 Min (charFill VA.currentAttr '*' 2 1)+      let img = growWith (charFill VA.currentAttr ' ') 6 MidG 1 Min (charFill VA.currentAttr '*' (2 :: Int) 1)       imageWidth img @?= 6   ]