import Network.HTTP.Server
import Network.HTTP.Server.Logger
import Network.HTTP.Base
import Network.HTTP.Headers
import Network.Socket.Internal
import Network.URL
-- displayListHdr :: [Header] -> [Char]
-- displayListHdr = concatMap show
hdrToHtml :: Header -> [Char]
hdrToHtml hdr = "\t\t\t\n"
++ "\t\t\t| " ++ name ++ " | \n"
++ "\t\t\t" ++ value ++ " | \n"
++ "\t\t\t
\n"
where
name = show $ hdrName hdr
value = hdrValue hdr
displayListHdr :: [Header] -> [Char]
displayListHdr hdrs = head ++ (body hdrs) ++ tail
where
head = "\n"
++ "\n"
++ "\t\n\tToto\n"
++ "\t\n"
++ "\t\n"
++ "\t\n"
++ "\t\t\n"
++ "\t\t\t\n"
++ "\t\t\t| NAME | \n"
++ "\t\t\tVALUE | \n"
++ "\t\t\t
\n"
tail = "\t\t
\n"
++ "\t\n"
body = concatMap hdrToHtml
copyHeaders :: SockAddr -> URL -> Request [Char] -> IO (Response [Char])
copyHeaders addr url req =
return Response {rspCode = (2,0,0)
,rspReason = "OK"
,rspHeaders = [Header HdrConnection "close"]
,rspBody = displayListHdr $ rqHeaders req}
main :: IO ()
main = serverWith config copyHeaders
where
config = Config { srvLog = quietLogger
, srvHost = "0.0.0.0"
, srvPort = 80 }