{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE CPP #-}
import Test.Hspec
import Test.HUnit
import Control.Applicative
import Control.Monad
import Control.Exception (Exception, toException)
import Data.Monoid
import qualified Data.ByteString as S
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Network.Wai hiding (requestBody, requestHeaders)
import qualified Network.Wai as Wai
import Network.Wai.Handler.Warp (run)
import Network.HTTP.Conduit
#if MIN_VERSION_http_conduit(1,9,0)
import Network.HTTP.Conduit.Internal (receiveSetCookie)
#endif
import Network.HTTP.Conduit.Browser
import Data.ByteString.Base64 (encode)
import Data.Typeable (Typeable)
import Control.Concurrent (forkIO, killThread)
import Network.HTTP.Types
import Control.Exception.Lifted (try)
import Data.CaseInsensitive (mk)
import qualified Data.ByteString.Lazy as L
import Data.IORef
import Control.Monad.IO.Class (liftIO)
import Data.Time.Clock
import Data.Time.Calendar
import Web.Cookie

-- TODO tests for responseTimeout/Browser.timeout.

data TestException = TestException
    deriving (Show, Typeable)

instance Exception TestException

utf8String :: String -> S.ByteString
utf8String = TE.encodeUtf8 . T.pack

strictToLazy :: S.ByteString -> L.ByteString
strictToLazy = L.fromChunks . replicate 1

lazyToStrict :: L.ByteString -> S.ByteString
lazyToStrict = S.concat . L.toChunks

dummy :: S.ByteString
dummy = "dummy"

user :: S.ByteString
user = "user"

pass :: S.ByteString
pass = "pass"

failure :: L.ByteString
failure = "failure"

success :: L.ByteString
success = "success"

appWithSideEffect :: IORef Bool -> Application
appWithSideEffect ref _ = liftIO $ do
    v <- readIORef ref
    writeIORef ref $ not v
    if v
        then return $ responseLBS status500 [] failure
        else return $ responseLBS status200 [] success

app :: Application
app req =
    case pathInfo req of
        [] -> return $ responseLBS status200 [] "homepage"
        ["cookies"] -> return $ responseLBS status200 [tastyCookie] "cookies"
        ["print-cookies"] -> return $ responseLBS status200 [] $ getHeader "Cookie"
        ["useragent"] -> return $ responseLBS status200 [] $ getHeader "User-Agent"
        ["accept"] -> return $ responseLBS status200 [] $ getHeader "Accept"
        ["authorities"] -> return $ responseLBS status200 [] $ getHeader "Authorization"
        ["redir1"] -> return $ responseLBS temporaryRedirect307 [redir2] L.empty
        ["redir2"] -> return $ responseLBS temporaryRedirect307 [redir3] L.empty
        ["redir3"] -> return $ responseLBS status200 [] $ strictToLazy dummy
        ["cookie_redir2"] -> return $ responseLBS status303 [("Set-Cookie", "baka=baka;"), (hLocation, "/checkcookie")] ""
        ["checkcookie"] -> return $
            if "flavor=chocolate-chip;baka=baka" == getHeader hCookie
                then responseLBS status200 [] "nom-nom-nom"
                else responseLBS status200 [] $ getHeader "Cookie"
        _ -> return $ responseLBS status404 [] "not found"

    where tastyCookie = (mk (utf8String "Set-Cookie"), utf8String "flavor=chocolate-chip;")
          getHeader s = strictToLazy $ case lookup s $ Wai.requestHeaders req of
                            Just a -> a
                            Nothing -> S.empty
          redir2 = (mk (utf8String "Location"), utf8String "/redir2")
          redir3 = (mk (utf8String "Location"), utf8String "/redir3")

main :: IO ()
main = do
    ref <- newIORef True
    hspec $ do
        describe "browser" $ do
            it "cookie jar works" $ do
                tid <- forkIO $ run 3011 app
                request1 <- parseUrl "http://127.0.0.1:3011/cookies"
                request2 <- parseUrl "http://127.0.0.1:3011/print-cookies"
                elbs <- withManager $ \manager -> do
                    browse manager $ do
                        _ <- makeRequestLbs request1
                        makeRequestLbs request2
                killThread tid
                if lazyToStrict (responseBody elbs) /= "flavor=chocolate-chip"
                     then error "Should have gotten the cookie back!"
                     else return ()
            it "cookie filter can deny cookies" $ do
                tid <- forkIO $ run 3011 app
                request1 <- parseUrl "http://127.0.0.1:3011/cookies"
                request2 <- parseUrl "http://127.0.0.1:3011/print-cookies"
                elbs <- withManager $ \manager -> do
                    browse manager $ do
                        setCookieFilter $ const $ const $ return False
                        _ <- makeRequestLbs request1
                        makeRequestLbs request2
                killThread tid
                if lazyToStrict (responseBody elbs) /= S.empty
                     then error "Shouldn't have gotten the cookie back!"
                     else return ()
            it "custom cookies in global cookie jar survive redirects" $ do
                tid <- forkIO $ run 3019 app
                req <- parseUrl "http://127.0.0.1:3019/cookie_redir2"
                let setCookie = def
                        { setCookieName = "flavor"
                        , setCookieValue = "chocolate-chip" }
                    default_time = UTCTime (ModifiedJulianDay 56200) (secondsToDiffTime 0)
                elbs <- withManager $ \manager -> do
                    browse manager $ do
                        setCookieJar =<< receiveSetCookie setCookie req default_time True <$> getCookieJar
                        responseBody <$> makeRequestLbs req
                killThread tid
                elbs @?= "nom-nom-nom"
#if MIN_VERSION_http_conduit(1,9,0)
            it "custom cookies in Request's cookie jar survive redirects" $ do
                tid <- forkIO $ run 3019 app
                req <- parseUrl "http://127.0.0.1:3019/cookie_redir2"
                let setCookie = def
                        { setCookieName = "flavor"
                        , setCookieValue = "chocolate-chip" }
                    default_time = UTCTime (ModifiedJulianDay 56200) (secondsToDiffTime 0)
                elbs <- withManager $ \manager -> do
                    browse manager $ do
                        cjar <- receiveSetCookie setCookie req default_time True <$> getCookieJar
                        let request = req {cookieJar = Just cjar}
                        responseBody <$> makeRequestLbs request
                killThread tid
                liftIO $ elbs @?= "nom-nom-nom"
            it "custom cookies in Request's cookie jar take priority over global cookiejar" $ do
                tid <- forkIO $ run 3019 app
                req <- parseUrl "http://127.0.0.1:3019/cookie_redir2"
                let setCookie a = def
                        { setCookieName = "flavor"
                        , setCookieValue = a }
                    default_time = UTCTime (ModifiedJulianDay 56200) (secondsToDiffTime 0)
                elbs <- withManager $ \manager -> do
                    browse manager $ do
                        cjar_glb <- receiveSetCookie (setCookie "another-cookie") req default_time True <$> getCookieJar
                        setCookieJar cjar_glb
                        cjar_req <- receiveSetCookie (setCookie "chocolate-chip") req default_time True <$> getCookieJar
                        let request = req {cookieJar = Just cjar_req}
                        responseBody <$> makeRequestLbs request
                killThread tid
                liftIO $ elbs @?= "nom-nom-nom"
#endif
            it "can save and load cookie jar" $ do
                tid <- forkIO $ run 3011 app
                request1 <- parseUrl "http://127.0.0.1:3011/cookies"
                request2 <- parseUrl "http://127.0.0.1:3011/print-cookies"
                (lbs1, lbs2) <- withManager $ \manager -> do
                    browse manager $ do
                        _ <- makeRequestLbs request1
                        cookie_jar <- getCookieJar
                        setCookieJar def
                        lbs1 <- responseBody <$> makeRequestLbs request2
                        setCookieJar cookie_jar
                        lbs2 <- responseBody <$> makeRequestLbs request2
                        return (lbs1, lbs2)
                killThread tid
                when (lbs1 /= "" || lbs2 /= "flavor=chocolate-chip") $
                    error "Cookie jar got garbled up!"
            it "user agent sets correctly" $ do
                tid <- forkIO $ run 3012 app
                request <- parseUrl "http://127.0.0.1:3012/useragent"
                elbs <- withManager $ \manager -> do
                    browse manager $ do
                        setDefaultHeader "User-Agent" $ Just "abcd"
                        makeRequestLbs request
                killThread tid
                when (responseBody elbs /= "abcd") $
                    error "Should have gotten the user agent back!"
            it "default headers propagate" $ do
                tid <- forkIO $ run 3012 app
                request <- parseUrl "http://127.0.0.1:3012/useragent"
                elbs <- withManager $ \manager -> do
                    browse manager $ do
                        setDefaultHeader "User-Agent" $ Just "abcd"
                        makeRequestLbs request
                killThread tid
                responseBody elbs @?= "abcd"
            it "default headers get overriden" $ do
                tid <- forkIO $ run 3012 app
                request <- parseUrl "http://127.0.0.1:3012/useragent"
                elbs <- withManager $ \manager -> do
                    browse manager $ do
                        setDefaultHeader "User-Agent" $ Just "bwahaha"
                        makeRequestLbs request{requestHeaders = [(hUserAgent, "abcd")]}
                killThread tid
                responseBody elbs @?= "abcd"
            it "user agent overrides" $ do
                tid <- forkIO $ run 3012 app
                request <- parseUrl "http://127.0.0.1:3012/useragent"
                elbs <- withManager $ \manager -> do
                    browse manager $ do
                        setOverrideHeader hUserAgent $ Just $ utf8String "abcd"
                        makeRequestLbs request{requestHeaders = [(hUserAgent, "bwahaha")]}
                killThread tid
                responseBody elbs @?= "abcd"
            it "doesn't override additional headers" $ do
                tid <- forkIO $ run 3012 app
                request <- parseUrl "http://127.0.0.1:3012/accept"
                elbs <- withManager $ \manager -> do
                    browse manager $ do
                        insertOverrideHeader ("User-Agent", "http-conduit")
                        insertOverrideHeader ("Connection", "keep-alive")
                        makeRequestLbs request{requestHeaders = [("User-Agent", "another agent"), ("Accept", "everything/digestible")]}
                killThread tid
                when (responseBody elbs /= "everything/digestible") $
                    error "Shouldn't have deleted Accept header!"
            it "withOverrideHeader: doesn't override additional headers" $ do
                tid <- forkIO $ run 3012 app
                request1 <- parseUrl "http://127.0.0.1:3012/accept"
                request2 <- parseUrl "http://127.0.0.1:3012/useragent"
                (lbs1, lbs2) <- withManager $ flip browse $ do
                    insertOverrideHeader ("User-Agent", "another agent")
                    withOverrideHeader ("User-Agent", "http-conduit") $
                        insertOverrideHeader ("Accept", "everything/digestible")
                    r1 <- responseBody <$> makeRequestLbs request1
                    r2 <- responseBody <$> makeRequestLbs request2
                    return (r1,r2)
                killThread tid
                when (lbs1 /= "everything/digestible") $
                    error "Shouldn't have deleted Accept header!"
                when (lbs2 /= "another agent") $
                    error "Shouldn't have overriden user agent!"
            it "authorities get set correctly" $ do
                tid <- forkIO $ run 3013 app
                request <- parseUrl "http://127.0.0.1:3013/authorities"
                elbs <- withManager $ \manager -> do
                    browse manager $ do
                        setAuthorities $ const $ Just (user, pass)
                        makeRequestLbs request
                killThread tid
                if lazyToStrict (responseBody elbs) /= (utf8String "Basic " `mappend` (encode $ user `mappend` ":" `mappend` pass))
                     then error "Authorities didn't get set correctly!"
                     else return ()
            it "can follow redirects" $ do
                tid <- forkIO $ run 3014 app
                request <- parseUrl "http://127.0.0.1:3014/redir1"
                elbs <- withManager $ \manager -> do
                    browse manager $ do
                        setMaxRedirects $ Just 2
                        makeRequestLbs request
                killThread tid
                if lazyToStrict (responseBody elbs) /= dummy
                     then error "Should be able to follow 2 redirects"
                     else return ()
            it "max redirects fails correctly" $ do
                tid <- forkIO $ run 3015 app
                request <- parseUrl "http://127.0.0.1:3015/redir1"
                elbs <- try $ withManager $ \manager -> do
                    browse manager $ do
                        setMaxRedirects $ Just 1
                        makeRequestLbs request
                killThread tid
                case elbs of
                     Left (TooManyRedirects _) -> return ()
                     _ -> error "Shouldn't have followed all those redirects!"
            it "Retry fails correctly when it is too low" $ do
                writeIORef ref True
                tid <- forkIO $ run 3016 $ appWithSideEffect ref
                request <- parseUrl "http://127.0.0.1:3016/"
                elbs <- try $ withManager $ \manager -> do
                    browse manager $ do
                        setMaxRetryCount 0
                        makeRequestLbs request
                killThread tid
                case elbs of
                     Left StatusCodeException{} -> return ()
                     _ -> error "1 redirect shouldn't be enough!"
            it "Makes multiple retries" $ do
                writeIORef ref True
                tid <- forkIO $ run 3017 $ appWithSideEffect ref
                request <- parseUrl "http://127.0.0.1:3017/"
                elbs <- withManager $ \manager -> do
                    browse manager $ do
                        setMaxRetryCount 1
                        makeRequestLbs request
                killThread tid
                if responseBody elbs /= success
                     then error "Didn't retry failed request"
                     else return ()
            it "throws statusCodeException, when maxRedirects=0" $ do
                tid <- forkIO $ run 3015 app
                request <- parseUrl "http://127.0.0.1:3015/redir1"
                elbs <- try $ withManager $ \manager -> do
                    browse manager $ do
                        setMaxRedirects $ Just 0
                        makeRequestLbs request
                killThread tid
                case elbs of
                     Left StatusCodeException{} -> return ()
                     _ -> error "Should've thrown StatusCodeException!"
            it "doesn't override redirectCount when maxRedirects=Nothing" $ do
                tid <- forkIO $ run 3015 app
                request <- parseUrl "http://127.0.0.1:3015/redir1"
                elbs <- try $ withManager $ \manager -> do
                    browse manager $ do
                        setMaxRedirects Nothing
                        makeRequestLbs request{redirectCount = 0}
                killThread tid
                case elbs of
                     Left StatusCodeException{} -> return ()
                     _ -> error "redirectCount /= 0!"
            it "overrides redirectCount when maxRedirects/=Nothing" $ do
                tid <- forkIO $ run 3015 app
                request <- parseUrl "http://127.0.0.1:3015/redir1"
                elbs <- try $ withManager $ \manager -> do
                    browse manager $ do
                        setMaxRedirects $ Just 0
                        makeRequestLbs request{redirectCount = 10}
                killThread tid
                case elbs of
                     Left StatusCodeException{} -> return ()
                     _ -> error "redirectCount should be 0!"
            it "uses checkStatus correctly" $ do
                tid <- forkIO $ run 3012 app
                request <- parseUrl "http://127.0.0.1:3012/useragent"
                elbs <- try $ withManager $ \manager -> do
                    browse manager $ do
                        setCheckStatus $ Just $  \ _ _ _ -> Just $ toException TestException
                        makeRequestLbs request
                killThread tid
                case elbs of
                    Left TestException -> return ()
                    _ -> error "Should have thrown an exception!"
            it "updates location" $ do
                tid <- forkIO $ run 3014 app
                request <- parseUrl "http://127.0.0.1:3014/"
                loc <- withManager $ \manager -> do
                    browse manager $ do
                        _ <- makeRequestLbs request
                        getLocation
                killThread tid
                if (maybe "" show loc) /= "http://127.0.0.1:3014/"
                     then error "Should have set the location"
                     else return ()
            it "updates location while following redirections" $ do
                tid <- forkIO $ run 3014 app
                request <- parseUrl "http://127.0.0.1:3014/redir1"
                loc <- withManager $ \manager -> do
                    browse manager $ do
                        setMaxRedirects $ Just 2
                        _ <- makeRequestLbs request
                        getLocation
                killThread tid
                if (maybe "" show loc) /= "http://127.0.0.1:3014/redir3"
                     then error "Should have updated the location when following 2 redirects"
                     else return ()
            it "follows relative references" $ do
                tid <- forkIO $ run 3014 app
                (elbs1, elbs2) <- withManager $ \manager -> do
                    browse manager $ do
                        lbs1 <- makeRequestLbs =<< parseUrl "http://127.0.0.1:3014/"
                        lbs2 <- makeRequestLbs =<< parseRelativeUrl "redir3"
                        return (lbs1, lbs2)
                killThread tid
                if responseBody elbs1 /= "homepage" || lazyToStrict (responseBody elbs2) /= dummy
                     then error "Should have followed the relative reference"
                     else return ()