Skip to content
This repository
Browse code

Add deprecation shims for rqRemoteAddr and rqRemotePort.

  • Loading branch information...
commit abdfd628949565ff47657cc749a51146cf2b0731 1 parent f819079
Gregory Collins authored April 07, 2014
6  src/Snap/Core.hs
@@ -108,6 +108,10 @@ module Snap.Core
108 108
   , rqModifyParams
109 109
   , rqSetParam
110 110
 
  111
+    -- *** Deprecated functions
  112
+  , rqRemoteAddr
  113
+  , rqRemotePort
  114
+
111 115
     -- ** Responses
112 116
   , emptyResponse
113 117
   , setResponseCode
@@ -158,7 +162,7 @@ module Snap.Core
158 162
   ) where
159 163
 
160 164
 ------------------------------------------------------------------------------
161  
-import           Snap.Internal.Http.Types (Cookie (..), HasHeaders (..), HttpVersion, Method (..), Params, Request (rqClientAddr, rqClientPort, rqContentLength, rqContextPath, rqCookies, rqHeaders, rqHostName, rqIsSecure, rqLocalHostname, rqMethod, rqParams, rqPathInfo, rqPostParams, rqQueryParams, rqQueryString, rqServerAddr, rqServerPort, rqURI, rqVersion), Response (rspStatus, rspStatusReason), addHeader, addResponseCookie, clearContentLength, deleteHeader, deleteResponseCookie, emptyResponse, formatHttpTime, getHeader, getResponseCookie, getResponseCookies, listHeaders, modifyResponseBody, modifyResponseCookie, parseHttpTime, rqModifyParams, rqParam, rqPostParam, rqQueryParam, rqSetParam, setContentLength, setContentType, setHeader, setResponseBody, setResponseCode, setResponseStatus)
  165
+import           Snap.Internal.Http.Types (Cookie (..), HasHeaders (..), HttpVersion, Method (..), Params, Request (rqClientAddr, rqClientPort, rqContentLength, rqContextPath, rqCookies, rqHeaders, rqHostName, rqIsSecure, rqLocalHostname, rqMethod, rqParams, rqPathInfo, rqPostParams, rqQueryParams, rqQueryString, rqServerAddr, rqServerPort, rqURI, rqVersion), Response (rspStatus, rspStatusReason), addHeader, addResponseCookie, clearContentLength, deleteHeader, deleteResponseCookie, emptyResponse, formatHttpTime, getHeader, getResponseCookie, getResponseCookies, listHeaders, modifyResponseBody, modifyResponseCookie, parseHttpTime, rqModifyParams, rqParam, rqPostParam, rqQueryParam, rqRemoteAddr, rqRemotePort, rqSetParam, setContentLength, setContentType, setHeader, setResponseBody, setResponseCode, setResponseStatus)
162 166
 import           Snap.Internal.Instances  ()
163 167
 import           Snap.Internal.Parsing    (buildUrlEncoded, parseUrlEncoded, printUrlEncoded, urlDecode, urlEncode, urlEncodeBuilder)
164 168
 import           Snap.Internal.Routing    (route, routeLocal)
11  src/Snap/Internal/Http/Types.hs
@@ -816,3 +816,14 @@ statusReasonMap = IM.fromList [
816 816
         (504, "Gateway Time-out"),
817 817
         (505, "HTTP Version not supported")
818 818
     ]
  819
+
  820
+
  821
+------------------------------------------------------------------------------
  822
+-- Deprecated functions
  823
+rqRemoteAddr :: Request -> ByteString
  824
+rqRemoteAddr = rqClientAddr
  825
