never executed always true always false

    1 module PureClaw.Security.Vault.Passphrase
    2   ( mkPassphraseVaultEncryptor
    3   ) where
    4 
    5 import Control.Concurrent.STM
    6 import Crypto.KDF.PBKDF2 (Parameters (..), fastPBKDF2_SHA256)
    7 import Crypto.Random (getRandomBytes)
    8 import Data.ByteString (ByteString)
    9 import Data.ByteString qualified as BS
   10 
   11 import PureClaw.Security.Crypto (decrypt, encrypt)
   12 import PureClaw.Security.Secrets (mkSecretKey)
   13 import PureClaw.Security.Vault.Age (VaultEncryptor (..), VaultError (..))
   14 
   15 -- Magic header identifying passphrase-encrypted vault files.
   16 magicHeader :: ByteString
   17 magicHeader = "PCLAWPW1"
   18 
   19 -- Magic prefix prepended to plaintext before encryption for passphrase verification.
   20 checkMagic :: ByteString
   21 checkMagic = "PCLAWCHK"
   22 
   23 saltLen :: Int
   24 saltLen = 32
   25 
   26 pbkdf2Params :: Parameters
   27 pbkdf2Params = Parameters { iterCounts = 100_000, outputLength = 32 }
   28 
   29 -- | Derive a 32-byte encryption key from a passphrase and salt using PBKDF2-SHA256.
   30 deriveKey :: ByteString -> ByteString -> ByteString
   31 deriveKey = fastPBKDF2_SHA256 pbkdf2Params
   32 
   33 -- | Create a passphrase-based vault encryptor.
   34 -- The IO action is called at most once to obtain the passphrase, then cached.
   35 mkPassphraseVaultEncryptor :: IO ByteString -> IO VaultEncryptor
   36 mkPassphraseVaultEncryptor getPass = do
   37   cache <- newTVarIO Nothing
   38   let getOrPrompt = do
   39         c <- readTVarIO cache
   40         case c of
   41           Just p  -> pure p
   42           Nothing -> do
   43             p <- getPass
   44             atomically (writeTVar cache (Just p))
   45             pure p
   46   pure VaultEncryptor
   47     { _ve_encrypt = \plaintext -> do
   48         passphrase <- getOrPrompt
   49         salt <- getRandomBytes saltLen
   50         let key = deriveKey passphrase salt
   51         result <- encrypt (mkSecretKey key) (checkMagic <> plaintext)
   52         case result of
   53           Left  _          -> pure (Left (VaultCorrupted "encryption failed"))
   54           Right ciphertext -> pure (Right (magicHeader <> salt <> ciphertext))
   55     , _ve_decrypt = \ciphertext -> do
   56         passphrase <- getOrPrompt
   57         let (hdr, rest) = BS.splitAt (BS.length magicHeader) ciphertext
   58         if hdr /= magicHeader
   59           then pure (Left (VaultCorrupted "not a passphrase-encrypted vault"))
   60           else do
   61             let (salt, encrypted) = BS.splitAt saltLen rest
   62             if BS.length salt < saltLen
   63               then pure (Left (VaultCorrupted "truncated vault file"))
   64               else do
   65                 let key = deriveKey passphrase salt
   66                 case decrypt (mkSecretKey key) encrypted of
   67                   Left  _ -> pure (Left (VaultCorrupted "decryption failed"))
   68                   Right plain ->
   69                     if checkMagic `BS.isPrefixOf` plain
   70                       then pure (Right (BS.drop (BS.length checkMagic) plain))
   71                       else pure (Left (VaultCorrupted "wrong passphrase"))
   72     }