never executed always true always false

    1 module PureClaw.Security.Vault.Passphrase
    2   ( mkPassphraseVaultEncryptor
    3   ) where
    4 
    5 import Control.Concurrent.STM
    6 import Control.Monad.Trans.Except (runExceptT)
    7 import Crypto.Age (decrypt, encrypt)
    8 import Crypto.Age.Identity (Identity (..), ScryptIdentity (..))
    9 import Crypto.Age.Recipient (Recipients (..), ScryptRecipient (..))
   10 import Crypto.Age.Scrypt (Passphrase (..), WorkFactor, bytesToSalt, mkWorkFactor)
   11 import Crypto.Random (getRandomBytes)
   12 import Data.ByteArray (convert)
   13 import Data.ByteString (ByteString)
   14 import Data.List.NonEmpty (NonEmpty (..))
   15 import Data.Maybe (fromJust)
   16 import Data.Text qualified as T
   17 
   18 import PureClaw.Security.Vault.Age (VaultEncryptor (..), VaultError (..))
   19 
   20 -- | scrypt work factor (N = 2^22), matching the age CLI default.
   21 ageWorkFactor :: WorkFactor
   22 ageWorkFactor = fromJust (mkWorkFactor 22)
   23 
   24 -- | Convert a passphrase 'ByteString' to an age 'Passphrase'.
   25 toAgePass :: ByteString -> Passphrase
   26 toAgePass bs = Passphrase (convert bs)
   27 
   28 -- | Create a passphrase-based vault encryptor using the age encryption format.
   29 -- The resulting ciphertext is a standard age binary file, compatible with
   30 -- @age -d --passphrase@.
   31 -- The IO action is called at most once to obtain the passphrase, then cached.
   32 mkPassphraseVaultEncryptor :: IO ByteString -> IO VaultEncryptor
   33 mkPassphraseVaultEncryptor getPass = do
   34   cache <- newTVarIO Nothing
   35   let getOrPrompt = do
   36         c <- readTVarIO cache
   37         case c of
   38           Just p  -> pure p
   39           Nothing -> do
   40             p <- getPass
   41             atomically (writeTVar cache (Just p))
   42             pure p
   43   pure VaultEncryptor
   44     { _ve_encrypt = \plaintext -> do
   45         passphrase <- getOrPrompt
   46         saltBytes  <- getRandomBytes 16
   47         case bytesToSalt saltBytes of
   48           Nothing   -> pure (Left (VaultCorrupted "salt generation failed"))
   49           Just salt -> do
   50             let recipient = ScryptRecipient
   51                   { srPassphrase  = toAgePass passphrase
   52                   , srSalt        = salt
   53                   , srWorkFactor  = ageWorkFactor
   54                   }
   55             result <- runExceptT (encrypt (RecipientsScrypt recipient) plaintext)
   56             case result of
   57               Left  err -> pure (Left (VaultCorrupted ("age encrypt: " <> T.pack (show err))))
   58               Right ct  -> pure (Right ct)
   59     , _ve_decrypt = \ciphertext -> do
   60         passphrase <- getOrPrompt
   61         let identity   = ScryptIdentity
   62               { siPassphrase    = toAgePass passphrase
   63               , siMaxWorkFactor = ageWorkFactor
   64               }
   65             identities = IdentityScrypt identity :| []
   66         case decrypt identities ciphertext of
   67           Left  _  -> pure (Left (VaultCorrupted "wrong passphrase"))
   68           Right pt -> pure (Right pt)
   69     }