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)