Echo.hs

{-# LANGUAGE OverloadedStrings #-}
--------------------------------------------------------------------------------
module Echo where
--------------------------------------------------------------------------------
import Blaze.ByteString.Builder.Char.Utf8 (fromString)
import Data.ByteString (ByteString)
import Network.Wai as Wai
import Network.Wai.Handler.Warp as Warp
import Network.HTTP.Types (status200)
import Network.HTTP.Types.Header (hContentType)
--------------------------------------------------------------------------------
main = start 9000
--------------------------------------------------------------------------------
start :: Int -> IO ()
start port = do
  putStrLn ("Listening on port " ++ show port)
  run port app
--------------------------------------------------------------------------------
app :: Wai.Application
app req f = do
  putStrLn (show req ++ "\n")
  resp <- handler req
  f resp
--------------------------------------------------------------------------------
handler :: Request -> IO Response
handler req = do
  let query   = queryString req :: [(ByteString, Maybe ByteString)]
      method  = Wai.requestMethod  req
      headers = Wai.requestHeaders req
      path    = pathInfo req
      rawpath = rawPathInfo req
  body <- (Wai.requestBody req)
  return
    $ responseBuilder  status200
    [(hContentType, "text/plain")]
    $ fromString ( "\n"
                   ++ "Method          : " ++ (show method)  ++ "\n"
                   ++ "Path            : " ++ (show path)    ++ "\n"
                   ++ "Raw Path        : " ++ (show rawpath) ++ "\n"
                   ++ "Headers         : " ++ (show headers) ++ "\n"
                   ++ "Query String    : " ++ (show query)   ++ "\n"
                   ++ "Request Body    : " ++ (show body)    ++ "\n"
                   ++ "\n" )
--------------------------------------------------------------------------------