{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-}

-- |
-- Copyright: © 2018-2021 IOHK
-- License: Apache-2.0
--
-- Hashing of wallet passwords.
--

module Cardano.Wallet.Primitive.Passphrase
    ( -- * Passphrases from the user
      Passphrase (..)
    , PassphraseMinLength (..)
    , PassphraseMaxLength (..)
    , validatePassphrase

      -- * Wallet passphrases stored as hashes
    , PassphraseHash (..)
    , PassphraseScheme (..)
    , currentPassphraseScheme
    , WalletPassphraseInfo (..)

      -- * Operations
    , encryptPassphrase
    , encryptPassphrase'
    , checkPassphrase
    , preparePassphrase
    , changePassphraseXPrv
    , checkAndChangePassphraseXPrv
    , ErrWrongPassphrase (..)
    ) where

import Prelude

import Cardano.Crypto.Wallet
    ( XPrv, xPrvChangePass )
import Cardano.Wallet.Primitive.Passphrase.Types
import Crypto.Random.Types
    ( MonadRandom )

import qualified Cardano.Wallet.Primitive.Passphrase.Current as PBKDF2
import qualified Cardano.Wallet.Primitive.Passphrase.Legacy as Scrypt

currentPassphraseScheme :: PassphraseScheme
currentPassphraseScheme :: PassphraseScheme
currentPassphraseScheme = PassphraseScheme
EncryptWithPBKDF2

-- | Hashes a 'Passphrase' into a format that is suitable for storing on
-- disk. It will always use the current scheme: pbkdf2-hmac-sha512.
encryptPassphrase
    :: MonadRandom m
    => Passphrase "user"
    -> m (PassphraseScheme, PassphraseHash)
encryptPassphrase :: Passphrase "user" -> m (PassphraseScheme, PassphraseHash)
encryptPassphrase = (PassphraseHash -> (PassphraseScheme, PassphraseHash))
-> m PassphraseHash -> m (PassphraseScheme, PassphraseHash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PassphraseScheme
currentPassphraseScheme,)
    (m PassphraseHash -> m (PassphraseScheme, PassphraseHash))
