@@ -31,11 +31,86 @@
3131-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
3232-- POSSIBILITY OF SUCH DAMAGE.
3333
34+{-# LANGUAGE DataKinds #-}
35+{-# LANGUAGE FlexibleInstances #-}
36+{-# LANGUAGE OverloadedStrings #-}
37+{-# LANGUAGE RankNTypes #-}
38+{-# LANGUAGE RecordWildCards #-}
39+{-# OPTIONS_GHC -fno-warn-orphans #-}
40+
3441module Network.HTTP.ReqSpec
3542 ( spec )
3643where
3744
45+import Control.Exception (throwIO)
46+import Control.Monad.Reader
47+import Data.ByteString (ByteString)
48+import Network.HTTP.Req
3849import Test.Hspec
50+import Test.QuickCheck
51+import qualified Data.ByteString as B
52+import qualified Network.HTTP.Client as L
3953
4054spec :: Spec
41−spec = return ()
55+spec = do
56+ describe "getHttpConfig" $ do
57+ it "has effect on resulting request" $ do
58+ property $ \config -> do
59+ request <- runReaderT (req_ GET url NoReqBody mempty) config
60+ L.proxy request `shouldBe` httpConfigProxy config
61+ L.redirectCount request `shouldBe` httpConfigRedirectCount config
62+
63+----------------------------------------------------------------------------
64+-- Instances
65+
66+instance MonadHttp IO where
67+ handleHttpException = throwIO
68+
69+instance MonadHttp (ReaderT HttpConfig IO) where
70+ handleHttpException = liftIO . throwIO
71+ getHttpConfig = ask
72+
73+instance Arbitrary HttpConfig where
74+ arbitrary = do
75+ httpConfigProxy <- arbitrary
76+ httpConfigRedirectCount <- arbitrary
77+ let httpConfigAltManager = Nothing
78+ httpConfigCheckResponse _ _ = return ()
79+ return HttpConfig {..}
80+
81+instance Show HttpConfig where
82+ show HttpConfig {..} =
83+ "HttpConfig\n" ++
84+ "{ httpConfigProxy=" ++ show httpConfigProxy ++ "\n" ++
85+ ", httpRedirectCount=" ++ show httpConfigRedirectCount ++ "\n" ++
86+ ", httpConfigAltManager=<cannot be shown>\n" ++
87+ ", httpConfigCheckResponse=<cannot be shown>}\n"
88+
89+instance Arbitrary L.Proxy where
90+ arbitrary = L.Proxy <$> arbitrary <*> arbitrary
91+
92+instance Arbitrary ByteString where
93+ arbitrary = B.pack <$> arbitrary
94+
95+----------------------------------------------------------------------------
96+-- Helpers
97+
98+-- | 'req' that just returns the prepared 'L.Request'.
99+
100+req_
101+ :: ( MonadHttp m
102+ , HttpMethod method
103+ , HttpBody body
104+ , HttpBodyAllowed (AllowsBody method) (ProvidesBody body) )
105+ => method -- ^ HTTP method
106+ -> Url scheme -- ^ 'Url' — location of resource
107+ -> body -- ^ Body of the request
108+ -> Option scheme -- ^ Collection of optional parameters
109+ -> m L.Request -- ^ Vanilla request
110+req_ method url' body options =
111+ responseRequest <$> req method url' body returnRequest options
112+
113+-- | A dummy 'Url'.
114+
115+url :: Url 'Https
116+url = https "httpbin.org"