2
\$\begingroup\$

I wrote some code to encrypt and decrypt some user credentials for services that a locally run application needs to work.

I get a password from the user, use it to stretch a key via Scrypt, and then use the key to do authenticated symmetric encryption with ChaChaPoly1305.

I use the hostname as salt for the key, so that a global attacker that somehow managed to obtain encrypted files for all users around the world, wouldn't be able to simply generate all the keys by bruteforcing passwords offline. I could've used random bytes instead .

Choice of crypto is based on these recommendations. I obviously always try to avoid writing my own crypto, but when I picked up this ChaChaPoly1305 library I found that it was a bit lower-level than expected.

stretchKey :: (MonadCrypto m, MonadError SomeException m) => ByteString -> m B.ScrubbedBytes
stretchKey pass = do
    salt <- getSalt
    liftCrypto $ toScrubbed $ getHash $ scrypt scryptParams (Salt salt) (Pass pass)

toScrubbed :: ByteString -> Either Error B.ScrubbedBytes
toScrubbed bs = mapLeft Error $ fill l $ putBytes bs
    where
        l = BS.length bs

liftCrypto :: (Exception e, MonadCrypto m, MonadError SomeException m) => Either e a -> m a
liftCrypto = either (throwError . SomeException) pure

encryptCredentials :: (MonadCrypto m, MonadError SomeException m) => String -> SavedCredentials -> m EncryptedData
encryptCredentials password creds = do
    nonce <- getEntropy 12
    key <- stretchKey $ encode password
    liftCrypto $ crypt chachaEncrypt nonce key $ encode $ show creds

encryptCredentials' :: (MonadCrypto m, MonadError SomeException m) => String -> SavedCredentials -> m LBS.ByteString
encryptCredentials' password creds = lazyEncode . show <$> encryptCredentials password creds


crypt :: (ByteString -> ChaCha.State -> (ByteString, ChaCha.State)) -- en/decrypter
      -> ByteString -- nonce (12 random bytes)
      -> B.ScrubbedBytes -- symmetric key
      -> ByteString -- input to be encrypted/decrypted
      -> Either CryptoError EncryptedData
crypt encrypter nonce key sourcetext = eitherCryptoError $ do
    st1 <- ChaCha.nonce12 nonce >>= ChaCha.initialize key
    let
        st2 = ChaCha.finalizeAAD $ ChaCha.appendAAD BS.empty st1
        (out, st3) = encrypter sourcetext st2
        auth = ChaCha.finalize st3
    return $ EncryptedData nonce out $ B.convert auth


saveCredentials :: (MonadWriteFS m, MonadInput m, MonadCrypto m, MonadError SomeException m) => SavedCredentials -> m ()
saveCredentials creds = do
    pass <- getPassword' "Please insert an encryption password for your credentials>"
    encryptedCreds <- encryptCredentials' pass creds
    writeFile "credentials.enc" encryptedCreds

decryptCredentials :: (MonadCrypto m, MonadError SomeException m, MonadInput m) => String -> EncryptedData -> m SavedCredentials
decryptCredentials password ed@(EncryptedData nonce cyphertext auth) = do
    key <- stretchKey $ encode password
    (EncryptedData _ plaintext auth') <- liftCrypto $ crypt chachaDecrypt nonce key cyphertext
    if auth /= auth' then do
        password' <- getPassword' "Incorrect password, please insert again>"
        decryptCredentials password' ed
    else maybe (throwMessage "I'm sorry, it looks like your saved credentials are corrupted")
                pure $ readMaybe $ decode plaintext

maybeDecrypt :: (MonadInput m, MonadReadFS m, MonadCrypto m, MonadError SomeException m) => FilePath -> String -> m SavedCredentials
maybeDecrypt filepath password = do
    maybeEncryptedData <- readMaybe . lazyDecode <$> readFile filepath
    case maybeEncryptedData of
        (Just encryptedData) -> decryptCredentials password encryptedData
        Nothing -> throwMessage "It looks like your encrypted credentials are corrupted"


decryptSavedCredentials :: (MonadInput m, MonadReadFS m, MonadCrypto m, MonadError SomeException m, Log m) => FilePath -> m (Maybe SavedCredentials)
decryptSavedCredentials filepath = do
    fileExists <- doesFileExist filepath
    if fileExists then do
        password <- getPassword' "Please insert your credentials decryption password>"
        catchError (Just <$> maybeDecrypt filepath password) $ \e -> do
                logError $ Text.pack $ displayException e
                pure Nothing
else pure Nothing

Here's the full code for this module, for the type definitions module and for the test. Documentation for the crypto library that I used.

One thing that I could probably improve is my usage of ScrubbedBytes: I use it only for the symmetric key, but I could probably use it for the password as well (but OTOH, I cannot use it for the web credentials I think, since eventually those will have to exit the process)

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.