-- 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 Data.Metrics.Test where

import Data.Metrics.Types
import Data.Text qualified as Text
import Data.Text.Encoding
import Data.Text.Encoding.Error
import Data.Tree qualified as Tree
import Imports

-- | It is an error for one prefix to end in two different capture variables.  eg., these two
-- routes constitute a confict: "/user/:uid", "/user/:id".  There is a show instance that
-- explains this better.
data SiteConsistencyError = SiteConsistencyError
  { SiteConsistencyError -> [Text]
_siteConsistencyPrefix :: [Text],
    SiteConsistencyError -> [(Text, Int)]
_siteConsistencyCaptureVars :: [(Text, Int)]
  }
  deriving (SiteConsistencyError -> SiteConsistencyError -> Bool
(SiteConsistencyError -> SiteConsistencyError -> Bool)
-> (SiteConsistencyError -> SiteConsistencyError -> Bool)
-> Eq SiteConsistencyError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SiteConsistencyError -> SiteConsistencyError -> Bool
== :: SiteConsistencyError -> SiteConsistencyError -> Bool
$c/= :: SiteConsistencyError -> SiteConsistencyError -> Bool
/= :: SiteConsistencyError -> SiteConsistencyError -> Bool
Eq)

instance Show SiteConsistencyError where
  show :: SiteConsistencyError -> String
show (SiteConsistencyError [Text]
prefix [(Text, Int)]
conflicts) =
    String
"bad routing tables: the prefix "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show (Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
"/" [Text]
prefix)
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"contains these variables with (very roughly) the resp. numbers of routes under them: "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [(Text, Int)] -> String
forall a. Show a => a -> String
show [(Text, Int)]
conflicts

pathsConsistencyCheck :: Paths -> [SiteConsistencyError]
pathsConsistencyCheck :: Paths -> [SiteConsistencyError]
pathsConsistencyCheck (Paths Forest PathSegment
forest) = [[SiteConsistencyError]] -> [SiteConsistencyError]
forall a. Monoid a => [a] -> a
mconcat ([[SiteConsistencyError]] -> [SiteConsistencyError])
-> [[SiteConsistencyError]] -> [SiteConsistencyError]
forall a b. (a -> b) -> a -> b
$ [PathSegment] -> Tree PathSegment -> [SiteConsistencyError]
go [] (Tree PathSegment -> [SiteConsistencyError])
-> Forest PathSegment -> [[SiteConsistencyError]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Forest PathSegment
forest
  where
    go :: [PathSegment] -> Tree.Tree PathSegment -> [SiteConsistencyError]
    go :: [PathSegment] -> Tree PathSegment -> [SiteConsistencyError]
go [PathSegment]
prefix (Tree.Node PathSegment
root Forest PathSegment
trees) = Maybe SiteConsistencyError -> [SiteConsistencyError]
forall a. Maybe a -> [a]
maybeToList Maybe SiteConsistencyError
here [SiteConsistencyError]
-> [SiteConsistencyError] -> [SiteConsistencyError]
forall a. Semigroup a => a -> a -> a
<> [[SiteConsistencyError]] -> [SiteConsistencyError]
forall a. Monoid a => [a] -> a
mconcat ([PathSegment] -> Tree PathSegment -> [SiteConsistencyError]
go (PathSegment
root PathSegment -> [PathSegment] -> [PathSegment]
forall a. a -> [a] -> [a]
: [PathSegment]
prefix) (Tree PathSegment -> [SiteConsistencyError])
-> Forest PathSegment -> [[SiteConsistencyError]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Forest PathSegment
trees)
      where
        here :: Maybe SiteConsistencyError
here = [PathSegment] -> Forest PathSegment -> Maybe SiteConsistencyError
findSiteConsistencyError ([PathSegment] -> [PathSegment]
forall a. [a] -> [a]
reverse ([PathSegment] -> [PathSegment]) -> [PathSegment] -> [PathSegment]
forall a b. (a -> b) -> a -> b
$ PathSegment
root PathSegment -> [PathSegment] -> [PathSegment]
forall a. a -> [a] -> [a]
: [PathSegment]
prefix) Forest PathSegment
trees
    findSiteConsistencyError :: [PathSegment] -> Tree.Forest PathSegment -> Maybe SiteConsistencyError
    findSiteConsistencyError :: [PathSegment] -> Forest PathSegment -> Maybe SiteConsistencyError
findSiteConsistencyError [PathSegment]
prefix Forest PathSegment
subtrees = case (Tree PathSegment -> Maybe (Text, Int))
-> Forest PathSegment -> [(Text, Int)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Tree PathSegment -> Maybe (Text, Int)
forall any. Tree (Either ByteString any) -> Maybe (Text, Int)
captureVars Forest PathSegment
subtrees of
      [] -> Maybe SiteConsistencyError
forall a. Maybe a
Nothing
      [(Text, Int)
_] -> Maybe SiteConsistencyError
forall a. Maybe a
Nothing
      bad :: [(Text, Int)]
bad@((Text, Int)
_ : (Text, Int)
_ : [(Text, Int)]
_) ->
        SiteConsistencyError -> Maybe SiteConsistencyError
forall a. a -> Maybe a
Just (SiteConsistencyError -> Maybe SiteConsistencyError)
-> SiteConsistencyError -> Maybe SiteConsistencyError
forall a b. (a -> b) -> a -> b
$
          [Text] -> [(Text, Int)] -> SiteConsistencyError
SiteConsistencyError ((ByteString -> Text) -> (ByteString -> Text) -> PathSegment -> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ByteString -> Text
decode ByteString -> Text
decode (PathSegment -> Text) -> [PathSegment] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PathSegment]
prefix) [(Text, Int)]
bad
    captureVars :: Tree.Tree (Either ByteString any) -> Maybe (Text, Int)
    captureVars :: forall any. Tree (Either ByteString any) -> Maybe (Text, Int)
captureVars (Tree.Node (Left ByteString
root) [Tree (Either ByteString any)]
trees) = (Text, Int) -> Maybe (Text, Int)
forall a. a -> Maybe a
Just (ByteString -> Text
decode ByteString
root, [Tree (Either ByteString any)] -> Int
forall a. Forest a -> Int
weight [Tree (Either ByteString any)]
trees)
    captureVars (Tree.Node (Right any
_) [Tree (Either ByteString any)]
_) = Maybe (Text, Int)
forall a. Maybe a
Nothing
    weight :: Tree.Forest a -> Int
    weight :: forall a. Forest a -> Int
weight = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> (Forest a -> [Int]) -> Forest a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tree a -> Int) -> Forest a -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> (Tree a -> [a]) -> Tree a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a -> [a]
forall a. Tree a -> [a]
Tree.flatten)
    decode :: ByteString -> Text
decode = OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode