[fix] some minor corrections and improvements

This commit is contained in:
mangoiv 2024-07-21 17:38:01 +02:00
parent f2a47f8b86
commit 49c51088f2
Signed by: mangoiv
SSH key fingerprint: SHA256:JlsRe4zkmS13EG6gMFNjv13Lw5rtoMPu3Lq69ZQTKF8
2 changed files with 38 additions and 17 deletions

View file

@ -1,4 +1,4 @@
-- | 'Nework.HTTP.Barf' is a http client library that tries to make scripting http requests as easy as possible. -- | 'Network.HTTP.Barf' is a http client library that tries to make scripting http requests as easy as possible.
-- It provides a monoidal combinator library that should not clash with 'Prelude' imports. -- It provides a monoidal combinator library that should not clash with 'Prelude' imports.
-- It delegates to and includes for convenience the great aeson library for e.g. decoding of json -- It delegates to and includes for convenience the great aeson library for e.g. decoding of json
-- --
@ -27,6 +27,7 @@ module Network.HTTP.Barf
-- ** debugging helpers -- ** debugging helpers
, inspectRequest_ , inspectRequest_
, dryRyn_
-- * useful reexports -- * useful reexports
, module Reexports , module Reexports

View file

@ -11,7 +11,9 @@ module Network.HTTP.Barf.Internal
, q_ , q_
, h_ , h_
, j_ , j_
, v_
, inspectRequest_ , inspectRequest_
, dryRun_
-- * internal -- * internal
, httpWithManager , httpWithManager
@ -35,15 +37,22 @@ import GHC.Generics (Generic)
import GHC.IsList (IsList (Item, fromList, toList)) import GHC.IsList (IsList (Item, fromList, toList))
import Network.HTTP.Client import Network.HTTP.Client
import Network.HTTP.Client.TLS (tlsManagerSettings) import Network.HTTP.Client.TLS (tlsManagerSettings)
import System.Exit (exitFailure)
import System.IO (hPutStrLn, stderr)
import Prelude hiding (head) import Prelude hiding (head)
-- | a data type representing an http request -- | a data type representing an http request
data Req' = MkReq' data Req' = MkReq'
{queryParams :: Vector (String, String), headers :: Vector (String, String), jsonBody :: Maybe Value, inspectRequest :: Bool} { queryParams :: Vector (String, String)
, headers :: Vector (String, String)
, jsonBody :: Maybe Value
, inspectRequest :: Bool
, dryRun :: Bool
}
deriving stock (Eq, Ord, Show, Generic) deriving stock (Eq, Ord, Show, Generic)
defaultReq' :: Req' defaultReq' :: Req'
defaultReq' = MkReq' {queryParams = mempty, headers = mempty, jsonBody = Nothing, inspectRequest = False} defaultReq' = MkReq' {queryParams = mempty, headers = mempty, jsonBody = Nothing, inspectRequest = False, dryRun = False}
newtype Req = MkReq {appReq :: Req' -> Req'} newtype Req = MkReq {appReq :: Req' -> Req'}
deriving deriving
@ -67,12 +76,10 @@ instance IsList Req where
-- | creates a @GET@ request, use it like -- | creates a @GET@ request, use it like
-- --
-- @'get_' "http://localhost:8080"@ -- @'get_' "http://localhost:8080"@
-- or
-- @'get_' "https://example.com"@
get_ get_
:: MonadIO m :: MonadIO m
=> String => String
-- ^ the url to connect to -- ^ the url toiconnect to
-> Req -> Req
-- ^ the modifier(s) to the request -- ^ the modifier(s) to the request
-> m LazyByteString -> m LazyByteString
@ -81,8 +88,6 @@ get_ = httpWithManager "GET"
-- | creates a @HEAD@ request, use it like -- | creates a @HEAD@ request, use it like
-- --
-- @'head_' "http://localhost:8080"@ -- @'head_' "http://localhost:8080"@
-- or
-- @'head_' "https://example.com"@
head_ head_
:: MonadIO m :: MonadIO m
=> String => String
@ -95,8 +100,6 @@ head_ = httpWithManager "HEAD"
-- | creates a @DELETE@ request, use it like -- | creates a @DELETE@ request, use it like
-- --
-- @'delete_' "http://localhost:8080" []@ -- @'delete_' "http://localhost:8080" []@
-- or
-- @'delete_' "https://example.com" []@
delete_ delete_
:: MonadIO m :: MonadIO m
=> String => String
@ -109,8 +112,6 @@ delete_ = httpWithManager "DELETE"
-- | creates a @PUT@ request, use it like -- | creates a @PUT@ request, use it like
-- --
-- @'put_' "http://localhost:8080" []@ -- @'put_' "http://localhost:8080" []@
-- or
-- @'put_' "https://example.com" []@
put_ put_
:: MonadIO m :: MonadIO m
=> String => String
@ -123,8 +124,6 @@ put_ = httpWithManager "PUT"
-- | creates a @POST@ request, use it like -- | creates a @POST@ request, use it like
-- --
-- @'post_' "http://localhost:8080" []@ -- @'post_' "http://localhost:8080" []@
-- or
-- @'post_' "https://example.com" []@
post_ post_
:: MonadIO m :: MonadIO m
=> String => String
@ -141,8 +140,15 @@ buildRequestFromReq method url req = do
. (\r -> r {requestBody = RequestBodyLBS $ Aeson.encode req.jsonBody}) . (\r -> r {requestBody = RequestBodyLBS $ Aeson.encode req.jsonBody})
. (\r -> r {method = BS8.pack method}) . (\r -> r {method = BS8.pack method})
<$> parseRequest url <$> parseRequest url
let err = hPutStrLn stderr
when req.inspectRequest do when req.inspectRequest do
print r err "request parameters"
err (show req)
err "the resulting request"
err (show r)
when req.dryRun do
err "dryrun, exiting"
exitFailure
pure r pure r
httpWithManager :: MonadIO m => String -> String -> Req -> m LazyByteString httpWithManager :: MonadIO m => String -> String -> Req -> m LazyByteString
@ -169,15 +175,29 @@ h_
-> Req -> Req
h_ k v = MkReq \req -> req {headers = (k, v) `V.cons` req.headers} h_ k v = MkReq \req -> req {headers = (k, v) `V.cons` req.headers}
-- | 'v_' like "value"
--
-- if the json body is already set, it *will be overwritten*
v_
:: Value
-- ^ the value of the json body
-> Req
v_ val = MkReq \req -> req {jsonBody = Just val}
-- | 'j_' like "json" -- | 'j_' like "json"
-- --
-- if the json body is already set, it *will be overwritten* -- if the json body is already set, it *will be overwritten*
j_ j_
:: Value :: Aeson.ToJSON a
=> a
-- ^ the value of the json body -- ^ the value of the json body
-> Req -> Req
j_ val = MkReq \req -> req {jsonBody = Just val} j_ val = MkReq \req -> req {jsonBody = Just (Aeson.toJSON val)}
-- | print the request before dispatching, useful for debugging -- | print the request before dispatching, useful for debugging
inspectRequest_ :: Req inspectRequest_ :: Req
inspectRequest_ = MkReq \req -> req {inspectRequest = True} inspectRequest_ = MkReq \req -> req {inspectRequest = True}
-- | when set, do not execute the request
dryRun_ :: Req
dryRun_ = MkReq \req -> req {dryRun = True}