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\$

0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Browse other questions tagged or ask your own question.