-- 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 API.Common where

import Control.Monad
import Control.Monad.IO.Class
import Data.Array ((!))
import qualified Data.Array as Array
import qualified Data.ByteString as BS
import Data.Scientific (scientific)
import qualified Data.Vector as Vector
import System.Random (randomIO, randomRIO)
import Testlib.Prelude

-- | please don't use special shell characters like '!' here.  it makes writing shell lines
-- that use test data a lot less straight-forward.
defPassword :: String
defPassword :: String
defPassword = String
"hunter2."

randomEmail :: App String
randomEmail :: App String
randomEmail = do
  u <- App String
randomName
  pure $ u <> "@example.com"

randomDomain :: App String
randomDomain :: App String
randomDomain = do
  u <- App String
randomName
  pure $ (fmap toLower u) <> ".example"

randomExternalId :: App String
randomExternalId :: App String
randomExternalId = IO String -> App String
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> App String) -> IO String -> App String
forall a b. (a -> b) -> a -> b
$ do
  -- external ID has no constraints, but we only generate human-readable samples
  n <- (Int, Int) -> IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int
8, Int
15)
  replicateM n pick
  where
    chars :: Array Int Char
chars = String -> Array Int Char
forall a. [a] -> Array Int a
mkArray (String -> Array Int Char) -> String -> Array Int Char
forall a b. (a -> b) -> a -> b
$ [Char
'A' .. Char
'Z'] String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Char
'a' .. Char
'z'] String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Char
'0' .. Char
'9']
    pick :: IO Char
pick = (Array Int Char
chars Array Int Char -> Int -> Char
forall i e. Ix i => Array i e -> i -> e
!) (Int -> Char) -> IO Int -> IO Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Array Int Char -> (Int, Int)
forall i e. Array i e -> (i, i)
Array.bounds Array Int Char
chars)

randomName :: App String
randomName :: App String
randomName = IO String -> App String
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> App String) -> IO String -> App String
forall a b. (a -> b) -> a -> b
$ do
  n <- (Int, Int) -> IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int
8, Int
15)
  replicateM n pick
  where
    chars :: Array Int Char
chars = String -> Array Int Char
forall a. [a] -> Array Int a
mkArray (String -> Array Int Char) -> String -> Array Int Char
forall a b. (a -> b) -> a -> b
$ [Char
'A' .. Char
'Z'] String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Char
'a' .. Char
'z'] String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Char
'0' .. Char
'9']
    pick :: IO Char
pick = (Array Int Char
chars Array Int Char -> Int -> Char
forall i e. Ix i => Array i e -> i -> e
!) (Int -> Char) -> IO Int -> IO Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Array Int Char -> (Int, Int)
forall i e. Array i e -> (i, i)
Array.bounds Array Int Char
chars)

randomHandle :: App String
randomHandle :: App String
randomHandle = Int -> Int -> App String
randomHandleWithRange Int
50 Int
256

randomHandleWithRange :: Int -> Int -> App String
randomHandleWithRange :: Int -> Int -> App String
randomHandleWithRange Int
min' Int
max' = IO String -> App String
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> App String) -> IO String -> App String
forall a b. (a -> b) -> a -> b
$ do
  n <- (Int, Int) -> IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int
min', Int
max')
  replicateM n pick
  where
    chars :: Array Int Char
chars = String -> Array Int Char
forall a. [a] -> Array Int a
mkArray (String -> Array Int Char) -> String -> Array Int Char
forall a b. (a -> b) -> a -> b
$ [Char
'a' .. Char
'z'] String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Char
'0' .. Char
'9'] String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_-."
    pick :: IO Char
pick = (Array Int Char
chars Array Int Char -> Int -> Char
forall i e. Ix i => Array i e -> i -> e
!) (Int -> Char) -> IO Int -> IO Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Array Int Char -> (Int, Int)
forall i e. Array i e -> (i, i)
Array.bounds Array Int Char
chars)

randomBytes :: Int -> App ByteString
randomBytes :: Int -> App ByteString
randomBytes Int
n = IO ByteString -> App ByteString
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> App ByteString)
-> IO ByteString -> App ByteString
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> IO [Word8] -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO Word8 -> IO [Word8]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n IO Word8
forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO

