{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}

-- |
-- Copyright: © 2018-2021 IOHK
-- License: Apache-2.0
--
-- Support for verifying hashed passwords from the old wallet codebase.
--
-- These passwords were encrypted by the @scrypt@ package using the following
-- parameters:
--  - logN = 14
--  - r = 8
--  - p = 1
--  - outputLength = 64
--
-- It is possible to disable support for legacy password hashing by compiling
-- with the @-scrypt@ Cabal flag.

module Cardano.Wallet.Primitive.Passphrase.Legacy
    ( -- * Legacy passphrases
      checkPassphrase
    , preparePassphrase

      -- * Testing-only scrypt password implementation
    , checkPassphraseTestingOnly
    , encryptPassphraseTestingOnly

      -- * Testing-only helper
    , haveScrypt

      -- * Internal functions
    , getSalt
    , genSalt
    ) where

import Prelude

import Cardano.Wallet.Primitive.Passphrase.Types
    ( Passphrase (..), PassphraseHash (..) )
import Crypto.Hash.Utils
    ( blake2b256 )
import Crypto.Random.Types
    ( MonadRandom (..) )
import Data.ByteArray.Encoding
    ( Base (..), convertFromBase, convertToBase )
import Data.ByteString
    ( ByteString )
import Data.Word
    ( Word64 )

import qualified Codec.CBOR.Encoding as CBOR
import qualified Codec.CBOR.Write as CBOR
import qualified Crypto.KDF.Scrypt as Scrypt
import qualified Data.ByteArray as BA
import qualified Data.ByteString.Char8 as B8
import Data.Either.Extra
    ( eitherToMaybe )

#if HAVE_SCRYPT
import Crypto.Scrypt
    ( EncryptedPass (..), Pass (..), verifyPass' )

-- | Verify a wallet spending password using the legacy Byron scrypt encryption
-- scheme.
checkPassphrase :: Passphrase "encryption" -> PassphraseHash -> Maybe Bool
checkPassphrase :: Passphrase "encryption" -> PassphraseHash -> Maybe Bool
checkPassphrase Passphrase "encryption"
pwd PassphraseHash
stored = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$
    Pass -> EncryptedPass -> Bool
verifyPass' (ByteString -> Pass
Pass (Passphrase "encryption" -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (Passphrase "encryption" -> Passphrase "encryption"
cborify Passphrase "encryption"
pwd))) EncryptedPass
encryptedPass
  where
    encryptedPass :: EncryptedPass
encryptedPass = ByteString -> EncryptedPass
EncryptedPass (PassphraseHash -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert PassphraseHash
stored)

haveScrypt :: Bool
haveScrypt :: Bool
haveScrypt = Bool
True
#else
-- | Stub function for when compiled without @scrypt@.
checkPassphrase :: Passphrase "encryption" -> PassphraseHash -> Maybe Bool
checkPassphrase _ _ = Nothing

haveScrypt :: Bool
haveScrypt = False
#endif

preparePassphrase :: Passphrase "user" -> Passphrase "encryption"
preparePassphrase :: Passphrase "user" -> Passphrase "encryption"
preparePassphrase = ScrubbedBytes -> Passphrase "encryption"
forall (purpose :: Symbol). ScrubbedBytes -> Passphrase purpose
Passphrase (ScrubbedBytes -> Passphrase "encryption")
-> (Passphrase "user" -> ScrubbedBytes)
-> Passphrase "user"
-> Passphrase "encryption"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScrubbedBytes -> ScrubbedBytes
forall a p.
(Monoid a, ByteArray p, Eq a, ByteArrayAccess a) =>
a -> p
hashMaybe (ScrubbedBytes -> ScrubbedBytes)
-> (Passphrase "user" -> ScrubbedBytes)
-> Passphrase "user"
-> ScrubbedBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Passphrase "user" -> ScrubbedBytes
forall (purpose :: Symbol). Passphrase purpose -> ScrubbedBytes
unPassphrase
  where
    hashMaybe :: a -> p
hashMaybe a
pw
        | a
pw a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Monoid a => a
mempty = p
forall a. Monoid a => a
mempty
        | Bool
otherwise = ByteString -> p
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ByteString -> p) -> ByteString -> p
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. ByteArrayAccess a => a -> ByteString
blake2b256 a
pw


-- | This is for use by test cases only. Use only the implementation from the
-- @scrypt@ package for application code.
checkPassphraseTestingOnly :: Passphrase "encryption" -> PassphraseHash -> Bool
checkPassphraseTestingOnly :: Passphrase "encryption" -> PassphraseHash -> Bool
checkPassphraseTestingOnly Passphrase "encryption"
pwd PassphraseHash
stored = case PassphraseHash -> Maybe (Passphrase "salt")
getSalt PassphraseHash
stored of
    Just Passphrase "salt"
salt -> Passphrase "encryption" -> Passphrase "salt" -> PassphraseHash
forall (m :: * -> *).
MonadRandom m =>
Passphrase "encryption" -> m PassphraseHash
encryptPassphraseTestingOnly Passphrase "encryption"
pwd Passphrase "salt"
salt PassphraseHash -> PassphraseHash -> Bool
forall a. Eq a => a -> a -> Bool
== PassphraseHash
stored
    Maybe (Passphrase "salt")
Nothing -> Bool
False

