{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-|
Module      : Data.Password.Internal
Copyright   : (c) Dennis Gosnell, 2019; Felix Paulusma, 2020
License     : BSD-style (see LICENSE file)
Maintainer  : cdep.illabout@gmail.com
Stability   : experimental
Portability : POSIX
-}

module Data.Password.Internal (
    -- * Global types
    Password(..)
  , mkPassword
  , PasswordHash(..)
  , PasswordCheck(..)
  , Salt(..)
  , newSalt
  -- * Unsafe function
  , unsafeShowPassword
  -- * Utility
  , toBytes
  , fromBytes
  , from64
  , readT
  , showT
  ) where

import Control.Monad.IO.Class (MonadIO(liftIO))
import Crypto.Random (getRandomBytes)
import Data.ByteArray (Bytes, constEq, convert)
import Data.ByteString (ByteString)
import Data.Function (on)
import Data.ByteString.Base64 (decodeBase64)
import Data.String (IsString(..))
import Data.Text as T (Text, pack, unpack)
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Text.Read (readMaybe)


-- | A plain-text password.
--
-- This represents a plain-text password that has /NOT/ been hashed.
--
-- You should be careful with 'Password'. Make sure not to write it to logs or
-- store it in a database.
--
-- You can construct a 'Password' by using the 'mkPassword' function or as literal
-- strings together with the OverloadedStrings pragma (or manually, by using
-- 'fromString' on a 'String'). Alternatively, you could also use some of the
-- instances in the <http://hackage.haskell.org/package/password-instances password-instances>
-- library.
newtype Password = Password Text
  deriving (String -> Password
(String -> Password) -> IsString Password
forall a. (String -> a) -> IsString a
fromString :: String -> Password
$cfromString :: String -> Password
IsString)

-- | CAREFUL: 'Show'-ing a 'Password' will always print @"**PASSWORD**"@
--
-- >>> show ("hello" :: Password)
-- "**PASSWORD**"
--
-- @since 1.0.0.0
instance Show Password where
 show :: Password -> String
show Password
_ = String
"**PASSWORD**"

-- | Construct a 'Password'
--
-- @since 1.0.0.0
mkPassword :: Text -> Password
mkPassword :: Text -> Password
mkPassword = Text -> Password
Password
{-# INLINE mkPassword #-}

-- | A salt used by a hashing algorithm.
--
-- @since 2.0.0.0
newtype Salt a = Salt ByteString
  deriving (Salt a -> Salt a -> Bool
(Salt a -> Salt a -> Bool)
-> (Salt a -> Salt a -> Bool) -> Eq (Salt a)
forall a. Salt a -> Salt a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Salt a -> Salt a -> Bool
$c/= :: forall a. Salt a -> Salt a -> Bool
== :: Salt a -> Salt a -> Bool
$c== :: forall a. Salt a -> Salt a -> Bool
Eq, Int -> Salt a -> ShowS
[Salt a] -> ShowS
Salt a -> String
(Int -> Salt a -> ShowS)
-> (Salt a -> String) -> ([Salt a] -> ShowS) -> Show (Salt a)
forall a. Int -> Salt a -> ShowS
forall a. [Salt a] -> ShowS
forall a. Salt a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Salt a] -> ShowS
$cshowList :: forall a. [Salt a] -> ShowS
show :: Salt a -> String
$cshow :: forall a. Salt a -> String
showsPrec :: Int -> Salt a -> ShowS
$cshowsPrec :: forall a. Int -> Salt a -> ShowS
Show)

