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
  String
u <- App String
randomName
  String -> App String
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> App String) -> String -> App String
forall a b. (a -> b) -> a -> b
$ String
u String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"@example.com"

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
  Int
n <- (Int, Int) -> IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int
8, Int
15)
  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 (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 !) (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
  Int
n <- (Int, Int) -> IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int
8, Int
15)
  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 (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 !) (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
  Int
n <- (Int, Int) -> IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int
min', Int
max')
  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 (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 !) (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
      Int
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 -> Value
Array (Array -> Value) -> ([Value] -> Array) -> [Value] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Array
forall a. [a] -> Vector a
Vector.fromList ([Value] -> Value) -> App [Value] -> App Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> App Value -> App [Value]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n App Value
randomJSON
    Int
5 -> do
      Int
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)
      [String]
keys <- do
        Int
keyLength <- (Int, Int) -> App Int
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int
0, Int
maxThings)
        Int -> App String -> App [String]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (Int -> App String
randomString Int
keyLength)
      [Value]
vals <- Int -> App Value -> App [Value]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n App Value
randomJSON
      Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> App Value) -> ([Pair] -> Value) -> [Pair] -> App Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pair] -> Value
object ([Pair] -> App Value) -> [Pair] -> App Value
forall a b. (a -> b) -> a -> b
$ (String -> Value -> Pair) -> [String] -> [Value] -> [Pair]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
(.=) [String]
keys [Value]
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 !) (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
  String
second <- Int -> App String
randomHex Int
15
  Char
first <- App Char
pick
  String -> App String
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> App String) -> String -> App String
forall a b. (a -> b) -> a -> b
$ Char
first Char -> String -> String
forall a. a -> [a] -> [a]
: String
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 !) (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
  Value
uid <- u
u u -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"id"
  Value -> App Value
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Value -> App Value) -> Value -> App Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object
      [ String
"user_id" String -> Value -> Pair
forall a. ToJSON a => String -> a -> Pair
.= Value
uid,
        String
"route" String -> String -> Pair
forall a. ToJSON a => String -> a -> Pair
.= String
"any",
        String
"clients" String -> [String] -> Pair
forall a. ToJSON a => String -> a -> Pair
.= ([] :: [String])
      ]