-> (Passphrase "user" -> m PassphraseHash)
-> Passphrase "user"
-> m (PassphraseScheme, PassphraseHash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PassphraseScheme -> Passphrase "user" -> m PassphraseHash
forall (m :: * -> *).
MonadRandom m =>
PassphraseScheme -> Passphrase "user" -> m PassphraseHash
encryptPassphrase' PassphraseScheme
currentPassphraseScheme

encryptPassphrase'
    :: MonadRandom m
    => PassphraseScheme
    -> Passphrase "user"
    -> m PassphraseHash
encryptPassphrase' :: PassphraseScheme -> Passphrase "user" -> m PassphraseHash
encryptPassphrase' PassphraseScheme
scheme = Passphrase "encryption" -> m PassphraseHash
encrypt (Passphrase "encryption" -> m PassphraseHash)
-> (Passphrase "user" -> Passphrase "encryption")
-> Passphrase "user"
-> m PassphraseHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PassphraseScheme -> Passphrase "user" -> Passphrase "encryption"
preparePassphrase PassphraseScheme
scheme
  where
    encrypt :: Passphrase "encryption" -> m PassphraseHash
encrypt = case PassphraseScheme
scheme of
        PassphraseScheme
EncryptWithPBKDF2 -> Passphrase "encryption" -> m PassphraseHash
forall (m :: * -> *).
MonadRandom m =>
Passphrase "encryption" -> m PassphraseHash
PBKDF2.encryptPassphrase
        PassphraseScheme
EncryptWithScrypt -> Passphrase "encryption" -> m PassphraseHash
forall (m :: * -> *).
MonadRandom m =>
Passphrase "encryption" -> m PassphraseHash
Scrypt.encryptPassphraseTestingOnly

-- | Manipulation done on legacy passphrases before used for encryption.
preparePassphrase
    :: PassphraseScheme
    -> Passphrase "user"
    -> Passphrase "encryption"
preparePassphrase :: PassphraseScheme -> Passphrase "user" -> Passphrase "encryption"
preparePassphrase = \case
    PassphraseScheme
EncryptWithPBKDF2 -> Passphrase "user" -> Passphrase "encryption"
PBKDF2.preparePassphrase
    PassphraseScheme
EncryptWithScrypt -> Passphrase "user" -> Passphrase "encryption"
Scrypt.preparePassphrase

-- | Check whether a 'Passphrase' matches with a stored 'Hash'
checkPassphrase
    :: PassphraseScheme
    -> Passphrase "user"
    -> PassphraseHash
    -> Either ErrWrongPassphrase ()
checkPassphrase :: PassphraseScheme
-> Passphrase "user"
-> PassphraseHash
-> Either ErrWrongPassphrase ()
checkPassphrase PassphraseScheme
scheme Passphrase "user"
received PassphraseHash
stored = case PassphraseScheme
scheme of
    PassphraseScheme
EncryptWithPBKDF2 -> Passphrase "encryption"
-> PassphraseHash -> Either ErrWrongPassphrase ()
PBKDF2.checkPassphrase Passphrase "encryption"
prepared PassphraseHash
stored
    PassphraseScheme
EncryptWithScrypt -> case Passphrase "encryption" -> PassphraseHash -> Maybe Bool
Scrypt.checkPassphrase Passphrase "encryption"
prepared PassphraseHash
stored of
        Just Bool
True -> () -> Either ErrWrongPassphrase ()
forall a b. b -> Either a b
Right ()
        Just Bool
False -> ErrWrongPassphrase -> Either ErrWrongPassphrase ()
forall a b. a -> Either a b
Left ErrWrongPassphrase
ErrWrongPassphrase
        Maybe Bool
Nothing -> ErrWrongPassphrase -> Either ErrWrongPassphrase ()
forall a b. a -> Either a b
Left (PassphraseScheme -> ErrWrongPassphrase
ErrPassphraseSchemeUnsupported PassphraseScheme
scheme)
  where
    prepared :: Passphrase "encryption"
prepared = PassphraseScheme -> Passphrase "user" -> Passphrase "encryption"
preparePassphrase PassphraseScheme
scheme Passphrase "user"
received

-- | Re-encrypts a wallet private key with a new passphrase.
--
-- **Important**:
-- This function doesn't check that the old passphrase is correct! Caller is
-- expected to have already checked that. Using an incorrect passphrase here
-- will lead to very bad thing.
changePassphraseXPrv
    :: (PassphraseScheme, Passphrase "user")
       -- ^ Old passphrase
    -> (PassphraseScheme, Passphrase "user")
       -- ^ New passphrase
    -> XPrv
       -- ^ Key to re-encrypt
    -> XPrv
changePassphraseXPrv :: (PassphraseScheme, Passphrase "user")
-> (PassphraseScheme, Passphrase "user") -> XPrv -> XPrv
changePassphraseXPrv (PassphraseScheme
oldS, Passphrase "user"
old) (PassphraseScheme
newS, Passphrase "user"
new) = Passphrase "encryption" -> Passphrase "encryption" -> XPrv -> XPrv
forall oldPassPhrase newPassPhrase.
(ByteArrayAccess oldPassPhrase, ByteArrayAccess newPassPhrase) =>
oldPassPhrase -> newPassPhrase -> XPrv -> XPrv
xPrvChangePass Passphrase "encryption"
oldP Passphrase "encryption"
newP
  where
    oldP :: Passphrase "encryption"
oldP = PassphraseScheme -> Passphrase "user" -> Passphrase "encryption"
preparePassphrase PassphraseScheme
oldS Passphrase "user"
old
    newP :: Passphrase "encryption"
newP = PassphraseScheme -> Passphrase "user" -> Passphrase "encryption"
preparePassphrase PassphraseScheme
newS Passphrase "user"
new

-- | Re-encrypts a wallet private key with a new passphrase.
checkAndChangePassphraseXPrv
    :: MonadRandom m
    => ((PassphraseScheme, PassphraseHash), Passphrase "user")
       -- ^ Old passphrase
    -> Passphrase "user"
       -- ^ New passphrase
    -> XPrv
       -- ^ Key to re-encrypt
    -> m (Either ErrWrongPassphrase ((PassphraseScheme, PassphraseHash), XPrv))
checkAndChangePassphraseXPrv :: ((PassphraseScheme, PassphraseHash), Passphrase "user")
-> Passphrase "user"
-> XPrv
-> m (Either
        ErrWrongPassphrase ((PassphraseScheme, PassphraseHash), XPrv))
checkAndChangePassphraseXPrv ((PassphraseScheme
oldS, PassphraseHash
oldH), Passphrase "user"
old) Passphrase "user"
new XPrv
key =
    case PassphraseScheme
-> Passphrase "user"
-> PassphraseHash
-> Either ErrWrongPassphrase ()
checkPassphrase PassphraseScheme
oldS Passphrase "user"
old PassphraseHash
oldH of
        Right () -> do
            (PassphraseScheme
newS, PassphraseHash
newH) <- Passphrase "user" -> m (PassphraseScheme, PassphraseHash)
forall (m :: * -> *).
MonadRandom m =>
Passphrase "user" -> m (PassphraseScheme, PassphraseHash)
encryptPassphrase Passphrase "user"
new
            let newKey :: XPrv
newKey = (PassphraseScheme, Passphrase "user")
-> (PassphraseScheme, Passphrase "user") -> XPrv -> XPrv
changePassphraseXPrv (PassphraseScheme
oldS, Passphrase "user"
old) (PassphraseScheme
newS, Passphrase "user"
new) XPrv
key
            Either
  ErrWrongPassphrase ((PassphraseScheme, PassphraseHash), XPrv)
-> m (Either
        ErrWrongPassphrase ((PassphraseScheme, PassphraseHash), XPrv))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
   ErrWrongPassphrase ((PassphraseScheme, PassphraseHash), XPrv)
 -> m (Either
         ErrWrongPassphrase ((PassphraseScheme, PassphraseHash), XPrv)))
