{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Data.Password.Internal (
PasswordCheck(..)
, newSalt
, toBytes
, fromBytes
, from64
, unsafePad64
, readT
, showT
,
) where
import Control.Monad.IO.Class (MonadIO (liftIO))
import Crypto.Random (getRandomBytes)
import Data.ByteArray (Bytes, convert)
import Data.ByteString (ByteString)
import Data.ByteString.Base64 (decodeBase64)
#if !MIN_VERSION_base(4,13,0)
import Data.Semigroup ((<>))
#endif
import Data.Text as T (
Text,
length,
pack,
replicate,
unpack,
)
import Data.Password.Types (Salt(..))
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Text.Read (readMaybe)
newSalt :: MonadIO m => Int -> m (Salt a)
newSalt :: forall (m :: * -> *) a. MonadIO m => Int -> m (Salt a)
newSalt Int
i = IO (Salt a) -> m (Salt a)
forall a. IO a -> m 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 byteArray. ByteArray byteArray => Int -> IO byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
i
{-# INLINE newSalt #-}
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
$c== :: PasswordCheck -> PasswordCheck -> Bool
== :: PasswordCheck -> PasswordCheck -> Bool
$c/= :: PasswordCheck -> PasswordCheck -> Bool
/= :: 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
$creadsPrec :: Int -> ReadS PasswordCheck
readsPrec :: Int -> ReadS PasswordCheck
$creadList :: ReadS [PasswordCheck]
readList :: ReadS [PasswordCheck]
$creadPrec :: ReadPrec PasswordCheck
readPrec :: ReadPrec PasswordCheck
$creadListPrec :: ReadPrec [PasswordCheck]
readListPrec :: ReadPrec [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
$cshowsPrec :: Int -> PasswordCheck -> ShowS
showsPrec :: Int -> PasswordCheck -> ShowS
$cshow :: PasswordCheck -> String
show :: PasswordCheck -> String
$cshowList :: [PasswordCheck] -> ShowS
showList :: [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 {a} {a}. Either a 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 a a -> Maybe a
toMaybe = (a -> Maybe a) -> (a -> Maybe a) -> Either a a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> a -> 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 :: Read a => Text -> Maybe a
readT :: forall a. Read a => 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 :: Show a => a -> Text
showT :: forall a. Show a => 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 #-}
unsafePad64 :: Text -> Text
unsafePad64 :: Text -> Text
unsafePad64 Text
t
| Int
remains Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Text
t
| Bool
otherwise = Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pad
where
remains :: Int
remains = Text -> Int
T.length Text
t Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
4
pad :: Text
pad = Int -> Text -> Text
T.replicate (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
remains) Text
"="