{-# 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
-> Ptr CString
-> Ptr ()
-> IO CDouble
type Password = String
type Entropy = Double
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