1 {-# LANGUAGE ForeignFunctionInterface, OverloadedStrings, TemplateHaskell #-} 2 module Databrary.Service.Passwd 3 ( passwordPolicy 4 , passwdCheck 5 , Passwd 6 , initPasswd 7 ) where 8 9 import Control.Concurrent.MVar (MVar, newMVar, withMVar) 10 import qualified Crypto.BCrypt as BCrypt 11 import qualified Data.ByteString as BS 12 import qualified Data.ByteString.Char8 as BSC 13 import Foreign.C.String (CString) 14 import Foreign.Ptr (nullPtr) 15 16 import Databrary.Ops 17 import Paths_databrary (getDataFileName) 18 19 passwordPolicy :: BCrypt.HashingPolicy 20 passwordPolicy = BCrypt.HashingPolicy 21 { BCrypt.preferredHashAlgorithm = "$2b$" 22 , BCrypt.preferredHashCost = 12 23 } 24 25 foreign import ccall unsafe "crack.h FascistCheck" 26 cracklibCheck :: CString -> CString -> IO CString 27 28 newtype Passwd = Passwd { _passwdLock :: MVar () } 29 30 initPasswd :: IO Passwd 31 initPasswd = Passwd <$> newMVar () 32 33 -- | FIXME: bottleneck? Also, does GHC handle locking ccalls for us? 34 passwdCheck :: BS.ByteString -> BS.ByteString -> BS.ByteString -> Passwd -> IO (Maybe BS.ByteString) 35 passwdCheck passwd _ _ (Passwd lock) = 36 withMVar lock $ \() -> 37 BS.useAsCString passwd $ \p -> do 38 pw_dict <- getDataFileName "cracklib/pw_dict" 39 BS.useAsCString (BSC.pack pw_dict) $ \dict -> do 40 r <- cracklibCheck p dict 41 (r /= nullPtr) `thenReturn` (BS.packCString r)