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

This library provides datatypes for interacting with passwords.
It provides the types 'Password' and 'PasswordHash', which correspond
to plain-text and hashed passwords.

== Special instances

There is an accompanying <http://hackage.haskell.org/package/password-instances password-instances>
package that provides canonical typeclass instances for
'Password' and 'PasswordHash' for many common typeclasses, like
<http://hackage.haskell.org/package/aeson/docs/Data-Aeson.html#t:FromJSON FromJSON> from
<http://hackage.haskell.org/package/aeson aeson>,
<http://hackage.haskell.org/package/persistent/docs/Database-Persist-Class.html#t:PersistField PersistField>
from
<http://hackage.haskell.org/package/persistent persistent>, etc.

See the <http://hackage.haskell.org/package/password-instances password-instances> package for more information.

== Phantom types

The 'PasswordHash' and 'Salt' data types have a phantom type parameter
to be able to make sure salts and hashes can carry information about the
algorithm they should be used with.

For example, the @bcrypt@ algorithm requires its salt to be exactly
16 bytes (128 bits) long, so this way you won't accidentally use a
@'Salt' PBKDF2@ when the hashing function requires a @'Salt' Bcrypt@.
And checking a password using @bcrypt@ would obviously fail if checked
against a @'PasswordHash' PBKDF2@.

-}

module Data.Password.Types (
    -- * Plain-text Password
    Password
  , mkPassword
    -- * Password Hashing
  , PasswordHash (..)
    -- ** Unsafe debugging function to show a Password
  , unsafeShowPassword
    -- * Hashing salts
  , Salt (..)
  ) where

import Data.ByteArray (constEq)
import Data.ByteString (ByteString)
import Data.Function (on)
import Data.String (IsString(..))
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)

-- $setup
-- >>> :set -XOverloadedStrings

-- | 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**"
instance Show Password where
 show :: Password -> String
show Password
_ = String
"**PASSWORD**"

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

-- | This is an unsafe function that shows a password in plain-text.
--
-- >>> unsafeShowPassword ("foobar" :: Password)
-- "foobar"
--
-- You should generally __not use this function__ in production settings,
-- as you don't want to accidentally print a password anywhere, like
-- logs, network responses, database entries, etc.
--
-- This will mostly be used by other libraries to handle the actual
-- password internally, though it is conceivable that, even in a production
-- setting, a password might have to be handled in an unsafe manner at some point.
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

-- | A salt used by a hashing algorithm.
newtype Salt a = Salt
  { Salt a -> ByteString
getSalt :: 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)