-- | Generate a random x-byte-long salt.
--
-- @since 2.0.0.0
newSalt :: MonadIO m => Int -> m (Salt a)
newSalt :: Int -> m (Salt a)
newSalt Int
i = IO (Salt a) -> m (Salt a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Salt a) -> m (Salt a)) -> IO (Salt a) -> m (Salt a)
forall a b. (a -> b) -> a -> b
$ ByteString -> Salt a
forall a. ByteString -> Salt a
Salt (ByteString -> Salt a) -> IO ByteString -> IO (Salt a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO ByteString
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
i
{-# INLINE newSalt #-}

-- | This is an unsafe function that shows a password in plain-text.
--
-- >>> unsafeShowPassword ("foobar" :: Password)
-- "foobar"
--
-- You should generally not use this function.
unsafeShowPassword :: Password -> Text
unsafeShowPassword :: Password -> Text
unsafeShowPassword (Password Text
pass) = Text
pass
{-# INLINE unsafeShowPassword #-}

-- | A hashed password.
--
-- This represents a password that has been put through a hashing function.
-- The hashed password can be stored in a database.
newtype PasswordHash a = PasswordHash
  { PasswordHash a -> Text
unPasswordHash :: Text
  } deriving (Eq (PasswordHash a)
Eq (PasswordHash a)
-> (PasswordHash a -> PasswordHash a -> Ordering)
-> (PasswordHash a -> PasswordHash a -> Bool)
-> (PasswordHash a -> PasswordHash a -> Bool)
-> (PasswordHash a -> PasswordHash a -> Bool)
-> (PasswordHash a -> PasswordHash a -> Bool)
-> (PasswordHash a -> PasswordHash a -> PasswordHash a)
-> (PasswordHash a -> PasswordHash a -> PasswordHash a)
-> Ord (PasswordHash a)
PasswordHash a -> PasswordHash a -> Bool
PasswordHash a -> PasswordHash a -> Ordering
PasswordHash a -> PasswordHash a -> PasswordHash a
forall a. Eq (PasswordHash a)
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. PasswordHash a -> PasswordHash a -> Bool
forall a. PasswordHash a -> PasswordHash a -> Ordering
forall a. PasswordHash a -> PasswordHash a -> PasswordHash a
min :: PasswordHash a -> PasswordHash a -> PasswordHash a
$cmin :: forall a. PasswordHash a -> PasswordHash a -> PasswordHash a
max :: PasswordHash a -> PasswordHash a -> PasswordHash a
$cmax :: forall a. PasswordHash a -> PasswordHash a -> PasswordHash a
>= :: PasswordHash a -> PasswordHash a -> Bool
$c>= :: forall a. PasswordHash a -> PasswordHash a -> Bool
> :: PasswordHash a -> PasswordHash a -> Bool
$c> :: forall a. PasswordHash a -> PasswordHash a -> Bool
<= :: PasswordHash a -> PasswordHash a -> Bool
$c<= :: forall a. PasswordHash a -> PasswordHash a -> Bool
< :: PasswordHash a -> PasswordHash a -> Bool
$c< :: forall a. PasswordHash a -> PasswordHash a -> Bool
compare :: PasswordHash a -> PasswordHash a -> Ordering
$ccompare :: forall a. PasswordHash a -> PasswordHash a -> Ordering
$cp1Ord :: forall a. Eq (PasswordHash a)
Ord, ReadPrec [PasswordHash a]
ReadPrec (PasswordHash a)
Int -> ReadS (PasswordHash a)
ReadS [PasswordHash a]
(Int -> ReadS (PasswordHash a))
-> ReadS [PasswordHash a]
-> ReadPrec (PasswordHash a)
-> ReadPrec [PasswordHash a]
-> Read (PasswordHash a)
forall a. ReadPrec [PasswordHash a]
forall a. ReadPrec (PasswordHash a)
forall a. Int -> ReadS (PasswordHash a)
forall a. ReadS [PasswordHash a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PasswordHash a]
$creadListPrec :: forall a. ReadPrec [PasswordHash a]
readPrec :: ReadPrec (PasswordHash a)
$creadPrec :: forall a. ReadPrec (PasswordHash a)
readList :: ReadS [PasswordHash a]
$creadList :: forall a. ReadS [PasswordHash a]
readsPrec :: Int -> ReadS (PasswordHash a)
$creadsPrec :: forall a. Int -> ReadS (PasswordHash a)
Read, Int -> PasswordHash a -> ShowS
[PasswordHash a] -> ShowS
PasswordHash a -> String
(Int -> PasswordHash a -> ShowS)
-> (PasswordHash a -> String)
-> ([PasswordHash a] -> ShowS)
-> Show (PasswordHash a)
forall a. Int -> PasswordHash a -> ShowS
forall a. [PasswordHash a] -> ShowS
forall a. PasswordHash a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PasswordHash a] -> ShowS
$cshowList :: forall a. [PasswordHash a] -> ShowS
show :: PasswordHash a -> String
$cshow :: forall a. PasswordHash a -> String
showsPrec :: Int -> PasswordHash a -> ShowS
$cshowsPrec :: forall a. Int -> PasswordHash a -> ShowS
Show)

instance Eq (PasswordHash a)  where
  == :: PasswordHash a -> PasswordHash a -> Bool
(==) = ByteString -> ByteString -> Bool
forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
constEq (ByteString -> ByteString -> Bool)
-> (PasswordHash a -> ByteString)
-> PasswordHash a
-> PasswordHash a
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Text -> ByteString
encodeUtf8 (Text -> ByteString)
-> (PasswordHash a -> Text) -> PasswordHash a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PasswordHash a -> Text
forall a. PasswordHash a -> Text
unPasswordHash

-- | The result of checking a password against a hashed version. This is
-- returned by the @checkPassword@ functions.
data PasswordCheck
  = PasswordCheckSuccess
  -- ^ The password check was successful. The plain-text password matches the
  -- hashed password.
  | PasswordCheckFail
  -- ^ The password check failed. The plain-text password does not match the
  -- hashed password.
  deriving (PasswordCheck -> PasswordCheck -> Bool
(PasswordCheck -> PasswordCheck -> Bool)
-> (PasswordCheck -> PasswordCheck -> Bool) -> Eq PasswordCheck
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PasswordCheck -> PasswordCheck -> Bool
$c/= :: PasswordCheck -> PasswordCheck -> Bool
== :: PasswordCheck -> PasswordCheck -> Bool
$c== :: PasswordCheck -> PasswordCheck -> Bool
Eq, ReadPrec [PasswordCheck]
ReadPrec PasswordCheck
Int -> ReadS PasswordCheck
ReadS [PasswordCheck]
(Int -> ReadS PasswordCheck)
-> ReadS [PasswordCheck]
-> ReadPrec PasswordCheck
-> ReadPrec [PasswordCheck]
-> Read PasswordCheck
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PasswordCheck]
$creadListPrec :: ReadPrec [PasswordCheck]
readPrec :: ReadPrec PasswordCheck
$creadPrec :: ReadPrec PasswordCheck
readList :: ReadS [PasswordCheck]
$creadList :: ReadS [PasswordCheck]
readsPrec :: Int -> ReadS PasswordCheck
$creadsPrec :: Int -> ReadS PasswordCheck
Read, Int -> PasswordCheck -> ShowS
[PasswordCheck] -> ShowS
PasswordCheck -> String
(Int -> PasswordCheck -> ShowS)
-> (PasswordCheck -> String)
-> ([PasswordCheck] -> ShowS)
-> Show PasswordCheck
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PasswordCheck] -> ShowS
$cshowList :: [PasswordCheck] -> ShowS
show :: PasswordCheck -> String
$cshow :: PasswordCheck -> String
showsPrec :: Int -> PasswordCheck -> ShowS
$cshowsPrec :: Int -> PasswordCheck -> ShowS
Show)

