{-# LANGUAGE ForeignFunctionInterface #-}

module Data.Digest.BCrypt
    ( bcrypt
    , genSalt
    , packBSalt
    , BSalt
    )
where

#include <stdlib.h>
#include "blf.h"
#include "bcrypt.h"

import Foreign
import Foreign.C.Types
import Foreign.C.String
import qualified Foreign.Ptr ( nullPtr )
import qualified System.IO.Unsafe ( unsafePerformIO )
import Data.ByteString.Char8 (split)
import qualified Data.ByteString.Unsafe as B
import qualified Data.ByteString.Internal as B ( fromForeignPtr
                                               , c_strlen
                                               )
import qualified Data.ByteString as B


-- | BCrypt salt for passing to bcrypt.
newtype BSalt = BSalt { -- | Deconstruct a BSalt to a bytestring
                        unBSalt::B.ByteString
                      } deriving (Eq, Ord, Show)

-- | Given a bytestring, construct a BSalt type, with some minimal checking
packBSalt :: B.ByteString   -- ^ Bytestring version of a BSalt
             -> Maybe BSalt -- ^ BSalt if the salt string validated
packBSalt s = do
    let unpacked = split '$' s in
        case unpacked of
          _:version:rounds:hashed:xs ->
            let vlen = B.length version
                rlen = B.length rounds
                hlen = B.length hashed in
            if and $ (vlen >= 2) : (rlen >= 1) : [hlen == 53]
            then Just $ BSalt s
            else Nothing
          _ -> Nothing

-- | Given a cost from 4-32 and a random seed of 16 bytes generate a salt.
-- Seed should be 16 bytes from a secure random generator
genSalt :: Integer         -- ^ Compute cost
           -> B.ByteString -- ^ 16 byte secure random seed
           -> Maybe BSalt  -- ^ Returned salt or Nothing
genSalt cost seed
       | B.length seed /= 16 = Nothing
       | otherwise = unsafePerformIO $
        B.useAsCString seed $ \s ->
             allocaBytes #{const BCRYPT_SALT_OUTPUT_SIZE} $ \out -> do
                 let seed' = (fromIntegral cost::CInt)
                 bsalt <- c_bcrypt_gensalt out seed' (castPtr s)
                 result <- B.packCString bsalt
                 return $ Just $ BSalt result

-- | Hash a password based on a BSalt with a given cost
bcrypt :: B.ByteString -- ^ Data to hash
          -> BSalt     -- ^ salt generated by genSalt
          -> B.ByteString
bcrypt key (BSalt salt) = unsafePerformIO $
       B.useAsCString key $ \k -> B.useAsCString salt $ \s ->
           allocaBytes #{const BCRYPT_OUTPUT_SIZE} $ \out -> do
               cptr <- c_bcrypt out k s
               if cptr == nullPtr -- On error, returns NULL
                 then return B.empty
                 else B.packCString cptr

foreign import ccall unsafe "bcrypt.h bcrypt_gensalt"
    c_bcrypt_gensalt :: CString -> CInt -> Ptr Word8 -> IO CString

foreign import ccall unsafe "bcrypt.h bcrypt"
    c_bcrypt :: CString -> CString -> CString -> IO CString