@@ -24,6 +24,7 @@ module Network.Wai.Middleware.Approot
2424 , fromRequest
2525 -- * Functions for applications
2626 , getApproot
27+ , getApprootMay
2728 ) where
2829
2930import Control.Exception (Exception, throw)
@@ -34,7 +35,7 @@ import Data.Maybe (fromMaybe)
3435import Data.Typeable (Typeable)
3536import qualified Data.Vault.Lazy as V
3637import Network.Wai (Request, vault, Middleware, requestHeaderHost)
37−import Network.Wai.Request (appearsSecure)
38+import Network.Wai.Request (appearsSecure, guessApproot)
3839import System.Environment (getEnvironment)
3940import System.IO.Unsafe (unsafePerformIO)
4041
@@ -100,21 +101,23 @@ hardcoded ar = approotMiddleware (const $ return ar)
100101--
101102-- Since 3.0.7
102103fromRequest :: Middleware
103−fromRequest = approotMiddleware (return . extract)
104−
105−extract :: Request -> ByteString
106−extract req =
107− (if appearsSecure req then "https://" else "http://") `S.append`
108− (fromMaybe "localhost" (requestHeaderHost req))
104+fromRequest = approotMiddleware (return . guessApproot)
109105
110106data ApprootMiddlewareNotSetup = ApprootMiddlewareNotSetup
111107 deriving (Show, Typeable)
112108instance Exception ApprootMiddlewareNotSetup
113109
114110-- | Get the approot set by the middleware. If the middleware is not in use,
115−-- then this function will return an exception.
111+-- then this function will return an exception. For a total version of the
112+-- function, see 'getApprootMay'.
116113--
117114-- Since 3.0.7
118115getApproot :: Request -> ByteString
119−getApproot req = fromMaybe (throw ApprootMiddlewareNotSetup)
120− $ V.lookup approotKey $ vault req
116+getApproot = fromMaybe (throw ApprootMiddlewareNotSetup) . getApprootMay
117+
118+-- | A total version of 'getApproot', which returns 'Nothing' if the middleware
119+-- is not in use.
120+--
121+-- Since 3.0.7
122+getApprootMay :: Request -> Maybe ByteString
123+getApprootMay req = V.lookup approotKey $ vault req