diff --git a/src/Network/HTTP/Barf.hs b/src/Network/HTTP/Barf.hs index cf5f728..c5e6738 100644 --- a/src/Network/HTTP/Barf.hs +++ b/src/Network/HTTP/Barf.hs @@ -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 diff --git a/src/Network/HTTP/Barf/Internal.hs b/src/Network/HTTP/Barf/Internal.hs index f7f3523..0a06d9d 100644 --- a/src/Network/HTTP/Barf/Internal.hs +++ b/src/Network/HTTP/Barf/Internal.hs @@ -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}