1{-# LANGUAGE TupleSections #-} 2{-# LANGUAGE CPP #-} 3 4module Network.Wai.Middleware.Rewrite 5 ( -- * How to use this module 6 -- $howto 7 8 -- ** A note on semantics 9 10 -- $semantics 11 12 -- ** Paths and Queries 13 14 -- $pathsandqueries 15 PathsAndQueries 16 17 -- ** An example rewriting paths with queries 18 19 -- $takeover 20 21 -- ** Upgrading from wai-extra ≤ 3.0.16.1 22 23 -- $upgrading 24 25 -- * 'Middleware' 26 27 -- ** Recommended functions 28 , rewriteWithQueries 29 , rewritePureWithQueries 30 , rewriteRoot 31 32 -- ** Deprecated 33 , rewrite 34 , rewritePure 35 36 -- * Operating on 'Request's 37 38 , rewriteRequest 39 , rewriteRequestPure 40 ) where 41 42import Network.Wai 43import Control.Monad.IO.Class (liftIO) 44import Data.Text (Text) 45import Data.Functor.Identity (Identity(..)) 46import qualified Data.Text.Encoding as TE 47import qualified Data.Text as T 48import Network.HTTP.Types as H 49 50-- GHC ≤ 7.10 does not export Applicative functions from the prelude. 51#if __GLASGOW_HASKELL__ <= 710 52import Control.Applicative 53#endif 54 55-- $howto 56-- This module provides 'Middleware' to rewrite URL paths. It also provides 57-- functions that will convert a 'Request' to a modified 'Request'. 58-- Both operations require a function that takes URL parameters and 59-- headers, and returns new URL parameters. Parameters are pieces of URL 60-- paths and query parameters. 61-- 62-- If you are a new user of the library, use 'rewriteWithQueries' or 63-- 'rewritePureWithQueries' for middleware. For modifying 'Request's 64-- directly, use 'rewriteRequest' or 'rewriteRequestPure'. 65 66-- $semantics 67-- 68-- Versions of this library in wai-extra ≤ 3.0.16.1 exported only 69-- 'rewrite' and 'rewritePure' and both modified 'rawPathInfo' of the 70-- underlying requests. Such modification has been proscribed. The 71-- semantics of these functions have not changed; instead the recommended 72-- approach is to use 'rewriteWithQueries' and 'rewritePureWithQueries'. 73-- The new functions are slightly different, as described in the section 74-- on upgrading; code for previous library versions can be upgraded with 75-- a single change, and as the type of the new function is different the 76-- compiler will indicate where this change must be made. 77-- 78-- The 'rewriteRequest' and 'rewriteRequestPure' functions use the new 79-- semantics, too. 80 81-- $pathsandqueries 82-- 83-- This library defines the type synonym `PathsAndQueries` to make code 84-- handling paths and queries easier to read. 85-- 86-- /e.g./ /\/foo\/bar/ would look like 87-- 88-- > ["foo", "bar"] :: Text 89-- 90-- /?bar=baz/ would look like 91-- 92-- > [("bar", Just "baz")] :: QueryText 93-- 94-- Together, 95-- 96-- /\/foo?bar=baz/ would look like 97-- 98-- > (["foo"],[("bar", Just "baz")]) :: PathsAndQueries 99 100-- $takeover 101-- Let’s say we want to replace a website written in PHP with one written 102-- using WAI. We’ll use the 103-- <https://hackage.haskell.org/package/http-reverse-proxy http-reverse-proxy> 104-- package to serve the old 105-- site from the new site, but there’s a problem. The old site uses pages like 106-- 107-- @ 108-- index.php?page=/page/ 109-- @ 110-- 111-- whereas the new site would look like 112-- 113-- @ 114-- index\//page/ 115-- @ 116-- 117-- In doing this, we want to separate the migration code from our new 118-- website. So we’d like to handle links internally using the path 119-- formulation, but externally have the old links still work. 120-- 121-- Therefore, we will use middleware ('rewritePureWithQueries') from this 122-- module to rewrite incoming requests from the query formulation to the 123-- paths formulation. 124-- 125-- > {-# LANGUAGE ViewPatterns #-} 126-- > 127-- > rewritePathFromPhp :: Middleware 128-- > rewritePathFromPhp = rewritePureWithQueries pathFromPhp 129-- > 130-- > pathFromPhp :: PathsAndQueries -> H.RequestHeaders -> PathsAndQueries 131-- > pathFromPhp (pieces, queries) _ = piecesConvert pieces queries 132-- > where 133-- > piecesConvert :: [Text] -> H.Query -> PathsAndQueries 134-- > piecesConvert ["index.php"] qs@(join . lookup "page" -> Just page) = 135-- > ( ["index", TE.decodeUtf8With TE.lenientDecode page] 136-- > , delete ("page", pure page) qs 137-- > ) 138-- > piecesConvert ps qs = (ps, qs) 139-- 140-- On the other side, we will use 'rewriteRequestPure' to rewrite outgoing 141-- requests to the original website from the reverse proxy code (using the 142-- 'Network.HTTP.ReverseProxy.WPRModifiedRequest' or 143-- 'Network.HTTP.ReverseProxy.WPRModifiedRequestSecure' constructors. Note, 144-- these links will only work if the haddock documentation for 145-- <https://hackage.haskell.org/package/http-reverse-proxy http-reverse-proxy> 146-- is installed). 147-- 148-- > rewritePhpFromPath :: Request -> Request 149-- > rewritePhpFromPath = rewriteRequestPure phpFromPath 150-- > 151-- > phpFromPath :: PathsAndQueries -> H.RequestHeaders -> PathsAndQueries 152-- > phpFromPath (pieces, queries) _ = piecesConvert pieces queries 153-- > where 154-- > piecesConvert :: [Text] -> H.Query -> PathsAndQueries 155-- > piecesConvert ["index", page] qs = ( ["index.php"], ("page", pure . TE.encodeUtf8 $ page) : qs ) 156-- > piecesConvert ps qs = (ps, qs) 157-- 158-- For the whole example, see 159-- <https://gist.github.com/dbaynard/c844d0df124f68ec8b6da152c581ce6d>. 160 161-- $upgrading 162-- It is quite simple to upgrade from 'rewrite' and 'rewritePure', to 163-- 'rewriteWithQueries' and 'rewritePureWithQueries'. 164-- Insert 'Data.Bifunctor.first', which specialises to 165-- 166-- @ 167-- 'Data.Bifunctor.first' :: (['Text'] -> ['Text']) -> 'PathsAndQueries' -> 'PathsAndQueries' 168-- @ 169-- 170-- as the following example demonstrates. 171-- 172-- Old versions of the library could only handle path pieces, not queries. 173-- This could have been supplied to 'rewritePure'. 174-- 175-- @ 176-- staticConvert' :: [Text] -> H.RequestHeaders -> [Text] 177-- staticConvert' pieces _ = piecesConvert pieces 178-- where 179-- piecesConvert [] = ["static", "html", "pages.html"] 180-- piecesConvert route@("pages":_) = "static":"html":route 181-- @ 182-- 183-- Instead, use this function, supplied to 'rewritePureWithQueries'. 184-- 185-- @ 186-- staticConvert :: 'PathsAndQueries' -> H.RequestHeaders -> 'PathsAndQueries' 187-- staticConvert pathsAndQueries _ = 'Data.Bifunctor.first' piecesConvert pathsAndQueries 188-- where 189-- piecesConvert [] = ["static", "html", "pages.html"] 190-- piecesConvert route@("pages":_) = "static":"html":route 191-- @ 192-- 193-- The former formulation is deprecated for two reasons: 194-- 195-- 1. The original formulation of 'rewrite' modified 'rawPathInfo', which 196-- is deprecated behaviour. 197-- 198-- 2. The original formulation did not allow query parameters to 199-- influence the path. 200-- 201-- Concerning the first point, take care with semantics of your program when 202-- upgrading as the upgraded functions no longer modify 'rawPathInfo'. 203 204-------------------------------------------------- 205-- * Types 206-------------------------------------------------- 207 208-- | A tuple of the path sections as ['Text'] and query parameters as 209-- 'H.Query'. This makes writing type signatures for the conversion 210-- function far more pleasant. 211-- 212-- Note that this uses 'H.Query' not 'H.QueryText' to more accurately 213-- reflect the paramaters that can be supplied in URLs. It may be safe to 214-- treat parameters as text; use the 'H.queryToQueryText' and 215-- 'H.queryTextToQuery' functions to interconvert. 216type PathsAndQueries = ([Text], H.Query) 217 218-------------------------------------------------- 219-- * Rewriting 'Middleware' 220-------------------------------------------------- 221 222-- | Rewrite based on your own conversion function for paths only, to be 223-- supplied by users of this library (with the conversion operating in 'IO'). 224-- 225-- For new code, use 'rewriteWithQueries' instead. 226rewrite :: ([Text] -> H.RequestHeaders -> IO [Text]) -> Middleware 227rewrite convert app req sendResponse = do 228 let convertIO = pathsOnly . curry $ liftIO . uncurry convert 229 newReq <- rewriteRequestRawM convertIO req 230 app newReq sendResponse 231{-# WARNING rewrite [ 232 "This modifies the 'rawPathInfo' field of a 'Request'." 233 , " This is not recommended behaviour; it is however how" 234 , " this function has worked in the past." 235 , " Use 'rewriteWithQueries' instead"] #-} 236 237-- | Rewrite based on pure conversion function for paths only, to be 238-- supplied by users of this library. 239-- 240-- For new code, use 'rewritePureWithQueries' instead. 241rewritePure :: ([Text] -> H.RequestHeaders -> [Text]) -> Middleware 242rewritePure convert app req = 243 let convertPure = pathsOnly . curry $ Identity . uncurry convert 244 newReq = runIdentity $ rewriteRequestRawM convertPure req 245 in app newReq 246{-# WARNING rewritePure [ 247 "This modifies the 'rawPathInfo' field of a 'Request'." 248 , " This is not recommended behaviour; it is however how" 249 , " this function has worked in the past." 250 , " Use 'rewritePureWithQueries' instead"] #-} 251 252-- | Rewrite based on your own conversion function for paths and queries. 253-- This function is to be supplied by users of this library, and operates 254-- in 'IO'. 255rewriteWithQueries :: (PathsAndQueries -> H.RequestHeaders -> IO PathsAndQueries) 256 -> Middleware 257rewriteWithQueries convert app req sendResponse = do 258 newReq <- rewriteRequestM convert req 259 app newReq sendResponse 260 261-- | Rewrite based on pure conversion function for paths and queries. This 262-- function is to be supplied by users of this library. 263rewritePureWithQueries :: (PathsAndQueries -> H.RequestHeaders -> PathsAndQueries) 264 -> Middleware 265rewritePureWithQueries convert app req = app $ rewriteRequestPure convert req 266 267-- | Rewrite root requests (/) to a specified path 268-- 269-- Note that /index.html/ in example below should already be a valid route. 270-- 271-- @ 272-- rewriteRoot "index.html" :: Middleware 273-- @ 274-- 275-- @since 3.0.23.0 276rewriteRoot :: Text -> Middleware 277rewriteRoot root = rewritePureWithQueries onlyRoot 278 where 279 onlyRoot ([], q) _ = ([root], q) 280 onlyRoot paths _ = paths 281 282-------------------------------------------------- 283-- * Modifying 'Request's directly 284-------------------------------------------------- 285 286-- | Modify a 'Request' using the supplied function in 'IO'. This is suitable for 287-- the reverse proxy example. 288rewriteRequest :: (PathsAndQueries -> H.RequestHeaders -> IO PathsAndQueries) 289 -> Request -> IO Request 290rewriteRequest convert req = 291 let convertIO = curry $ liftIO . uncurry convert 292 in rewriteRequestRawM convertIO req 293 294-- | Modify a 'Request' using the pure supplied function. This is suitable for 295-- the reverse proxy example. 296rewriteRequestPure :: (PathsAndQueries -> H.RequestHeaders -> PathsAndQueries) 297 -> Request -> Request 298rewriteRequestPure convert req = 299 let convertPure = curry $ Identity . uncurry convert 300 in runIdentity $ rewriteRequestRawM convertPure req 301 302-------------------------------------------------- 303-- * Helper functions 304-------------------------------------------------- 305 306-- | This helper function factors out the common behaviour of rewriting requests. 307rewriteRequestM :: (Applicative m, Monad m) 308 => (PathsAndQueries -> H.RequestHeaders -> m PathsAndQueries) 309 -> Request -> m Request 310rewriteRequestM convert req = do 311 (pInfo, qByteStrings) <- curry convert (pathInfo req) (queryString req) (requestHeaders req) 312 pure req {pathInfo = pInfo, queryString = qByteStrings} 313 314-- | This helper function preserves the semantics of wai-extra ≤ 3.0, in 315-- which the rewrite functions modify the 'rawPathInfo' parameter. Note 316-- that this has not been extended to modify the 'rawQueryInfo' as 317-- modifying either of these values has been deprecated. 318rewriteRequestRawM :: (Applicative m, Monad m) 319 => (PathsAndQueries -> H.RequestHeaders -> m PathsAndQueries) 320 -> Request -> m Request 321rewriteRequestRawM convert req = do 322 newReq <- rewriteRequestM convert req 323 let rawPInfo = TE.encodeUtf8 . T.intercalate "/" . pathInfo $ newReq 324 pure newReq { rawPathInfo = rawPInfo } 325{-# WARNING rewriteRequestRawM [ 326 "This modifies the 'rawPathInfo' field of a 'Request'." 327 , " This is not recommended behaviour; it is however how" 328 , " this function has worked in the past." 329 , " Use 'rewriteRequestM' instead"] #-} 330 331-- | Produce a function that works on 'PathsAndQueries' from one working 332-- only on paths. This is not exported, as it is only needed to handle 333-- code written for versions ≤ 3.0 of the library; see the 334-- example above using 'Data.Bifunctor.first' to do something similar. 335pathsOnly :: (Applicative m, Monad m) 336 => ([Text] -> H.RequestHeaders -> m [Text]) 337 -> PathsAndQueries -> H.RequestHeaders -> m PathsAndQueries 338pathsOnly convert psAndQs headers = (,[]) <$> convert (fst psAndQs) headers 339{-# INLINE pathsOnly #-} 340