{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
-- Because we don't need Eq (Route site) in newer versions of Yesod.
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}

module Test.Syd.Yesod.E2E where

import Control.Arrow (second)
import qualified Data.Binary.Builder as BB
import qualified Data.ByteString.Lazy as LB
import Data.Function
import qualified Data.Text.Encoding as TE
import GHC.Generics (Generic)
import Network.HTTP.Client as HTTP
import Network.HTTP.Client.TLS
import Network.HTTP.Types as HTTP
import Network.URI
import Test.Syd
import Test.Syd.Yesod.Client
import Test.Syd.Yesod.Def
import Yesod.Core

-- | Run an end-to-end yesod test suite against a remote server at the given 'URI'.
--
-- If you would like to write tests that can be run against both a local and a remote instance of your site, you can use the following type:
--
-- > mySpec :: (Yesod site, RedirectUrl site (Route App)) => YesodSpec site
-- > mySpec = do
-- >   it "responds 200 OK to GET HomeR" $ do
-- >     get HomeR
-- >     statusIs 200
yesodE2ESpec :: URI -> YesodSpec (E2E site) -> Spec
yesodE2ESpec :: forall site. URI -> YesodSpec (E2E site) -> Spec
yesodE2ESpec URI
uri = forall outer (otherOuters :: [*]) inner result.
IO outer
-> TestDefM (outer : otherOuters) inner result
-> TestDefM otherOuters inner result
beforeAll forall (m :: * -> *). MonadIO m => m Manager
newTlsManager forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall site. URI -> YesodSpec (E2E site) -> TestDef '[Manager] ()
yesodE2ESpec' URI
uri

-- | Like 'yesodE2ESpec', but doesn't set up the 'HTTP.Manager' for you.
--
-- If you are running the end-to-end test against a server that uses
-- @https://@, make sure to use a TLS-enabled 'HTTP.Manager'.
--
-- You can do this using @beforeAll newTlsManager@.
yesodE2ESpec' :: URI -> YesodSpec (E2E site) -> TestDef '[HTTP.Manager] ()
yesodE2ESpec' :: forall site. URI -> YesodSpec (E2E site) -> TestDef '[Manager] ()
yesodE2ESpec' URI
uri =
  forall (outers :: [*]) outer oldInner newInner result.
HContains outers outer =>
(outer -> oldInner -> IO newInner)
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
beforeWith'
    ( \Manager
man () -> do
        forall (f :: * -> *) a. Applicative f => a -> f a
pure
          YesodClient
            { yesodClientManager :: Manager
yesodClientManager = Manager
man,
              yesodClientSite :: E2E site
yesodClientSite = forall site. E2E site
E2E,
              yesodClientSiteURI :: URI
yesodClientSiteURI = URI
uri
            }
    )

-- | Turn a local 'YesodClient site' into a remote 'YesodClient (E2E site)'.
localToE2EClient :: YesodClient site -> YesodClient (E2E site)
localToE2EClient :: forall site. YesodClient site -> YesodClient (E2E site)
localToE2EClient YesodClient site
yc = YesodClient site
yc {yesodClientSite :: E2E site
yesodClientSite = forall site. E2E site
E2E}

-- | See 'localToE2EClient'
--
-- Turn an end-to-end yesod test suite into a local yesod test suite by
-- treating a local instance as remote.
localToE2ESpec :: YesodSpec (E2E site) -> YesodSpec site
localToE2ESpec :: forall site. YesodSpec (E2E site) -> YesodSpec site
localToE2ESpec = forall (outers :: [*]) oldInner newInner result.
(oldInner -> IO newInner)
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
beforeWith (\YesodClient site
yc -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall site. YesodClient site -> YesodClient (E2E site)
localToE2EClient YesodClient site
yc)

-- | A dummy type that is an instance of 'Yesod', with as a phantom type, the app that it represents.
--
-- That is to say, @E2E site@ is an instance of 'Yesod' that pretends to be a
-- @site@. You can treat it as a @site@ in end-to-end tests, except that you
-- cannot use the @site@ value because there is none in there.
data E2E site = E2E
  deriving (Int -> E2E site -> ShowS
forall site. Int -> E2E site -> ShowS
forall site. [E2E site] -> ShowS
forall site. E2E site -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [E2E site] -> ShowS
$cshowList :: forall site. [E2E site] -> ShowS
show :: E2E site -> String
$cshow :: forall site. E2E site -> String
showsPrec :: Int -> E2E site -> ShowS
$cshowsPrec :: forall site. Int -> E2E site -> ShowS
Show, E2E site -> E2E site -> Bool
forall site. E2E site -> E2E site -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: E2E site -> E2E site -> Bool
$c/= :: forall site. E2E site -> E2E site -> Bool
== :: E2E site -> E2E site -> Bool
$c== :: forall site. E2E site -> E2E site -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall site x. Rep (E2E site) x -> E2E site
forall site x. E2E site -> Rep (E2E site) x
$cto :: forall site x. Rep (E2E site) x -> E2E site
$cfrom :: forall site x. E2E site -> Rep (E2E site) x
Generic)

instance Yesod site => Yesod (E2E site)

instance (Eq (Route site), RenderRoute site) => RenderRoute (E2E site) where
  data Route (E2E site) = E2ERoute {forall site. Route (E2E site) -> Route site
unE2ERoute :: Route site}
    deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall site x. Rep (Route (E2E site)) x -> Route (E2E site)
forall site x. Route (E2E site) -> Rep (Route (E2E site)) x
$cto :: forall site x. Rep (Route (E2E site)) x -> Route (E2E site)
$cfrom :: forall site x. Route (E2E site) -> Rep (Route (E2E site)) x
Generic)
  renderRoute :: Route (E2E site) -> ([Text], [(Text, Text)])
renderRoute (E2ERoute Route site
route) = forall a. RenderRoute a => Route a -> ([Text], [(Text, Text)])
renderRoute Route site
route

instance Show (Route site) => Show (Route (E2E site)) where
  show :: Route (E2E site) -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall site. Route (E2E site) -> Route site
unE2ERoute

instance Eq (Route site) => Eq (Route (E2E site)) where
  == :: Route (E2E site) -> Route (E2E site) -> Bool
(==) = forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall site. Route (E2E site) -> Route site
unE2ERoute

instance RenderRoute site => RedirectUrl (E2E site) (Route site) where
  toTextUrl :: forall (m :: * -> *).
(MonadHandler m, HandlerSite m ~ E2E site) =>
Route site -> m Text
toTextUrl Route site
route = do
    let ([Text]
urlPieces, [(Text, Text)]
queryParams) = forall a. RenderRoute a => Route a -> ([Text], [(Text, Text)])
renderRoute (forall site. Route site -> Route (E2E site)
E2ERoute Route site
route)
        q :: Query
q = QueryText -> Query
queryTextToQuery forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall a. a -> Maybe a
Just) [(Text, Text)]
queryParams
        pathBS :: Builder
pathBS = [Text] -> Query -> Builder
encodePath [Text]
urlPieces Query
q
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TE.decodeUtf8 (ByteString -> ByteString
LB.toStrict (Builder -> ByteString
BB.toLazyByteString Builder
pathBS)) -- Not safe, but it will fail during testing (if at all) so should be ok.

instance ParseRoute site => ParseRoute (E2E site) where
  parseRoute :: ([Text], [(Text, Text)]) -> Maybe (Route (E2E site))
parseRoute = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall site. Route site -> Route (E2E site)
E2ERoute forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ParseRoute a =>
([Text], [(Text, Text)]) -> Maybe (Route a)
parseRoute