{-# LANGUAGE BangPatterns #-}
module Network.Wai.Auth.Tools
  ( encodeKey
  , decodeKey
  , toLowerUnderscore
  , getValidEmail
  ) where

import qualified Data.ByteString        as S
import           Data.ByteString.Base64 as B64
import           Data.Char              (isLower, toLower)
import           Data.Foldable          (foldr')
import           Data.Maybe             (listToMaybe)
import           Data.Serialize         (Get, get, put, runGet, runPut)
import           Text.Regex.Posix       ((=~))
import           Web.ClientSession      (Key)


-- | Decode a `Key` that is in a base64 encoded serialized form
decodeKey :: S.ByteString -> Either String Key
decodeKey :: ByteString -> Either String Key
decodeKey ByteString
secretKeyB64 = ByteString -> Either String ByteString
B64.decode ByteString
secretKeyB64 Either String ByteString
-> (ByteString -> Either String Key) -> Either String Key
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Get Key -> ByteString -> Either String Key
forall a. Get a -> ByteString -> Either String a
runGet (Get Key
forall t. Serialize t => Get t
get :: Get Key)


-- | Serialize and base64 encode a secret `Key`
encodeKey :: Key -> S.ByteString
encodeKey :: Key -> ByteString
encodeKey = ByteString -> ByteString
B64.encode (ByteString -> ByteString)
-> (Key -> ByteString) -> Key -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut (Put -> ByteString) -> (Key -> Put) -> Key -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Put
forall t. Serialize t => Putter t
put


-- | Prepend all but the first capital letter with underscores and convert all
-- of them to lower case.
toLowerUnderscore :: String -> String
toLowerUnderscore :: String -> String
toLowerUnderscore [] = []
toLowerUnderscore (Char
x:String
xs) = Char -> Char
toLower Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: (Char -> String -> String) -> String -> String -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' Char -> String -> String
toLowerWithUnder [] String
xs
  where
    toLowerWithUnder :: Char -> String -> String
toLowerWithUnder !Char
y !String
acc
      | Char -> Bool
isLower Char
y = Char
y Char -> String -> String
forall a. a -> [a] -> [a]
: String
acc
      | Bool
otherwise = Char
'_' Char -> String -> String
forall a. a -> [a] -> [a]
: Char -> Char
toLower Char
y Char -> String -> String
forall a. a -> [a] -> [a]
: String
acc


-- | Check email list against a whitelist and pick first one that matches or
-- Nothing otherwise.
getValidEmail :: [S.ByteString] -> [S.ByteString] -> Maybe S.ByteString
getValidEmail :: [ByteString] -> [ByteString] -> Maybe ByteString
getValidEmail [ByteString]
whitelist [ByteString]
emails =
  [ByteString] -> Maybe ByteString
forall a. [a] -> Maybe a
listToMaybe ([ByteString] -> Maybe ByteString)
-> [ByteString] -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
S.null) [ByteString
e ByteString -> ByteString -> ByteString
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ ByteString
w | ByteString
e <- [ByteString]
emails, ByteString
w <- [ByteString]
whitelist]