[fix] some minor corrections and improvements
This commit is contained in:
parent
f2a47f8b86
commit
49c51088f2
|
@ -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 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
|
||||
, inspectRequest_
|
||||
, dryRyn_
|
||||
|
||||
-- * useful reexports
|
||||
, module Reexports
|
||||
|
|
|
@ -11,7 +11,9 @@ module Network.HTTP.Barf.Internal
|
|||
, q_
|
||||
, h_
|
||||
, j_
|
||||
, v_
|
||||
, inspectRequest_
|
||||
, dryRun_
|
||||
|
||||
-- * internal
|
||||
, httpWithManager
|
||||
|
@ -35,15 +37,22 @@ import GHC.Generics (Generic)
|
|||
import GHC.IsList (IsList (Item, fromList, toList))
|
||||
import Network.HTTP.Client
|
||||
import Network.HTTP.Client.TLS (tlsManagerSettings)
|
||||
import System.Exit (exitFailure)
|
||||
import System.IO (hPutStrLn, stderr)
|
||||
import Prelude hiding (head)
|
||||
|
||||
-- | a data type representing an http request
|
||||
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)
|
||||
|
||||
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'}
|
||||
deriving
|
||||
|
@ -67,12 +76,10 @@ instance IsList Req where
|
|||
-- | creates a @GET@ request, use it like
|
||||
--
|
||||
-- @'get_' "http://localhost:8080"@
|
||||
-- or
|
||||
-- @'get_' "https://example.com"@
|
||||
get_
|
||||
:: MonadIO m
|
||||
=> String
|
||||
-- ^ the url to connect to
|
||||
-- ^ the url toiconnect to
|
||||
-> Req
|
||||
-- ^ the modifier(s) to the request
|
||||
-> m LazyByteString
|
||||
|
@ -81,8 +88,6 @@ get_ = httpWithManager "GET"
|
|||
-- | creates a @HEAD@ request, use it like
|
||||
--
|
||||
-- @'head_' "http://localhost:8080"@
|
||||
-- or
|
||||
-- @'head_' "https://example.com"@
|
||||
head_
|
||||
:: MonadIO m
|
||||
=> String
|
||||
|
@ -95,8 +100,6 @@ head_ = httpWithManager "HEAD"
|
|||
-- | creates a @DELETE@ request, use it like
|
||||
--
|
||||
-- @'delete_' "http://localhost:8080" []@
|
||||
-- or
|
||||
-- @'delete_' "https://example.com" []@
|
||||
delete_
|
||||
:: MonadIO m
|
||||
=> String
|
||||
|
@ -109,8 +112,6 @@ delete_ = httpWithManager "DELETE"
|
|||
-- | creates a @PUT@ request, use it like
|
||||
--
|
||||
-- @'put_' "http://localhost:8080" []@
|
||||
-- or
|
||||
-- @'put_' "https://example.com" []@
|
||||
put_
|
||||
:: MonadIO m
|
||||
=> String
|
||||
|
@ -123,8 +124,6 @@ put_ = httpWithManager "PUT"
|
|||
-- | creates a @POST@ request, use it like
|
||||
--
|
||||
-- @'post_' "http://localhost:8080" []@
|
||||
-- or
|
||||
-- @'post_' "https://example.com" []@
|
||||
post_
|
||||
:: MonadIO m
|
||||
=> String
|
||||
|
@ -141,8 +140,15 @@ buildRequestFromReq method url req = do
|
|||
. (\r -> r {requestBody = RequestBodyLBS $ Aeson.encode req.jsonBody})
|
||||
. (\r -> r {method = BS8.pack method})
|
||||
<$> parseRequest url
|
||||
let err = hPutStrLn stderr
|
||||
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
|
||||
|
||||
httpWithManager :: MonadIO m => String -> String -> Req -> m LazyByteString
|
||||
|
@ -169,15 +175,29 @@ h_
|
|||
-> Req
|
||||
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"
|
||||
--
|
||||
-- if the json body is already set, it *will be overwritten*
|
||||
j_
|
||||
:: Value
|
||||
:: Aeson.ToJSON a
|
||||
=> a
|
||||
-- ^ the value of the json body
|
||||
-> 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
|
||||
inspectRequest_ :: Req
|
||||
inspectRequest_ = MkReq \req -> req {inspectRequest = True}
|
||||
|
||||
-- | when set, do not execute the request
|
||||
dryRun_ :: Req
|
||||
dryRun_ = MkReq \req -> req {dryRun = True}
|
||||
|
|
Loading…
Reference in a new issue