-- SPDX-FileCopyrightText: 2021 Serokell <https://serokell.io/>
--
-- SPDX-License-Identifier: MPL-2.0

-- | Reading and writing sensitive data.
module Data.SensitiveBytes.IO
  ( withUserPassword
  ) where

import Prelude hiding (length)

import Control.Exception.Safe (MonadMask)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import System.IO (stdin, stdout)

import Data.SensitiveBytes (WithSecureMemory)
import Data.SensitiveBytes.Internal (SensitiveBytes (..), resized, withSensitiveBytes)
import Data.SensitiveBytes.IO.Internal.Password (readPassword)

-- | Ask the user to enter their password and read it securely.
--
-- “Securely” means “following all the best pracrices”, such as:
--
-- * Disable echoing the entered characters back to the terminal.
-- * Enable some sort of secure input mode, if the OS supports it.
-- * Store it in a secure region of memory.
--
-- Since this function reads the data into securely allocated memory,
-- which is very expensive to allocate, it needs to know the maximum
-- possible length of the password to be read.
-- If the user enters something longer, it will be silently discarded
-- (similar to @readpassphrase@ on BSD).
-- In the future it is possible that this limitation will be removed
-- at the cost of performing multiple expensive allocations.
--
-- This function always writes prompt to @stdout@ and then reads from @stdin@.
--
-- Example:
--
-- @
-- 'Data.SensitiveBytes.withSecureMemory' $
--   'withUserPassword' 128 (Just "Enter your password: ") $ \pw -> do
--     {- hash the @pw@ or do something else with it -}
-- @
withUserPassword
  :: forall m s r. (MonadIO m, MonadMask m, WithSecureMemory)
  => Int  -- ^ Maximum possible length of the password to read (in bytes).
  -> Maybe Text  -- ^ Prompt (defaults to "Password: ").
  -> (SensitiveBytes s -> m r)  -- ^ Action to perform with the password.
  -> m r
withUserPassword :: Int -> Maybe Text -> (SensitiveBytes s -> m r) -> m r
withUserPassword Int
maxLength Maybe Text
mprompt SensitiveBytes s -> m r
act =
    Int -> (SensitiveBytes s -> m r) -> m r
forall k (s :: k) (m :: * -> *) r.
(MonadIO m, MonadMask m, WithSecureMemory) =>
Int -> (SensitiveBytes s -> m r) -> m r
withSensitiveBytes Int
allocSize ((SensitiveBytes s -> m r) -> m r)
-> (SensitiveBytes s -> m r) -> m r
forall a b. (a -> b) -> a -> b
$ \sb :: SensitiveBytes s
sb@SensitiveBytes{ Ptr ()
bufPtr :: forall k (s :: k). SensitiveBytes s -> Ptr ()
bufPtr :: Ptr ()
bufPtr } -> do
      Int
size <- IO Int -> m Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> m Int) -> IO Int -> m Int
forall a b. (a -> b) -> a -> b
$ Handle -> Handle -> Text -> Ptr () -> Int -> IO Int
readPassword Handle
stdin Handle
stdout Text
prompt Ptr ()
bufPtr Int
allocSize
      SensitiveBytes s -> m r
act (Int -> SensitiveBytes s -> SensitiveBytes s
forall k (s :: k). Int -> SensitiveBytes s -> SensitiveBytes s
resized Int
size SensitiveBytes s
sb)
  where
    defaultPrompt :: Text
defaultPrompt = Text
"Password: "
    prompt :: Text
prompt = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
defaultPrompt Maybe Text
mprompt
    allocSize :: Int
allocSize = Int
maxLength  -- the C function does not null-terminate the string