+{-# DEPRECATED rqRemoteAddr "(snap-core >= 1.0.0.0) please use rqClientAddr, this will be removed in 1.1.*" #-}
  826
+
  827
+rqRemotePort :: Request -> Int
  828
+rqRemotePort = rqClientPort
  829
+{-# DEPRECATED rqRemotePort "(snap-core >= 1.0.0.0) please use rqClientPort, this will be removed in 1.1.*" #-}
11  test/Snap/Core/Tests.hs
... ...
@@ -1,3 +1,5 @@
  1
+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
  2
+
1 3
 {-# LANGUAGE BangPatterns        #-}
2 4
 {-# LANGUAGE OverloadedStrings   #-}
3 5
 {-# LANGUAGE Rank2Types          #-}
@@ -36,7 +38,7 @@ import           Data.Text                            (Text)
36 38
 import qualified Data.Text.Encoding                   as T (encodeUtf8)
37 39
 import           Data.Text.Lazy                       ()
38 40
 import           Prelude                              (Bool (..), Either (..), Enum (..), Eq (..), IO, Int, Maybe (Just, Nothing), Num (..), Ord (..), Show (..), String, const, either, flip, id, map, maybe, not, seq, undefined, ($), ($!), (&&), (++), (.))
39  
-import           Snap.Internal.Http.Types             (Cookie (Cookie), Method (..), Request (rqBody, rqClientAddr, rqContextPath, rqIsSecure, rqURI), Response (rspContentLength, rspStatus, rspStatusReason, rspTransformingRqBody), addHeader, deleteHeader, emptyResponse, getHeader, setContentLength, setHeader, setResponseCode, setResponseStatus, statusReasonMap)
  41
+import           Snap.Internal.Http.Types             (Cookie (Cookie), Method (..), Request (rqBody, rqClientAddr, rqContextPath, rqIsSecure, rqURI), Response (rspContentLength, rspStatus, rspStatusReason, rspTransformingRqBody), addHeader, deleteHeader, emptyResponse, getHeader, rqRemoteAddr, setContentLength, setHeader, setResponseCode, setResponseStatus, statusReasonMap)
40 42
 import           Snap.Internal.Parsing                (urlDecode, urlEncode)
41 43
 import           Snap.Internal.Types                  (EscapeSnap (..), MonadSnap (..), NoHandlerException (NoHandlerException), Snap, addToOutput, bracketSnap, catchFinishWith, dir, escapeHttp, evalSnap, finishWith, getParam, getParams, getPostParam, getPostParams, getQueryParam, getQueryParams, getRequest, getResponse, getsResponse, ifTop, ipHeaderFilter, localRequest, logError, method, methods, modifyResponse, pass, path, pathArg, putRequest, putResponse, readRequestBody, redirect, redirect', runRequestBody, runSnap, setTimeout, terminateConnection, transformRequestBody, updateContextPath, withRequest, withResponse, writeBS, writeLBS, writeLazyText, writeText)
42 44
 import qualified Snap.Test                            as Test (RequestType (RequestWithRawBody), buildRequest, evalHandler, get, getResponseBody, postRaw, runHandler, setRequestType)
@@ -745,7 +747,7 @@ testIpHeaderFilter = testCase "core/ipHeaderFilter" $ do
745 747
     assertEqual "ipHeaderFilter" "1.2.3.4" b
746 748
 
747 749
 
748  
-    (_,r2) <- go f
  750
+    (_,r2) <- go f'
749 751
     b2 <- getBody r2
750 752
     assertEqual "ipHeaderFilter" "127.0.0.1" b2
751 753
 
@@ -755,6 +757,11 @@ testIpHeaderFilter = testCase "core/ipHeaderFilter" $ do
755 757
         ip <- liftM rqClientAddr getRequest
756 758
         writeBS ip
757 759
 
  760
+    f' = do
  761
+        ipHeaderFilter
  762
+        ip <- liftM rqRemoteAddr getRequest
  763
+        writeBS ip
  764
+
758 765
 
759 766
 ------------------------------------------------------------------------------
760 767
 testMZero404 :: Test
12  test/Snap/Util/Proxy/Tests.hs
... ...
@@ -1,3 +1,5 @@
  1
+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
  2
+
1 3
 {-# LANGUAGE BangPatterns      #-}
2 4
 {-# LANGUAGE OverloadedStrings #-}
3 5
 
@@ -9,7 +11,7 @@ import           Data.ByteString.Char8          (ByteString)
9 11
 import qualified Data.ByteString.Char8          as S
10 12
 import           Data.CaseInsensitive           (CI (..))
11 13
 import qualified Data.Map                       as Map
12  
-import           Snap.Core                      (Request (rqClientAddr, rqClientPort), Snap, withRequest)
  14
+import           Snap.Core                      (Request (rqClientAddr, rqClientPort), Snap, rqRemotePort, withRequest)
13 15
 import           Snap.Test                      (RequestBuilder, evalHandler, get, setHeader)
14 16
 import           Snap.Test.Common               (coverEqInstance, coverOrdInstance, coverReadInstance, coverShowInstance)
15 17
 import           Snap.Util.Proxy                (ProxyType (NoProxy, X_Forwarded_For), behindProxy)
@@ -83,7 +85,7 @@ testForwardedFor = testCase "proxy/forwarded-for" $ do
83 85
   where
84 86
     handler = behindProxy X_Forwarded_For $ do
85 87
                   !a <- reportRemoteAddr
86  
-                  !p <- reportRemotePort
  88
+                  !p <- reportRemotePort'
87 89
                   return $! (a,p)
88 90
 
89 91
     ip      = "5.6.7.8"
@@ -129,6 +131,12 @@ reportRemotePort = withRequest $ \req -> return $ rqClientPort req
129 131
 
130 132
 
131 133
 ------------------------------------------------------------------------------
  134
+-- Cover deprecated rqRemotePort
  135
+reportRemotePort' :: Snap Int
  136
+reportRemotePort' = withRequest $ \req -> return $ rqRemotePort req
  137
+
  138
+
  139
+------------------------------------------------------------------------------
132 140
 forwardedFor' :: CI ByteString              -- ^ header name
133 141
               -> [(ByteString, Maybe Int)]  -- ^ list of "forwarded-for"
134 142
               -> RequestBuilder IO ()

0 notes on commit abdfd62

Please sign in to comment.
Something went wrong with that request. Please try again.