[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 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
|
||||||
|
|
|
@ -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}
|
||||||
|
|
Loading…
Reference in a new issue