-- | HTTP.hs
-- A module which send data to board via HTTP.

module HTTP (
    sendPOST
) where

import ParseCmd

import Network.URI
import Network.HTTP
import Codec.Binary.UTF8.String
import Control.OldException

import Data.List

-- | Send POST request to board and return responce.
sendPOST :: String -> POSTData -> IO String
sendPOST url pdata = do
    -- formating http request
    let encodePair = joinTuple (urlEncode . encodeString)
        joinTuple f (a, b) = (f a)++"="++(f b)
        body = intercalate "&" $ map encodePair pdata

    -- send post data
    result <- try (post url body)
    return $ case result of
      Left _ -> ""
      Right str -> str

-- | Do post request and return responce body.
post :: String -> String -> IO String
post uriStr body = do
    let uri = maybe nullURI id $ parseURI uriStr
    result <- simpleHTTP (request uri body)
    return $ case result of
      Left _ -> ""
      Right resp -> rspBody resp

-- | Request construcion.
request :: URI -> String -> Request String
request uri body =
    Request { rqURI     = uri
            , rqMethod  = POST
            , rqHeaders = [ Header HdrContentLength (show $ length body)
                          , Header HdrContentType
                            "application/x-www-form-urlencoded; charset=utf-8"
                          ]
            , rqBody    = body
            }