{-# OPTIONS -Wno-ambiguous-fields #-}
module Test.Errors where

import API.Brig
import Control.Monad.Codensity
import Control.Monad.Reader
import qualified Data.Aeson as Aeson
import qualified Network.HTTP.Types as HTTP
import qualified Network.Wai as Wai
import SetupHelpers
import Testlib.Mock
import Testlib.Prelude
import Testlib.ResourcePool

testNestedError :: (HasCallStack) => App ()
testNestedError :: HasCallStack => App ()
testNestedError = do
  let innerError :: Value
innerError =
        [Pair] -> Value
object
          [ FilePath
"code" FilePath -> Port -> Pair
forall a. ToJSON a => FilePath -> a -> Pair
.= (Port
400 :: Int),
            FilePath
"label" FilePath -> FilePath -> Pair
forall a. ToJSON a => FilePath -> a -> Pair
.= FilePath
"example",
            FilePath
"message" FilePath -> FilePath -> Pair
forall a. ToJSON a => FilePath -> a -> Pair
.= FilePath
"Example remote federator failure"
          ]

  ResourcePool BackendResource
resourcePool <- (Env -> ResourcePool BackendResource)
-> App (ResourcePool BackendResource)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> ResourcePool BackendResource
resourcePool
  Codensity App () -> App ()
forall (f :: * -> *) a. Applicative f => Codensity f a -> f a
lowerCodensity (Codensity App () -> App ()) -> Codensity App () -> App ()
forall a b. (a -> b) -> a -> b
$ do
    [BackendResource
res] <- Port
-> ResourcePool BackendResource -> Codensity App [BackendResource]
forall (m :: * -> *) a.
(Ord a, MonadIO m, MonadMask m, HasCallStack) =>
Port -> ResourcePool a -> Codensity m [a]
acquireResources Port
1 ResourcePool BackendResource
resourcePool
    MockServerConfig
mockConfig <- do
      Maybe FilePath
mBase <- (Env -> Maybe FilePath) -> Codensity App (Maybe FilePath)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.servicesCwdBase)
      MockServerConfig -> Codensity App MockServerConfig
forall a. a -> Codensity App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MockServerConfig -> Codensity App MockServerConfig)
-> MockServerConfig -> Codensity App MockServerConfig
forall a b. (a -> b) -> a -> b
$ case Maybe FilePath
mBase of
        Just FilePath
_ ->
          -- when running locally, spawn a fake ingress returning an error
          MockServerConfig
forall a. Default a => a
def
            { port = Just (fromIntegral res.berNginzSslPort),
              tls = True
            }
        Maybe FilePath
Nothing -> do
          -- on CI, the real federation ingress is available, so we spawn its federator upstream instead
          MockServerConfig
forall a. Default a => a
def
            { port = Just (fromIntegral res.berFederatorExternal),
              tls = False
            }
    Codensity App Port -> Codensity App ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
      (Codensity App Port -> Codensity App ())
-> Codensity App Port -> Codensity App ()
forall a b. (a -> b) -> a -> b
$ MockServerConfig -> Application -> Codensity App Port
startMockServer MockServerConfig
mockConfig
      (Application -> Codensity App Port)
-> Application -> Codensity App Port
forall a b. (a -> b) -> a -> b
$ (Request -> Codensity IO Response) -> Application
codensityApp
      ((Request -> Codensity IO Response) -> Application)
-> (Request -> Codensity IO Response) -> Application
forall a b. (a -> b) -> a -> b
$ \Request
_req -> Response -> Codensity IO Response
forall a. a -> Codensity IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> Codensity IO Response)
-> Response -> Codensity IO Response
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> ByteString -> Response
Wai.responseLBS Status
HTTP.status400 ResponseHeaders
forall a. Monoid a => a
mempty (ByteString -> Response) -> ByteString -> Response
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode Value
innerError

    -- get remote user
    App () -> Codensity App ()
forall (m :: * -> *) a. Monad m => m a -> Codensity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (App () -> Codensity App ()) -> App () -> Codensity App ()
forall a b. (a -> b) -> a -> b
$ do
      Value
user <- Domain -> CreateUser -> App Value
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> CreateUser -> App Value
randomUser Domain
OwnDomain CreateUser
forall a. Default a => a
def
      FilePath
targetId <- App FilePath
HasCallStack => App FilePath
randomId
      let target :: Value
target = [Pair] -> Value
object [FilePath
"id" FilePath -> FilePath -> Pair
forall a. ToJSON a => FilePath -> a -> Pair
.= FilePath
targetId, FilePath
"domain" FilePath -> FilePath -> Pair
forall a. ToJSON a => FilePath -> a -> Pair
.= BackendResource
res.berDomain]
      App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
bindResponse (Value -> Value -> App Response
forall user target.
(HasCallStack, MakesValue user, MakesValue target) =>
user -> target -> App Response
getUser Value
user Value
target) ((Response -> App ()) -> App ()) -> (Response -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \Response
resp -> do
        Response
resp.status Port -> Port -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Port -> App ()
`shouldMatchInt` Port
533
        Response
resp.json App Value -> FilePath -> App Value
forall a.
(HasCallStack, MakesValue a) =>
a -> FilePath -> App Value
%. FilePath
"inner" App Value -> Value -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` Value
innerError