From 13567a1996c742faacd43d35e4ff2aacf0f4f91c Mon Sep 17 00:00:00 2001
From: Sharif Olorin <sio@tesser.org>
Date: Wed, 12 Aug 2015 08:18:33 +0000
Subject: [PATCH] Arbitrary instance for Request

Signed-off-by: Erik de Castro Lopo <erikd@mega-nerd.com>
---
 Network/HTTP/Proxy/Request/Arbitrary.hs | 78 +++++++++++++++++++++++++
 http-proxy.cabal                        |  4 ++
 2 files changed, 82 insertions(+)
 create mode 100644 Network/HTTP/Proxy/Request/Arbitrary.hs

diff --git a/Network/HTTP/Proxy/Request/Arbitrary.hs b/Network/HTTP/Proxy/Request/Arbitrary.hs
new file mode 100644
index 0000000..174c974
--- /dev/null
+++ b/Network/HTTP/Proxy/Request/Arbitrary.hs
@@ -0,0 +1,78 @@
+{-# LANGUAGE OverloadedStrings    #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+------------------------------------------------------------
+-- Copyright : Ambiata Pty Ltd
+-- Author : Sharif Olorin <sio@tesser.org>
+-- License : BSD3
+------------------------------------------------------------
+
+module Network.HTTP.Proxy.Request.Arbitrary(
+    Request ()
+) where
+
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as BS
+import Data.CaseInsensitive
+import Data.Monoid
+import Control.Applicative
+import Network.HTTP.Proxy.Request
+import Network.HTTP.Types
+import Test.QuickCheck
+
+
+stdMethod :: Gen ByteString
+stdMethod = elements [ "GET"
+                     , "POST"
+                     , "HEAD"
+                     , "PUT"
+                     , "DELETE"
+                     , "TRACE"
+                     , "CONNECT"
+                     , "OPTIONS"
+                     , "PATCH"
+                     ]
+
+instance Arbitrary HttpVersion where
+    arbitrary = elements [ http09
+                         , http10
+                         , http11
+                         ]
+
+ascii :: Gen ByteString
+ascii = BS.pack <$> (listOf1 (oneof [choose ('a', 'z'), choose ('0', '9')]))
+
+simpleUri :: Gen ByteString
+simpleUri = do
+    scheme' <- elements ["http://", "https://"]
+    host' <- listOf1 ascii
+    port' <- oneof [Just <$> ((arbitrary :: Gen Int) `suchThat` (> 0)), pure Nothing]
+    path' <- listOf ascii
+    pure . BS.concat $
+        [ scheme'
+        , BS.intercalate "." host'
+        , maybe "" (BS.pack . ((:) ':') . show) port'
+        , "/" <> (BS.intercalate "/" path')
+        ]
+
+-- The logic here should probably go into the Request type itself at some point.
+instance Arbitrary Request where
+    arbitrary = do
+        method' <- stdMethod
+        version' <- arbitrary
+        uri' <- simpleUri
+        headers' <- listOf header
+        qs' <- listOf qi
+        pure $ Request method'
+                       version'
+                       headers'
+                       uri'
+                       qs'
+      where
+        header :: Gen Header
+        header = (,) <$> ci <*> ascii
+
+        qi :: Gen QueryItem
+        qi = (,) <$> ascii <*> oneof [Just <$> ascii, pure Nothing]
+
+        ci :: Gen (CI ByteString)
+        ci = mk <$> ascii
diff --git a/http-proxy.cabal b/http-proxy.cabal
index b733164..3fdaf35 100644
--- a/http-proxy.cabal
+++ b/http-proxy.cabal
@@ -38,6 +38,8 @@ Library
                    , http-conduit            >= 2.1.7
                    , http-types              >= 0.8
                    , mtl                     >= 2.1
+                   , network-uri             >= 2.6
+                   , QuickCheck
                    , resourcet               >= 1.1
                    , tls                     >= 1.2
                    , text                    >= 1.2
@@ -49,6 +51,7 @@ Library
 
   Exposed-modules:   Network.HTTP.Proxy
   Other-modules:     Network.HTTP.Proxy.Request
+                     Network.HTTP.Proxy.Request.Arbitrary
 
   ghc-options:       -Wall -fwarn-tabs
   if os(windows)
@@ -70,6 +73,7 @@ Test-Suite testsuite
                    , http-conduit
                    , http-types
                    , hspec                   >= 2.1
+                   , QuickCheck
                    , network
                    , random                  >= 1.1
                    , resourcet