{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Data.Password.Internal (
Password(..)
, mkPassword
, PasswordHash(..)
, PasswordCheck(..)
, Salt(..)
, newSalt
, unsafeShowPassword
, 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)
newtype Password = Password Text
deriving (String -> Password
(String -> Password) -> IsString Password
forall a. (String -> a) -> IsString a
fromString :: String -> Password
$cfromString :: String -> Password
IsString)
instance Show Password where
show :: Password -> String
show Password
_ = String
"**PASSWORD**"
mkPassword :: Text -> Password
mkPassword :: Text -> Password
mkPassword = Text -> Password
Password
{-# INLINE mkPassword #-}
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)
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 #-}
unsafeShowPassword :: Password -> Text
unsafeShowPassword :: Password -> Text
unsafeShowPassword (Password Text
pass) = Text
pass
{-# INLINE unsafeShowPassword #-}
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
data PasswordCheck
= PasswordCheckSuccess
| PasswordCheckFail
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)
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}