---------------------------------------------------------
-- |
-- Module        : Hack.Middleware.Jsonp
-- Copyright     : Michael Snoyman
-- License       : BSD3
--
-- Maintainer    : Michael Snoyman <michael@snoyman.com>
-- Stability     : Unstable
-- Portability   : portable
--
-- Automatic wrapping of JSON responses to convert into JSONP.
--
---------------------------------------------------------
module Hack.Middleware.Jsonp (jsonp) where

import Hack
import Web.Encodings (decodeUrlPairs)
import Data.ByteString.Class (toLazyByteString)
import qualified Data.ByteString.Lazy as BS
import Data.Maybe (fromMaybe)
import Data.List (isInfixOf)

-- | Wrap json responses in a jsonp callback.
--
-- Basically, if the user requested a \"text\/javascript\" and supplied a
-- \"callback\" GET parameter, ask the application for an
-- \"application/json\" response, then convern that into a JSONP response,
-- having a content type of \"text\/javascript\" and calling the specified
-- callback function.
jsonp :: Middleware
jsonp app env = do
    let accept = fromMaybe "" $ lookup "HTTP_ACCEPT" $ http env
    let gets = decodeUrlPairs $ queryString env
    let callback :: Maybe String
        callback =
            if "text/javascript" `isInfixOf` accept
                then lookup "callback" gets
                else Nothing
    let env' =
            case callback of
                Nothing -> env
                Just _ -> env
                        { http = changeVal "HTTP_ACCEPT"
                                           "application/json"
                                           $ http env
                        }
    res <- app env'
    case callback of
            Nothing -> return res
            Just c -> return $ res
                    { headers = changeVal "Content-type"
                                          "text/javascript"
                                          $ headers res
                    , body = BS.concat
                                [ toLazyByteString c
                                , toLazyByteString "("
                                , body res
                                , toLazyByteString ")"
                                ]
                    }

changeVal :: String -> String -> [(String, String)] -> [(String, String)]
changeVal key val old = (key, val) : filter (\(k, _) -> k /= key) old