cborify :: Passphrase "encryption" -> Passphrase "encryption"
cborify :: Passphrase "encryption" -> Passphrase "encryption"
cborify = ScrubbedBytes -> Passphrase "encryption"
forall (purpose :: Symbol). ScrubbedBytes -> Passphrase purpose
Passphrase (ScrubbedBytes -> Passphrase "encryption")
-> (Passphrase "encryption" -> ScrubbedBytes)
-> Passphrase "encryption"
-> Passphrase "encryption"
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ScrubbedBytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ByteString -> ScrubbedBytes)
-> (Passphrase "encryption" -> ByteString)
-> Passphrase "encryption"
-> ScrubbedBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> ByteString
CBOR.toStrictByteString
    (Encoding -> ByteString)
-> (Passphrase "encryption" -> Encoding)
-> Passphrase "encryption"
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Encoding
CBOR.encodeBytes (ByteString -> Encoding)
-> (Passphrase "encryption" -> ByteString)
-> Passphrase "encryption"
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScrubbedBytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ScrubbedBytes -> ByteString)
-> (Passphrase "encryption" -> ScrubbedBytes)
-> Passphrase "encryption"
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Passphrase "encryption" -> ScrubbedBytes
forall (purpose :: Symbol). Passphrase purpose -> ScrubbedBytes
unPassphrase

-- | Extract salt field from pipe-delimited password hash.
-- This will fail unless there are exactly 5 fields
getSalt :: PassphraseHash -> Maybe (Passphrase "salt")
getSalt :: PassphraseHash -> Maybe (Passphrase "salt")
getSalt (PassphraseHash ScrubbedBytes
stored) = case Char -> ByteString -> [ByteString]
B8.split Char
'|' (ScrubbedBytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert ScrubbedBytes
stored) of
    [ByteString
_logN, ByteString
_r, ByteString
_p, ByteString
salt, ByteString
_passHash] -> Either String (Passphrase "salt") -> Maybe (Passphrase "salt")
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String (Passphrase "salt") -> Maybe (Passphrase "salt"))
-> Either String (Passphrase "salt") -> Maybe (Passphrase "salt")
forall a b. (a -> b) -> a -> b
$
        ScrubbedBytes -> Passphrase "salt"
forall (purpose :: Symbol). ScrubbedBytes -> Passphrase purpose
Passphrase (ScrubbedBytes -> Passphrase "salt")
-> Either String ScrubbedBytes -> Either String (Passphrase "salt")
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Base -> ByteString -> Either String ScrubbedBytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either String bout
convertFromBase Base
Base64 ByteString
salt
    [ByteString]
_ -> Maybe (Passphrase "salt")
forall a. Maybe a
Nothing

-- | This is for use by test cases only.
encryptPassphraseTestingOnly
    :: MonadRandom m
    => Passphrase "encryption"
    -> m PassphraseHash
encryptPassphraseTestingOnly :: Passphrase "encryption" -> m PassphraseHash
encryptPassphraseTestingOnly Passphrase "encryption"
pwd = Passphrase "salt" -> PassphraseHash
mkPassphraseHash (Passphrase "salt" -> PassphraseHash)
-> m (Passphrase "salt") -> m PassphraseHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Passphrase "salt")
forall (m :: * -> *). MonadRandom m => m (Passphrase "salt")
genSalt
  where
    mkPassphraseHash :: Passphrase "salt" -> PassphraseHash
mkPassphraseHash Passphrase "salt"
salt = ScrubbedBytes -> PassphraseHash
PassphraseHash (ScrubbedBytes -> PassphraseHash)
-> ScrubbedBytes -> PassphraseHash
forall a b. (a -> b) -> a -> b
$ ByteString -> ScrubbedBytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ByteString -> ScrubbedBytes) -> ByteString -> ScrubbedBytes
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> ByteString
B8.intercalate ByteString
"|"
        [ Int -> ByteString
showBS Int
logN, Int -> ByteString
showBS Int
r, Int -> ByteString
showBS Int
p
        , Base -> Passphrase "salt" -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
convertToBase Base
Base64 Passphrase "salt"
salt, Base -> ByteString -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
convertToBase Base
Base64 (Passphrase "salt" -> ByteString
passHash Passphrase "salt"
salt)]

    passHash :: Passphrase "salt" -> ByteString
    passHash :: Passphrase "salt" -> ByteString
passHash (Passphrase ScrubbedBytes
salt) = Parameters
-> Passphrase "encryption" -> ScrubbedBytes -> ByteString
forall password salt output.
(ByteArrayAccess password, ByteArrayAccess salt,
 ByteArray output) =>
Parameters -> password -> salt -> output
Scrypt.generate Parameters
params (Passphrase "encryption" -> Passphrase "encryption"
cborify Passphrase "encryption"
pwd) ScrubbedBytes
salt

    params :: Parameters
params = Word64 -> Int -> Int -> Int -> Parameters
Scrypt.Parameters ((Word64
2 :: Word64) Word64 -> Int -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
logN) Int
r Int
p Int
64
    logN :: Int
logN = Int
14
    r :: Int
r = Int
8
    p :: Int
p = Int
1

    showBS :: Int -> ByteString
showBS = String -> ByteString
B8.pack (String -> ByteString) -> (Int -> String) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show

genSalt :: MonadRandom m => m (Passphrase "salt")
genSalt :: m (Passphrase "salt")
genSalt = ScrubbedBytes -> Passphrase "salt"
forall (purpose :: Symbol). ScrubbedBytes -> Passphrase purpose
Passphrase (ScrubbedBytes -> Passphrase "salt")
-> m ScrubbedBytes -> m (Passphrase "salt")
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m ScrubbedBytes
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
32