File: CleanPath.hs

package info (click to toggle)
haskell-wai-extra 3.0.1.2-1
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 236 kB
  • ctags: 1
  • sloc: haskell: 2,177; makefile: 3
file content (30 lines) | stat: -rw-r--r-- 1,002 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
{-# LANGUAGE OverloadedStrings #-}
module Network.Wai.Middleware.CleanPath
    ( cleanPath
    ) where

import Network.Wai
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy as L
import Network.HTTP.Types (status301)
import Data.Text (Text)
import Data.Monoid (mconcat)

cleanPath :: ([Text] -> Either B.ByteString [Text])
          -> B.ByteString
          -> ([Text] -> Application)
          -> Application
cleanPath splitter prefix app env sendResponse =
    case splitter $ pathInfo env of
        Right pieces -> app pieces env sendResponse
        Left p -> sendResponse
                $ responseLBS status301
                  [("Location", mconcat [prefix, p, suffix])]
                $ L.empty
    where
        -- include the query string if present
        suffix =
            case B.uncons $ rawQueryString env of
                Nothing -> B.empty
                Just ('?', _) -> rawQueryString env
                _ -> B.cons '?' $ rawQueryString env