randomString :: Int -> App String
randomString :: Int -> App String
randomString Int
n = IO String -> App String
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> App String) -> IO String -> App String
forall a b. (a -> b) -> a -> b
$ Int -> IO Char -> IO String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n IO Char
forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO

randomJSON :: App Value
randomJSON :: App Value
randomJSON = do
  let maxThings :: Int
maxThings = Int
5
  IO Int -> App Int
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((Int, Int) -> IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int
0 :: Int, Int
5)) App Int -> (Int -> App Value) -> App Value
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Int
0 -> Text -> Value
String (Text -> Value) -> (String -> Text) -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString (String -> Value) -> App String -> App Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> App String
randomString (Int -> App String) -> App Int -> App String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Int, Int) -> App Int
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int
0, Int
maxThings))
    Int
1 -> Scientific -> Value
Number (Scientific -> Value) -> App Scientific -> App Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Scientific -> App Scientific
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Integer -> Int -> Scientific
scientific (Integer -> Int -> Scientific)
-> IO Integer -> IO (Int -> Scientific)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Integer
forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO IO (Int -> Scientific) -> IO Int -> IO Scientific
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO)
    Int
2 -> Bool -> Value
Bool (Bool -> Value) -> App Bool -> App Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Bool -> App Bool
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Bool
forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO
    Int
3 -> Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
Null
    Int
4 -> do
      n <- IO Int -> App Int
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> App Int) -> IO Int -> App Int
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int
0, Int
maxThings)
      Array . Vector.fromList <$> replicateM n randomJSON
    Int
5 -> do
      n <- IO Int -> App Int
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> App Int) -> IO Int -> App Int
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int
0, Int
maxThings)
      keys <- do
        keyLength <- randomRIO (0, maxThings)
        replicateM n (randomString keyLength)
      vals <- replicateM n randomJSON
      pure . object $ zipWith (.=) keys vals
    Int
_ -> String -> App Value
forall a. HasCallStack => String -> a
error (String -> App Value) -> String -> App Value
forall a b. (a -> b) -> a -> b
$ String
"impopssible: randomJSON"

randomHex :: Int -> App String
randomHex :: Int -> App String
randomHex Int
n = IO String -> App String
forall a. IO a -> App a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> App String) -> IO String -> App String
forall a b. (a -> b) -> a -> b
$ Int -> IO Char -> IO String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n IO Char
pick
  where
    chars :: Array Int Char
chars = String -> Array Int Char
forall a. [a] -> Array Int a
mkArray ([Char
'0' .. Char
'9'] String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Char
'a' .. Char
'f'])
    pick :: IO Char
pick = (Array Int Char
chars Array Int Char -> Int -> Char
forall i e. Ix i => Array i e -> i -> e
!) (Int -> Char) -> IO Int -> IO Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Array Int Char -> (Int, Int)
forall i e. Array i e -> (i, i)
Array.bounds Array Int Char
chars)

-- Should not have leading 0.
randomClientId :: App String
randomClientId :: App String
randomClientId = do
  second <- Int -> App String
randomHex Int
15
  first <- pick
  pure $ first : second
  where
    chars :: Array Int Char
chars = String -> Array Int Char
forall a. [a] -> Array Int a
mkArray ([Char
'1' .. Char
'9'] String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Char
'a' .. Char
'f'])
    pick :: App Char
pick = (Array Int Char
chars Array Int Char -> Int -> Char
forall i e. Ix i => Array i e -> i -> e
!) (Int -> Char) -> App Int -> App Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> App Int
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Array Int Char -> (Int, Int)
forall i e. Array i e -> (i, i)
Array.bounds Array Int Char
chars)

mkArray :: [a] -> Array.Array Int a
mkArray :: forall a. [a] -> Array Int a
mkArray [a]
l = (Int, Int) -> [a] -> Array Int a
forall i e. Ix i => (i, i) -> [e] -> Array i e
Array.listArray (Int
0, [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [a]
l

recipient :: (MakesValue u) => u -> App Value
recipient :: forall u. MakesValue u => u -> App Value
recipient u
u = do
  uid <- u
u u -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"
  pure
    $ object
      [ "user_id" .= uid,
        "route" .= "any",
        "clients" .= ([] :: [String])
      ]