-- | Converting 'Text' to 'Bytes'
toBytes :: Text -> Bytes
toBytes :: Text -> Bytes
toBytes = ByteString -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (ByteString -> Bytes) -> (Text -> ByteString) -> Text -> Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8
{-# INLINE toBytes #-}

-- | Converting 'Bytes' to 'Text'
fromBytes :: Bytes -> Text
fromBytes :: Bytes -> Text
fromBytes = ByteString -> Text
decodeUtf8 (ByteString -> Text) -> (Bytes -> ByteString) -> Bytes -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert
{-# INLINE fromBytes #-}

-- | Decodes a base64 'Text' to a regular 'ByteString' (if possible)
from64 :: Text -> Maybe ByteString
from64 :: Text -> Maybe ByteString
from64 = Either Text ByteString -> Maybe ByteString
forall b a. Either b a -> Maybe a
toMaybe (Either Text ByteString -> Maybe ByteString)
-> (Text -> Either Text ByteString) -> Text -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either Text ByteString
decodeBase64 (ByteString -> Either Text ByteString)
-> (Text -> ByteString) -> Text -> Either Text ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8
  where
    toMaybe :: Either b a -> Maybe a
toMaybe = (b -> Maybe a) -> (a -> Maybe a) -> Either b a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> b -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
Just
{-# INLINE from64 #-}

-- | Same as 'read' but works on 'Text'
readT :: forall a. Read a => Text -> Maybe a
readT :: Text -> Maybe a
readT = String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe a) -> (Text -> String) -> Text -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
{-# INLINE readT #-}

-- | Same as 'show' but works on 'Text'
showT :: forall a. Show a => a -> Text
showT :: a -> Text
showT = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
{-# INLINE showT #-}