{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

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 :: URI -> YesodSpec (E2E site) -> Spec
yesodE2ESpec URI
uri = IO Manager -> TestDefM '[Manager] () () -> Spec
forall outer (otherOuters :: [*]) inner result.
IO outer
-> TestDefM (outer : otherOuters) inner result
-> TestDefM otherOuters inner result
beforeAll IO Manager
forall (m :: * -> *). MonadIO m => m Manager
newTlsManager (TestDefM '[Manager] () () -> Spec)
-> (YesodSpec (E2E site) -> TestDefM '[Manager] () ())
-> YesodSpec (E2E site)
-> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> YesodSpec (E2E site) -> TestDefM '[Manager] () ()
forall site.
URI -> YesodSpec (E2E site) -> TestDefM '[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' :: URI -> YesodSpec (E2E site) -> TestDefM '[Manager] () ()
yesodE2ESpec' URI
uri =
  (Manager -> () -> IO (YesodClient (E2E site)))
-> YesodSpec (E2E site) -> TestDefM '[Manager] () ()
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
        YesodClient (E2E site) -> IO (YesodClient (E2E site))
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          YesodClient :: forall site. site -> Manager -> URI -> YesodClient site
YesodClient
            { yesodClientManager :: Manager
yesodClientManager = Manager
man,
              yesodClientSite :: E2E site
yesodClientSite = E2E site
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 :: YesodClient site -> YesodClient (E2E site)
localToE2EClient YesodClient site
yc = YesodClient site
yc {yesodClientSite :: E2E site
yesodClientSite = E2E site
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 :: YesodSpec (E2E site) -> YesodSpec site
localToE2ESpec = (YesodClient site -> IO (YesodClient (E2E site)))
-> YesodSpec (E2E site) -> YesodSpec site
forall (outers :: [*]) oldInner newInner result.
(oldInner -> IO newInner)
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
beforeWith (\YesodClient site
yc -> YesodClient (E2E site) -> IO (YesodClient (E2E site))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (YesodClient (E2E site) -> IO (YesodClient (E2E site)))
-> YesodClient (E2E site) -> IO (YesodClient (E2E site))
forall a b. (a -> b) -> a -> b
$ YesodClient site -> YesodClient (E2E site)
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
[E2E site] -> ShowS
E2E site -> String
(Int -> E2E site -> ShowS)
-> (E2E site -> String) -> ([E2E site] -> ShowS) -> Show (E2E site)
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
(E2E site -> E2E site -> Bool)
-> (E2E site -> E2E site -> Bool) -> Eq (E2E site)
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 x. E2E site -> Rep (E2E site) x)
-> (forall x. Rep (E2E site) x -> E2E site) -> Generic (E2E site)
forall x. Rep (E2E site) x -> E2E site
forall x. E2E site -> Rep (E2E site) x
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 {Route (E2E site) -> Route site
unE2ERoute :: Route site}
    deriving ((forall x. Route (E2E site) -> Rep (Route (E2E site)) x)
-> (forall x. Rep (Route (E2E site)) x -> Route (E2E site))
-> Generic (Route (E2E site))
forall x. Rep (Route (E2E site)) x -> Route (E2E site)
forall x. Route (E2E site) -> Rep (Route (E2E site)) x
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) = Route site -> ([Text], [(Text, Text)])
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 = Route site -> String
forall a. Show a => a -> String
show (Route site -> String)
-> (Route (E2E site) -> Route site) -> Route (E2E site) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Route (E2E site) -> Route site
forall site. Route (E2E site) -> Route site
unE2ERoute

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

instance RenderRoute site => RedirectUrl (E2E site) (Route site) where
  toTextUrl :: Route site -> m Text
toTextUrl Route site
route = do
    let ([Text]
urlPieces, [(Text, Text)]
queryParams) = Route (E2E site) -> ([Text], [(Text, Text)])
forall a. RenderRoute a => Route a -> ([Text], [(Text, Text)])
renderRoute (Route site -> Route (E2E site)
forall site. Route site -> Route (E2E site)
E2ERoute Route site
route)
        q :: Query
q = QueryText -> Query
queryTextToQuery (QueryText -> Query) -> QueryText -> Query
forall a b. (a -> b) -> a -> b
$ ((Text, Text) -> (Text, Maybe Text)) -> [(Text, Text)] -> QueryText
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Maybe Text) -> (Text, Text) -> (Text, Maybe Text)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Text -> Maybe Text
forall a. a -> Maybe a
Just) [(Text, Text)]
queryParams
        pathBS :: Builder
pathBS = [Text] -> Query -> Builder
encodePath [Text]
urlPieces Query
q
    Text -> m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> m Text) -> Text -> m Text
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 = (Route site -> Route (E2E site))
-> Maybe (Route site) -> Maybe (Route (E2E site))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Route site -> Route (E2E site)
forall site. Route site -> Route (E2E site)
E2ERoute (Maybe (Route site) -> Maybe (Route (E2E site)))
-> (([Text], [(Text, Text)]) -> Maybe (Route site))
-> ([Text], [(Text, Text)])
-> Maybe (Route (E2E site))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text], [(Text, Text)]) -> Maybe (Route site)
forall a.
ParseRoute a =>
([Text], [(Text, Text)]) -> Maybe (Route a)
parseRoute