{-# LANGUAGE OverloadedStrings #-}

module Data.Text.Extended (
    module Data.Text
  , constTimeCompare
) where

import           Data.Bits
import           Data.Char
import           Data.Function       (on)
import qualified Data.List           as L
import           Data.Text
import           Prelude             hiding (length, zip)

constTimeCompare :: Text -> Text -> Bool
constTimeCompare :: Text -> Text -> Bool
constTimeCompare Text
l Text
r = Text -> Int
length Text
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Int
length Text
r Bool -> Bool -> Bool
&& Text -> Text -> Bool
comp' Text
l Text
r
  where
    comp' :: Text -> Text -> Bool
comp' Text
a Text
b = Int
0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' Int -> Int -> Int
forall a. Bits a => a -> a -> a
(.|.) Int
0 ((Char -> Char -> Int) -> (Char, Char) -> Int
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Int -> Int -> Int) -> (Char -> Int) -> Char -> Char -> Int
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Int -> Int -> Int
forall a. Bits a => a -> a -> a
xor Char -> Int
ord) ((Char, Char) -> Int) -> [(Char, Char)] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> [(Char, Char)]
zip Text
a Text
b)