-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2025 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module Testlib.App where

import Control.Applicative ((<|>))
import Control.Monad.Reader
import Control.Monad.Trans.Maybe (MaybeT (MaybeT), runMaybeT)
import qualified Control.Retry as Retry
import Data.Aeson hiding ((.=))
import Data.Bool (bool)
import Data.Maybe (isJust)
import qualified Data.Text as T
import qualified Data.Yaml as Yaml
import GHC.Exception
import GHC.Generics (Generic)
import GHC.Stack (HasCallStack, callStack)
import System.FilePath
import Testlib.JSON
import Testlib.Types
import Prelude

failApp :: (HasCallStack) => String -> App a
failApp :: forall a. HasCallStack => FilePath -> App a
failApp FilePath
msg = AppFailure -> App a
forall a e. (HasCallStack, Exception e) => e -> a
throw (FilePath -> CallStack -> AppFailure
AppFailure FilePath
msg CallStack
HasCallStack => CallStack
callStack)

readServiceConfig :: Service -> App Value
readServiceConfig :: Service -> App Value
readServiceConfig = FilePath -> App Value
readServiceConfig' (FilePath -> App Value)
-> (Service -> FilePath) -> Service -> App Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Service -> FilePath
configName

readServiceConfig' :: String -> App Value
readServiceConfig' :: FilePath -> App Value
readServiceConfig' FilePath
srvName = do
  cfgFile <- (Env -> FilePath) -> App FilePath
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks \Env
env -> case Env
env.servicesCwdBase of
    Maybe FilePath
Nothing -> FilePath
"/etc/wire" FilePath -> FilePath -> FilePath
</> FilePath
srvName FilePath -> FilePath -> FilePath
</> FilePath
"conf" FilePath -> FilePath -> FilePath
</> (FilePath
srvName FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".yaml")
    Just FilePath
p -> FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
srvName FilePath -> FilePath -> FilePath
</> (FilePath
srvName FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".integration.yaml")

  eith <- liftIO (Yaml.decodeFileEither cfgFile)
  case eith of
    Left ParseException
err -> FilePath -> App Value
forall a. HasCallStack => FilePath -> App a
failApp (FilePath
"Error while parsing " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
cfgFile FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
": " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> ParseException -> FilePath
Yaml.prettyPrintParseException ParseException
err)
    Right Value
value -> Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
value

data Domain = OwnDomain | OtherDomain
  deriving stock (Domain -> Domain -> Bool
(Domain -> Domain -> Bool)
-> (Domain -> Domain -> Bool) -> Eq Domain
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Domain -> Domain -> Bool
== :: Domain -> Domain -> Bool
$c/= :: Domain -> Domain -> Bool
/= :: Domain -> Domain -> Bool
Eq, Int -> Domain -> FilePath -> FilePath
[Domain] -> FilePath -> FilePath
Domain -> FilePath
(Int -> Domain -> FilePath -> FilePath)
-> (Domain -> FilePath)
-> ([Domain] -> FilePath -> FilePath)
-> Show Domain
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> Domain -> FilePath -> FilePath
showsPrec :: Int -> Domain -> FilePath -> FilePath
$cshow :: Domain -> FilePath
show :: Domain -> FilePath
$cshowList :: [Domain] -> FilePath -> FilePath
showList :: [Domain] -> FilePath -> FilePath
Show, (forall x. Domain -> Rep Domain x)
-> (forall x. Rep Domain x -> Domain) -> Generic Domain
forall x. Rep Domain x -> Domain
forall x. Domain -> Rep Domain x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Domain -> Rep Domain x
from :: forall x. Domain -> Rep Domain x
$cto :: forall x. Rep Domain x -> Domain
to :: forall x. Rep Domain x -> Domain
Generic)

instance MakesValue Domain where
  make :: HasCallStack => Domain -> App Value
make Domain
OwnDomain = (Env -> Value) -> App Value
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Text -> Value
String (Text -> Value) -> (Env -> Text) -> Env -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> Text) -> (Env -> FilePath) -> Env -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.domain1))
  make Domain
OtherDomain = (Env -> Value) -> App Value
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Text -> Value
String (Text -> Value) -> (Env -> Text) -> Env -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> Text) -> (Env -> FilePath) -> Env -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.domain2))

-- | Run an action, `recoverAll`ing with exponential backoff (min step 8ms, total timeout
-- ~15s).  Search this package for examples how to use it.
--
-- Ideally, this will be the only thing you'll ever need from the retry package when writing
-- integration tests.  If you are unhappy with it, please consider making it more general in a
-- backwards-compatible way so everybody can benefit.
retryT :: App a -> App a
retryT :: forall a. App a -> App a
retryT App a
action = RetryPolicyM App -> (RetryStatus -> App a) -> App a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
RetryPolicyM m -> (RetryStatus -> m a) -> m a
Retry.recoverAll (Int -> RetryPolicyM App
forall (m :: * -> *). Monad m => Int -> RetryPolicyM m
Retry.exponentialBackoff Int
8000 RetryPolicyM App -> RetryPolicyM App -> RetryPolicyM App
forall a. Semigroup a => a -> a -> a
<> Int -> RetryPolicy
Retry.limitRetries Int
10) (App a -> RetryStatus -> App a
forall a b. a -> b -> a
const App a
action)

-- | make Bool lazy
liftBool :: (Functor f) => f Bool -> BoolT f
liftBool :: forall (f :: * -> *). Functor f => f Bool -> BoolT f
liftBool = f (Maybe ()) -> MaybeT f ()
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (f (Maybe ()) -> MaybeT f ())
-> (f Bool -> f (Maybe ())) -> f Bool -> MaybeT f ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Maybe ()) -> f Bool -> f (Maybe ())
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe () -> Maybe () -> Bool -> Maybe ()
forall a. a -> a -> Bool -> a
bool Maybe ()
forall a. Maybe a
Nothing (() -> Maybe ()
forall a. a -> Maybe a
Just ()))

-- | make Bool strict
unliftBool :: (Functor f) => BoolT f -> f Bool
unliftBool :: forall (f :: * -> *). Functor f => BoolT f -> f Bool
unliftBool = (Maybe () -> Bool) -> f (Maybe ()) -> f Bool
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe () -> Bool
forall a. Maybe a -> Bool
isJust (f (Maybe ()) -> f Bool)
-> (BoolT f -> f (Maybe ())) -> BoolT f -> f Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoolT f -> f (Maybe ())
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT

-- | lazy (&&)
(&&~) :: App Bool -> App Bool -> App Bool
App Bool
b1 &&~ :: App Bool -> App Bool -> App Bool
&&~ App Bool
b2 = BoolT App -> App Bool
forall (f :: * -> *). Functor f => BoolT f -> f Bool
unliftBool (BoolT App -> App Bool) -> BoolT App -> App Bool
forall a b. (a -> b) -> a -> b
$ App Bool -> BoolT App
forall (f :: * -> *). Functor f => f Bool -> BoolT f
liftBool App Bool
b1 BoolT App -> BoolT App -> BoolT App
forall a b. MaybeT App a -> MaybeT App b -> MaybeT App b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> App Bool -> BoolT App
forall (f :: * -> *). Functor f => f Bool -> BoolT f
liftBool App Bool
b2

infixr 3 &&~

-- | lazy (||)
(||~) :: App Bool -> App Bool -> App Bool
App Bool
b1 ||~ :: App Bool -> App Bool -> App Bool
||~ App Bool
b2 = BoolT App -> App Bool
forall (f :: * -> *). Functor f => BoolT f -> f Bool
unliftBool (BoolT App -> App Bool) -> BoolT App -> App Bool
forall a b. (a -> b) -> a -> b
$ App Bool -> BoolT App
forall (f :: * -> *). Functor f => f Bool -> BoolT f
liftBool App Bool
b1 BoolT App -> BoolT App -> BoolT App
forall a. MaybeT App a -> MaybeT App a -> MaybeT App a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> App Bool -> BoolT App
forall (f :: * -> *). Functor f => f Bool -> BoolT f
liftBool App Bool
b2

infixr 2 ||~

-- | lazy (&&): (*>)
--   lazy (||): (<|>)
type BoolT f = MaybeT f ()