{-# LINE 1 "Text/Password/Strength.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}

module Text.Password.Strength (Password, UserDict, Entropy, estimate) where



import Foreign
import Foreign.C
import System.IO.Unsafe

foreign import ccall unsafe "zxcvbn.h ZxcvbnMatch" zxcvbnMatch 
	:: CString
	-- ^ password
	-> Ptr CString
	-- ^ array of user dictionary words
	-> Ptr ()
	-- ^ used to get information about parts of the password,
	-- but this binding does not implement that, so a null pointer
	-> IO CDouble

type Password = String

-- | Entropy estimation in bits.
type Entropy = Double

-- | List of words that would be particularly bad in the password,
-- to suppliment the built-in word lists.
-- The name of the user is a good candidate to include here.
type UserDict = [String]

estimate :: Password -> UserDict -> Entropy
estimate :: Password -> UserDict -> Entropy
estimate Password
pw UserDict
ud = IO Entropy -> Entropy
forall a. IO a -> a
unsafePerformIO (IO Entropy -> Entropy) -> IO Entropy -> Entropy
forall a b. (a -> b) -> a -> b
$
	Password -> (Ptr CChar -> IO Entropy) -> IO Entropy
forall a. Password -> (Ptr CChar -> IO a) -> IO a
withCString Password
pw ((Ptr CChar -> IO Entropy) -> IO Entropy)
-> (Ptr CChar -> IO Entropy) -> IO Entropy
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
c_pw ->
		[Ptr CChar]
-> UserDict -> ([Ptr CChar] -> IO Entropy) -> IO Entropy
forall {a}.
[Ptr CChar] -> UserDict -> ([Ptr CChar] -> IO a) -> IO a
convud [] UserDict
ud (([Ptr CChar] -> IO Entropy) -> IO Entropy)
-> ([Ptr CChar] -> IO Entropy) -> IO Entropy
forall a b. (a -> b) -> a -> b
$ \[Ptr CChar]
c_udl -> 
			Ptr CChar
-> [Ptr CChar] -> (Ptr (Ptr CChar) -> IO Entropy) -> IO Entropy
forall a b. Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b
withArray0 Ptr CChar
forall a. Ptr a
nullPtr [Ptr CChar]
c_udl ((Ptr (Ptr CChar) -> IO Entropy) -> IO Entropy)
-> (Ptr (Ptr CChar) -> IO Entropy) -> IO Entropy
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CChar)
c_ud -> do
				CDouble
ent <- Ptr CChar -> Ptr (Ptr CChar) -> Ptr () -> IO CDouble
zxcvbnMatch Ptr CChar
c_pw Ptr (Ptr CChar)
c_ud Ptr ()
forall a. Ptr a
nullPtr
				Entropy -> IO Entropy
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Entropy -> IO Entropy) -> Entropy -> IO Entropy
forall a b. (a -> b) -> a -> b
$ Rational -> Entropy
forall a. Fractional a => Rational -> a
fromRational (Rational -> Entropy) -> Rational -> Entropy
forall a b. (a -> b) -> a -> b
$ CDouble -> Rational
forall a. Real a => a -> Rational
toRational CDouble
ent
  where
	convud :: [Ptr CChar] -> UserDict -> ([Ptr CChar] -> IO a) -> IO a
convud [Ptr CChar]
cs [] [Ptr CChar] -> IO a
a = [Ptr CChar] -> IO a
a [Ptr CChar]
cs
	convud [Ptr CChar]
cs (Password
x:UserDict
xs) [Ptr CChar] -> IO a
a = Password -> (Ptr CChar -> IO a) -> IO a
forall a. Password -> (Ptr CChar -> IO a) -> IO a
withCString Password
x ((Ptr CChar -> IO a) -> IO a) -> (Ptr CChar -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
c_x ->
		[Ptr CChar] -> UserDict -> ([Ptr CChar] -> IO a) -> IO a
convud (Ptr CChar
c_x Ptr CChar -> [Ptr CChar] -> [Ptr CChar]
forall a. a -> [a] -> [a]
: [Ptr CChar]
cs) UserDict
xs [Ptr CChar] -> IO a
a