-> Either
     ErrWrongPassphrase ((PassphraseScheme, PassphraseHash), XPrv)
-> m (Either
        ErrWrongPassphrase ((PassphraseScheme, PassphraseHash), XPrv))
forall a b. (a -> b) -> a -> b
$ ((PassphraseScheme, PassphraseHash), XPrv)
-> Either
     ErrWrongPassphrase ((PassphraseScheme, PassphraseHash), XPrv)
forall a b. b -> Either a b
Right ((PassphraseScheme
newS, PassphraseHash
newH), XPrv
newKey)
        Left ErrWrongPassphrase
e -> Either
  ErrWrongPassphrase ((PassphraseScheme, PassphraseHash), XPrv)
-> m (Either
        ErrWrongPassphrase ((PassphraseScheme, PassphraseHash), XPrv))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
   ErrWrongPassphrase ((PassphraseScheme, PassphraseHash), XPrv)
 -> m (Either
         ErrWrongPassphrase ((PassphraseScheme, PassphraseHash), XPrv)))
-> Either
     ErrWrongPassphrase ((PassphraseScheme, PassphraseHash), XPrv)
-> m (Either
        ErrWrongPassphrase ((PassphraseScheme, PassphraseHash), XPrv))
forall a b. (a -> b) -> a -> b
$ ErrWrongPassphrase
-> Either
     ErrWrongPassphrase ((PassphraseScheme, PassphraseHash), XPrv)
forall a b. a -> Either a b
Left ErrWrongPassphrase
e