{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 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 Galley.Validation
  ( rangeChecked,
    rangeCheckedMaybe,
    fromConvSize,
    ConvSizeChecked,
    checkedConvSize,
  )
where

import Control.Lens
import Data.Range
import GHC.TypeNats
import Galley.API.Error
import Galley.Options
import Imports
import Polysemy
import Polysemy.Error

rangeChecked :: (KnownNat n, KnownNat m, Member (Error InvalidInput) r, Within a n m) => a -> Sem r (Range n m a)
rangeChecked :: forall (n :: Nat) (m :: Nat) (r :: EffectRow) a.
(KnownNat n, KnownNat m, Member (Error InvalidInput) r,
 Within a n m) =>
a -> Sem r (Range n m a)
rangeChecked = (String -> Sem r (Range n m a))
-> (Range n m a -> Sem r (Range n m a))
-> Either String (Range n m a)
-> Sem r (Range n m a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Sem r (Range n m a)
forall (r :: EffectRow) a.
Member (Error InvalidInput) r =>
String -> Sem r a
throwErr Range n m a -> Sem r (Range n m a)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (Range n m a) -> Sem r (Range n m a))
-> (a -> Either String (Range n m a)) -> a -> Sem r (Range n m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either String (Range n m a)
forall a (n :: Nat) (m :: Nat).
(KnownNat n, KnownNat m, Within a n m) =>
a -> Either String (Range n m a)
checkedEither
{-# INLINE rangeChecked #-}

rangeCheckedMaybe ::
  (Member (Error InvalidInput) r, KnownNat n, KnownNat m, Within a n m) =>
  Maybe a ->
  Sem r (Maybe (Range n m a))
rangeCheckedMaybe :: forall (r :: EffectRow) (n :: Nat) (m :: Nat) a.
(Member (Error InvalidInput) r, KnownNat n, KnownNat m,
 Within a n m) =>
Maybe a -> Sem r (Maybe (Range n m a))
rangeCheckedMaybe Maybe a
Nothing = Maybe (Range n m a) -> Sem r (Maybe (Range n m a))
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Range n m a)
forall a. Maybe a
Nothing
rangeCheckedMaybe (Just a
a) = Range n m a -> Maybe (Range n m a)
forall a. a -> Maybe a
Just (Range n m a -> Maybe (Range n m a))
-> Sem r (Range n m a) -> Sem r (Maybe (Range n m a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Sem r (Range n m a)
forall (n :: Nat) (m :: Nat) (r :: EffectRow) a.
(KnownNat n, KnownNat m, Member (Error InvalidInput) r,
 Within a n m) =>
a -> Sem r (Range n m a)
rangeChecked a
a
{-# INLINE rangeCheckedMaybe #-}

-- Between 0 and (setMaxConvSize - 1)
newtype ConvSizeChecked f a = ConvSizeChecked {forall {k} (f :: k -> *) (a :: k). ConvSizeChecked f a -> f a
fromConvSize :: f a}
  deriving ((forall a b.
 (a -> b) -> ConvSizeChecked f a -> ConvSizeChecked f b)
-> (forall a b. a -> ConvSizeChecked f b -> ConvSizeChecked f a)
-> Functor (ConvSizeChecked f)
forall a b. a -> ConvSizeChecked f b -> ConvSizeChecked f a
forall a b. (a -> b) -> ConvSizeChecked f a -> ConvSizeChecked f b
forall (f :: * -> *) a b.
Functor f =>
a -> ConvSizeChecked f b -> ConvSizeChecked f a
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> ConvSizeChecked f a -> ConvSizeChecked f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> ConvSizeChecked f a -> ConvSizeChecked f b
fmap :: forall a b. (a -> b) -> ConvSizeChecked f a -> ConvSizeChecked f b
$c<$ :: forall (f :: * -> *) a b.
Functor f =>
a -> ConvSizeChecked f b -> ConvSizeChecked f a
<$ :: forall a b. a -> ConvSizeChecked f b -> ConvSizeChecked f a
Functor, (forall m. Monoid m => ConvSizeChecked f m -> m)
-> (forall m a. Monoid m => (a -> m) -> ConvSizeChecked f a -> m)
-> (forall m a. Monoid m => (a -> m) -> ConvSizeChecked f a -> m)
-> (forall a b. (a -> b -> b) -> b -> ConvSizeChecked f a -> b)
-> (forall a b. (a -> b -> b) -> b -> ConvSizeChecked f a -> b)
-> (forall b a. (b -> a -> b) -> b -> ConvSizeChecked f a -> b)
-> (forall b a. (b -> a -> b) -> b -> ConvSizeChecked f a -> b)
-> (forall a. (a -> a -> a) -> ConvSizeChecked f a -> a)
-> (forall a. (a -> a -> a) -> ConvSizeChecked f a -> a)
-> (forall a. ConvSizeChecked f a -> [a])
-> (forall a. ConvSizeChecked f a -> Bool)
-> (forall a. ConvSizeChecked f a -> Int)
-> (forall a. Eq a => a -> ConvSizeChecked f a -> Bool)
-> (forall a. Ord a => ConvSizeChecked f a -> a)
-> (forall a. Ord a => ConvSizeChecked f a -> a)
-> (forall a. Num a => ConvSizeChecked f a -> a)
-> (forall a. Num a => ConvSizeChecked f a -> a)
-> Foldable (ConvSizeChecked f)
forall a. Eq a => a -> ConvSizeChecked f a -> Bool
forall a. Num a => ConvSizeChecked f a -> a
forall a. Ord a => ConvSizeChecked f a -> a
forall m. Monoid m => ConvSizeChecked f m -> m
forall a. ConvSizeChecked f a -> Bool
forall a. ConvSizeChecked f a -> Int
forall a. ConvSizeChecked f a -> [a]
forall a. (a -> a -> a) -> ConvSizeChecked f a -> a
forall m a. Monoid m => (a -> m) -> ConvSizeChecked f a -> m
forall b a. (b -> a -> b) -> b -> ConvSizeChecked f a -> b
forall a b. (a -> b -> b) -> b -> ConvSizeChecked f a -> b
forall (f :: * -> *) a.
(Foldable f, Eq a) =>
a -> ConvSizeChecked f a -> Bool
forall (f :: * -> *) a.
(Foldable f, Num a) =>
ConvSizeChecked f a -> a
forall (f :: * -> *) a.
(Foldable f, Ord a) =>
ConvSizeChecked f a -> a
forall (f :: * -> *) m.
(Foldable f, Monoid m) =>
ConvSizeChecked f m -> m
forall (f :: * -> *) a. Foldable f => ConvSizeChecked f a -> Bool
forall (f :: * -> *) a. Foldable f => ConvSizeChecked f a -> Int
forall (f :: * -> *) a. Foldable f => ConvSizeChecked f a -> [a]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> ConvSizeChecked f a -> a
forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> ConvSizeChecked f a -> m
forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> ConvSizeChecked f a -> b
forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> ConvSizeChecked f a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall (f :: * -> *) m.
(Foldable f, Monoid m) =>
ConvSizeChecked f m -> m
fold :: forall m. Monoid m => ConvSizeChecked f m -> m
$cfoldMap :: forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> ConvSizeChecked f a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> ConvSizeChecked f a -> m
$cfoldMap' :: forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> ConvSizeChecked f a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> ConvSizeChecked f a -> m
$cfoldr :: forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> ConvSizeChecked f a -> b
foldr :: forall a b. (a -> b -> b) -> b -> ConvSizeChecked f a -> b
$cfoldr' :: forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> ConvSizeChecked f a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> ConvSizeChecked f a -> b
$cfoldl :: forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> ConvSizeChecked f a -> b
foldl :: forall b a. (b -> a -> b) -> b -> ConvSizeChecked f a -> b
$cfoldl' :: forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> ConvSizeChecked f a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> ConvSizeChecked f a -> b
$cfoldr1 :: forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> ConvSizeChecked f a -> a
foldr1 :: forall a. (a -> a -> a) -> ConvSizeChecked f a -> a
$cfoldl1 :: forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> ConvSizeChecked f a -> a
foldl1 :: forall a. (a -> a -> a) -> ConvSizeChecked f a -> a
$ctoList :: forall (f :: * -> *) a. Foldable f => ConvSizeChecked f a -> [a]
toList :: forall a. ConvSizeChecked f a -> [a]
$cnull :: forall (f :: * -> *) a. Foldable f => ConvSizeChecked f a -> Bool
null :: forall a. ConvSizeChecked f a -> Bool
$clength :: forall (f :: * -> *) a. Foldable f => ConvSizeChecked f a -> Int
length :: forall a. ConvSizeChecked f a -> Int
$celem :: forall (f :: * -> *) a.
(Foldable f, Eq a) =>
a -> ConvSizeChecked f a -> Bool
elem :: forall a. Eq a => a -> ConvSizeChecked f a -> Bool
$cmaximum :: forall (f :: * -> *) a.
(Foldable f, Ord a) =>
ConvSizeChecked f a -> a
maximum :: forall a. Ord a => ConvSizeChecked f a -> a
$cminimum :: forall (f :: * -> *) a.
(Foldable f, Ord a) =>
ConvSizeChecked f a -> a
minimum :: forall a. Ord a => ConvSizeChecked f a -> a
$csum :: forall (f :: * -> *) a.
(Foldable f, Num a) =>
ConvSizeChecked f a -> a
sum :: forall a. Num a => ConvSizeChecked f a -> a
$cproduct :: forall (f :: * -> *) a.
(Foldable f, Num a) =>
ConvSizeChecked f a -> a
product :: forall a. Num a => ConvSizeChecked f a -> a
Foldable, Functor (ConvSizeChecked f)
Foldable (ConvSizeChecked f)
(Functor (ConvSizeChecked f), Foldable (ConvSizeChecked f)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> ConvSizeChecked f a -> f (ConvSizeChecked f b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    ConvSizeChecked f (f a) -> f (ConvSizeChecked f a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> ConvSizeChecked f a -> m (ConvSizeChecked f b))
-> (forall (m :: * -> *) a.
    Monad m =>
    ConvSizeChecked f (m a) -> m (ConvSizeChecked f a))
-> Traversable (ConvSizeChecked f)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (f :: * -> *). Traversable f => Functor (ConvSizeChecked f)
forall (f :: * -> *). Traversable f => Foldable (ConvSizeChecked f)
forall (f :: * -> *) (m :: * -> *) a.
(Traversable f, Monad m) =>
ConvSizeChecked f (m a) -> m (ConvSizeChecked f a)
forall (f :: * -> *) (f :: * -> *) a.
(Traversable f, Applicative f) =>
ConvSizeChecked f (f a) -> f (ConvSizeChecked f a)
forall (f :: * -> *) (m :: * -> *) a b.
(Traversable f, Monad m) =>
(a -> m b) -> ConvSizeChecked f a -> m (ConvSizeChecked f b)
forall (f :: * -> *) (f :: * -> *) a b.
(Traversable f, Applicative f) =>
(a -> f b) -> ConvSizeChecked f a -> f (ConvSizeChecked f b)
forall (m :: * -> *) a.
Monad m =>
ConvSizeChecked f (m a) -> m (ConvSizeChecked f a)
forall (f :: * -> *) a.
Applicative f =>
ConvSizeChecked f (f a) -> f (ConvSizeChecked f a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ConvSizeChecked f a -> m (ConvSizeChecked f b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ConvSizeChecked f a -> f (ConvSizeChecked f b)
$ctraverse :: forall (f :: * -> *) (f :: * -> *) a b.
(Traversable f, Applicative f) =>
(a -> f b) -> ConvSizeChecked f a -> f (ConvSizeChecked f b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ConvSizeChecked f a -> f (ConvSizeChecked f b)
$csequenceA :: forall (f :: * -> *) (f :: * -> *) a.
(Traversable f, Applicative f) =>
ConvSizeChecked f (f a) -> f (ConvSizeChecked f a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
ConvSizeChecked f (f a) -> f (ConvSizeChecked f a)
$cmapM :: forall (f :: * -> *) (m :: * -> *) a b.
(Traversable f, Monad m) =>
(a -> m b) -> ConvSizeChecked f a -> m (ConvSizeChecked f b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ConvSizeChecked f a -> m (ConvSizeChecked f b)
$csequence :: forall (f :: * -> *) (m :: * -> *) a.
(Traversable f, Monad m) =>
ConvSizeChecked f (m a) -> m (ConvSizeChecked f a)
sequence :: forall (m :: * -> *) a.
Monad m =>
ConvSizeChecked f (m a) -> m (ConvSizeChecked f a)
Traversable)

deriving newtype instance (Semigroup (f a)) => Semigroup (ConvSizeChecked f a)

deriving newtype instance (Monoid (f a)) => Monoid (ConvSizeChecked f a)

checkedConvSize ::
  (Member (Error InvalidInput) r, Foldable f) =>
  Opts ->
  f a ->
  Sem r (ConvSizeChecked f a)
checkedConvSize :: forall (r :: EffectRow) (f :: * -> *) a.
(Member (Error InvalidInput) r, Foldable f) =>
Opts -> f a -> Sem r (ConvSizeChecked f a)
checkedConvSize Opts
o f a
x = do
  let Integer
minV :: Integer = Integer
0
      limit :: Word16
limit = Opts
o Opts -> Getting Word16 Opts Word16 -> Word16
forall s a. s -> Getting a s a -> a
^. (Settings -> Const Word16 Settings) -> Opts -> Const Word16 Opts
Lens' Opts Settings
settings ((Settings -> Const Word16 Settings) -> Opts -> Const Word16 Opts)
-> ((Word16 -> Const Word16 Word16)
    -> Settings -> Const Word16 Settings)
-> Getting Word16 Opts Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word16 -> Const Word16 Word16)
-> Settings -> Const Word16 Settings
Lens' Settings Word16
maxConvSize Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
- Word16
1
  if f a -> Int
forall a. f a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length f a
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
limit
    then ConvSizeChecked f a -> Sem r (ConvSizeChecked f a)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (f a -> ConvSizeChecked f a
forall {k} (f :: k -> *) (a :: k). f a -> ConvSizeChecked f a
ConvSizeChecked f a
x)
    else String -> Sem r (ConvSizeChecked f a)
forall (r :: EffectRow) a.
Member (Error InvalidInput) r =>
String -> Sem r a
throwErr (Integer -> Word16 -> ShowS
forall a b. (Show a, Show b) => a -> b -> ShowS
errorMsg Integer
minV Word16
limit String
"")

throwErr :: (Member (Error InvalidInput) r) => String -> Sem r a
throwErr :: forall (r :: EffectRow) a.
Member (Error InvalidInput) r =>
String -> Sem r a
throwErr = InvalidInput -> Sem r a
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw (InvalidInput -> Sem r a)
-> (String -> InvalidInput) -> String -> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LText -> InvalidInput
InvalidRange (LText -> InvalidInput)
-> (String -> LText) -> String -> InvalidInput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> LText
forall a. IsString a => String -> a
fromString