{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-|
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
    PasswordCheck(..)
  , newSalt
  -- * Utility
  , toBytes
  , fromBytes
  , from64
  , unsafePad64
  , readT
  , showT
  , -- * Setup for doctests.
    -- $setup
  ) 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)

-- $setup
-- >>> import Data.ByteString as B (length)
-- >>> import Data.ByteString.Base64 (encodeBase64)
-- >>> import Data.Text as T (dropWhileEnd)
-- >>> import Data.Word (Word16)
-- >>> import Test.QuickCheck (ioProperty, quickCheck, (===))
-- >>> import Test.QuickCheck.Instances.ByteString()

-- | Generate a random x-byte-long salt.
--
-- >>> :{
-- quickCheck $ \w ->
--   ioProperty $ do
--     let i :: Num a => a
--         i = fromIntegral (w :: Word16)
--     Salt bs <- newSalt i
--     pure $ B.length bs === i
-- :}
-- +++ OK, passed 100 tests.
--
-- @since 2.0.0.0
newSalt :: MonadIO m => Int -> m (Salt a)
newSalt :: forall (m :: * -> *) a. MonadIO m => Int -> m (Salt a)
newSalt Int
i = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. ByteString -> Salt a
Salt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
i
{-# INLINE newSalt #-}

-- | 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
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]
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
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 = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall {a} {a}. Either a a -> Maybe a
toMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either Text ByteString
decodeBase64 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8
  where
    toMaybe :: Either a a -> Maybe a
toMaybe = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just
{-# INLINE from64 #-}

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

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

-- | (UNSAFE) Pad a base64 text to "length `rem` 4 == 0" with "="
--
-- prop> \bs -> let b64 = encodeBase64 bs in unsafePad64 (T.dropWhileEnd (== '=') b64) == b64
unsafePad64 :: Text -> Text
unsafePad64 :: Text -> Text
unsafePad64 Text
t
    | Int
remains forall a. Eq a => a -> a -> Bool
== Int
0 = Text
t
    | Bool
otherwise = Text
t forall a. Semigroup a => a -> a -> a
<> Text
pad
  where
    remains :: Int
remains = Text -> Int
T.length Text
t forall a. Integral a => a -> a -> a
`rem` Int
4
    pad :: Text
pad = Int -> Text -> Text
T.replicate (Int
4 forall a. Num a => a -> a -> a
- Int
remains) Text
"="