{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module Wire.API.Password
  ( Password (..),
    PasswordStatus (..),
    genPassword,
    mkSafePassword,
    verifyPassword,
    verifyPasswordWithStatus,
    PasswordReqBody (..),
    argon2OptsFromHashingOpts,

    -- * Only for testing
    hashPasswordArgon2idWithSalt,
    mkSafePasswordScrypt,
    parsePassword,
  )
where

import Cassandra hiding (params)
import Crypto.Error
import Crypto.KDF.Argon2 qualified as Argon2
import Crypto.KDF.Scrypt as Scrypt
import Crypto.Random
import Data.Aeson qualified as A
import Data.ByteArray hiding (length)
import Data.ByteString.Base64 qualified as B64
import Data.ByteString.Char8 qualified as C8
import Data.ByteString.Lazy (fromStrict, toStrict)
import Data.Misc
import Data.OpenApi qualified as S
import Data.Schema
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text
import Imports
import OpenSSL.Random (randBytes)
import Util.Options

-- | A derived, stretched password that can be safely stored.
data Password
  = Argon2Password Argon2HashedPassword
  | ScryptPassword ScryptHashedPassword

instance Show Password where
  show :: Password -> [Char]
show Password
_ = [Char]
"<Password>"

instance Cql Password where
  ctype :: Tagged Password ColumnType
ctype = ColumnType -> Tagged Password ColumnType
forall a b. b -> Tagged a b
Tagged ColumnType
BlobColumn

  fromCql :: Value -> Either [Char] Password
fromCql (CqlBlob ByteString
lbs) = Text -> Either [Char] Password
parsePassword (Text -> Either [Char] Password)
-> (ByteString -> Text) -> ByteString -> Either [Char] Password
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict (ByteString -> Either [Char] Password)
-> ByteString -> Either [Char] Password
forall a b. (a -> b) -> a -> b
$ ByteString
lbs
  fromCql Value
_ = [Char] -> Either [Char] Password
forall a b. a -> Either a b
Left [Char]
"password: expected blob"

  toCql :: Password -> Value
toCql Password
pw = ByteString -> Value
CqlBlob (ByteString -> Value)
-> (ByteString -> ByteString) -> ByteString -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
fromStrict (ByteString -> Value) -> ByteString -> Value
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
Text.encodeUtf8 Text
encoded
    where
      encoded :: Text
encoded = case Password
pw of
        Argon2Password Argon2HashedPassword
argon2pw -> Argon2HashedPassword -> Text
encodeArgon2HashedPassword Argon2HashedPassword
argon2pw
        ScryptPassword ScryptHashedPassword
scryptpw -> ScryptHashedPassword -> Text
encodeScryptPassword ScryptHashedPassword
scryptpw

data Argon2HashedPassword = Argon2HashedPassword
  { Argon2HashedPassword -> Options
opts :: Argon2.Options,
    Argon2HashedPassword -> ByteString
salt :: ByteString,
    Argon2HashedPassword -> ByteString
hashedKey :: ByteString
  }

data ScryptHashedPassword = ScryptHashedPassword
  { ScryptHashedPassword -> ScryptParameters
params :: ScryptParameters,
    ScryptHashedPassword -> ByteString
salt :: ByteString,
    ScryptHashedPassword -> ByteString
hashedKey :: ByteString
  }

data PasswordStatus
  = PasswordStatusOk
  | PasswordStatusNeedsUpdate
  deriving (Int -> PasswordStatus -> ShowS
[PasswordStatus] -> ShowS
PasswordStatus -> [Char]
(Int -> PasswordStatus -> ShowS)
-> (PasswordStatus -> [Char])
-> ([PasswordStatus] -> ShowS)
-> Show PasswordStatus
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PasswordStatus -> ShowS
showsPrec :: Int -> PasswordStatus -> ShowS
$cshow :: PasswordStatus -> [Char]
show :: PasswordStatus -> [Char]
$cshowList :: [PasswordStatus] -> ShowS
showList :: [PasswordStatus] -> ShowS
Show, PasswordStatus -> PasswordStatus -> Bool
(PasswordStatus -> PasswordStatus -> Bool)
-> (PasswordStatus -> PasswordStatus -> Bool) -> Eq PasswordStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PasswordStatus -> PasswordStatus -> Bool
== :: PasswordStatus -> PasswordStatus -> Bool
$c/= :: PasswordStatus -> PasswordStatus -> Bool
/= :: PasswordStatus -> PasswordStatus -> Bool
Eq)

-------------------------------------------------------------------------------

data ScryptParameters = ScryptParameters
  { -- | Bytes to randomly generate as a unique salt, default is __32__
    ScryptParameters -> Word32
saltLength :: Word32,
    -- | log2(N) rounds to hash, default is __14__ (i.e. 2^14 rounds)
    ScryptParameters -> Word32
rounds :: Word32,
    -- | Block size, default is __8__
    --
    -- Limits are min: @1@, and max: @blockSize * scryptParallelism < 2 ^ 30@
    ScryptParameters -> Word32
blockSize :: Word32,
    -- | Parallelism factor, default is __1__
    --
    -- Limits are min: @0@, and max: @blockSize * scryptParallelism < 2 ^ 30@
    ScryptParameters -> Word32
parallelism :: Word32,
    -- | Output key length in bytes, default is __64__
    ScryptParameters -> Word32
outputLength :: Word32
  }
  deriving (ScryptParameters -> ScryptParameters -> Bool
(ScryptParameters -> ScryptParameters -> Bool)
-> (ScryptParameters -> ScryptParameters -> Bool)
-> Eq ScryptParameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScryptParameters -> ScryptParameters -> Bool
== :: ScryptParameters -> ScryptParameters -> Bool
$c/= :: ScryptParameters -> ScryptParameters -> Bool
/= :: ScryptParameters -> ScryptParameters -> Bool
Eq, Int -> ScryptParameters -> ShowS
[ScryptParameters] -> ShowS
ScryptParameters -> [Char]
(Int -> ScryptParameters -> ShowS)
-> (ScryptParameters -> [Char])
-> ([ScryptParameters] -> ShowS)
-> Show ScryptParameters
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScryptParameters -> ShowS
showsPrec :: Int -> ScryptParameters -> ShowS
$cshow :: ScryptParameters -> [Char]
show :: ScryptParameters -> [Char]
$cshowList :: [ScryptParameters] -> ShowS
showList :: [ScryptParameters] -> ShowS
Show)

defaultScryptParams :: ScryptParameters
defaultScryptParams :: ScryptParameters
defaultScryptParams =
  ScryptParameters
    { $sel:saltLength:ScryptParameters :: Word32
saltLength = Word32
32,
      $sel:rounds:ScryptParameters :: Word32
rounds = Word32
14,
      $sel:blockSize:ScryptParameters :: Word32
blockSize = Word32
8,
      $sel:parallelism:ScryptParameters :: Word32
parallelism = Word32
1,
      $sel:outputLength:ScryptParameters :: Word32
outputLength = Word32
64
    }

fromScrypt :: ScryptParameters -> Parameters
fromScrypt :: ScryptParameters -> Parameters
fromScrypt ScryptParameters
scryptParams =
  Parameters
    { n :: Word64
n = Word64
2 Word64 -> Word32 -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^ ScryptParameters
scryptParams.rounds,
      r :: Int
r = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ScryptParameters
scryptParams.blockSize,
      p :: Int
p = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ScryptParameters
scryptParams.parallelism,
      outputLength :: Int
outputLength = Int
64
    }

argon2OptsFromHashingOpts :: PasswordHashingOptions -> Argon2.Options
argon2OptsFromHashingOpts :: PasswordHashingOptions -> Options
argon2OptsFromHashingOpts PasswordHashingOptions {Word32
iterations :: Word32
memory :: Word32
parallelism :: Word32
$sel:iterations:PasswordHashingOptions :: PasswordHashingOptions -> Word32
$sel:memory:PasswordHashingOptions :: PasswordHashingOptions -> Word32
$sel:parallelism:PasswordHashingOptions :: PasswordHashingOptions -> Word32
..} =
  Argon2.Options
    { variant :: Variant
variant = Variant
Argon2.Argon2id,
      version :: Version
version = Version
Argon2.Version13,
      iterations :: Word32
iterations = Word32
iterations,
      memory :: Word32
memory = Word32
memory,
      parallelism :: Word32
parallelism = Word32
parallelism
    }

-------------------------------------------------------------------------------

-- | Generate a strong, random plaintext password of length 16
-- containing only alphanumeric characters, '+' and '/'.
genPassword :: (MonadIO m) => m PlainTextPassword8
genPassword :: forall (m :: * -> *). MonadIO m => m PlainTextPassword8
genPassword =
  IO PlainTextPassword8 -> m PlainTextPassword8
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PlainTextPassword8 -> m PlainTextPassword8)
-> (IO ByteString -> IO PlainTextPassword8)
-> IO ByteString
-> m PlainTextPassword8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> PlainTextPassword8)
-> IO ByteString -> IO PlainTextPassword8
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> PlainTextPassword8
plainTextPassword8Unsafe (Text -> PlainTextPassword8)
-> (ByteString -> Text) -> ByteString -> PlainTextPassword8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B64.encode) (IO ByteString -> m PlainTextPassword8)
-> IO ByteString -> m PlainTextPassword8
forall a b. (a -> b) -> a -> b
$
    Int -> IO ByteString
randBytes Int
12

mkSafePasswordScrypt :: (MonadIO m) => PlainTextPassword' t -> m Password
mkSafePasswordScrypt :: forall (m :: * -> *) (t :: Nat).
MonadIO m =>
PlainTextPassword' t -> m Password
mkSafePasswordScrypt = (ScryptHashedPassword -> Password)
-> m ScryptHashedPassword -> m Password
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ScryptHashedPassword -> Password
ScryptPassword (m ScryptHashedPassword -> m Password)
-> (PlainTextPassword' t -> m ScryptHashedPassword)
-> PlainTextPassword' t
-> m Password
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> m ScryptHashedPassword
forall (m :: * -> *).
MonadIO m =>
ByteString -> m ScryptHashedPassword
hashPasswordScrypt (ByteString -> m ScryptHashedPassword)
-> (PlainTextPassword' t -> ByteString)
-> PlainTextPassword' t
-> m ScryptHashedPassword
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8 (Text -> ByteString)
-> (PlainTextPassword' t -> Text)
-> PlainTextPassword' t
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlainTextPassword' t -> Text
forall (t :: Nat). PlainTextPassword' t -> Text
fromPlainTextPassword

mkSafePassword :: (MonadIO m) => Argon2.Options -> PlainTextPassword' t -> m Password
mkSafePassword :: forall (m :: * -> *) (t :: Nat).
MonadIO m =>
Options -> PlainTextPassword' t -> m Password
mkSafePassword Options
opts = (Argon2HashedPassword -> Password)
-> m Argon2HashedPassword -> m Password
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Argon2HashedPassword -> Password
Argon2Password (m Argon2HashedPassword -> m Password)
-> (PlainTextPassword' t -> m Argon2HashedPassword)
-> PlainTextPassword' t
-> m Password
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> ByteString -> m Argon2HashedPassword
forall (m :: * -> *).
MonadIO m =>
Options -> ByteString -> m Argon2HashedPassword
hashPasswordArgon2id Options
opts (ByteString -> m Argon2HashedPassword)
-> (PlainTextPassword' t -> ByteString)
-> PlainTextPassword' t
-> m Argon2HashedPassword
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8 (Text -> ByteString)
-> (PlainTextPassword' t -> Text)
-> PlainTextPassword' t
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlainTextPassword' t -> Text
forall (t :: Nat). PlainTextPassword' t -> Text
fromPlainTextPassword

-- | Verify a plaintext password from user input against a stretched
-- password from persistent storage.
verifyPassword :: PlainTextPassword' t -> Password -> Bool
verifyPassword :: forall (t :: Nat). PlainTextPassword' t -> Password -> Bool
verifyPassword = ((Bool, PasswordStatus) -> Bool
forall a b. (a, b) -> a
fst .) ((Password -> (Bool, PasswordStatus)) -> Password -> Bool)
-> (PlainTextPassword' t -> Password -> (Bool, PasswordStatus))
-> PlainTextPassword' t
-> Password
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlainTextPassword' t -> Password -> (Bool, PasswordStatus)
forall (t :: Nat).
PlainTextPassword' t -> Password -> (Bool, PasswordStatus)
verifyPasswordWithStatus

verifyPasswordWithStatus :: PlainTextPassword' t -> Password -> (Bool, PasswordStatus)
verifyPasswordWithStatus :: forall (t :: Nat).
PlainTextPassword' t -> Password -> (Bool, PasswordStatus)
verifyPasswordWithStatus (PlainTextPassword' t -> Text
forall (t :: Nat). PlainTextPassword' t -> Text
fromPlainTextPassword -> Text
plain) Password
hashed =
  case Password
hashed of
    (Argon2Password Argon2HashedPassword {ByteString
Options
$sel:opts:Argon2HashedPassword :: Argon2HashedPassword -> Options
$sel:salt:Argon2HashedPassword :: Argon2HashedPassword -> ByteString
$sel:hashedKey:Argon2HashedPassword :: Argon2HashedPassword -> ByteString
opts :: Options
salt :: ByteString
hashedKey :: ByteString
..}) ->
      let producedKey :: ByteString
producedKey = Options -> ByteString -> ByteString -> ByteString
hashPasswordWithOptions Options
opts (Text -> ByteString
Text.encodeUtf8 Text
plain) ByteString
salt
       in (ByteString
hashedKey ByteString -> ByteString -> Bool
forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
`constEq` ByteString
producedKey, PasswordStatus
PasswordStatusOk)
    (ScryptPassword ScryptHashedPassword {ByteString
ScryptParameters
$sel:params:ScryptHashedPassword :: ScryptHashedPassword -> ScryptParameters
$sel:salt:ScryptHashedPassword :: ScryptHashedPassword -> ByteString
$sel:hashedKey:ScryptHashedPassword :: ScryptHashedPassword -> ByteString
params :: ScryptParameters
salt :: ByteString
hashedKey :: ByteString
..}) ->
      let producedKey :: ByteString
producedKey = ScryptParameters -> ByteString -> ByteString -> ByteString
forall password salt.
(ByteArrayAccess password, ByteArrayAccess salt) =>
ScryptParameters -> password -> salt -> ByteString
hashPasswordWithParams ScryptParameters
params (Text -> ByteString
Text.encodeUtf8 Text
plain) ByteString
salt
       in (ByteString
hashedKey ByteString -> ByteString -> Bool
forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
`constEq` ByteString
producedKey, PasswordStatus
PasswordStatusNeedsUpdate)

hashPasswordScrypt :: (MonadIO m) => ByteString -> m ScryptHashedPassword
hashPasswordScrypt :: forall (m :: * -> *).
MonadIO m =>
ByteString -> m ScryptHashedPassword
hashPasswordScrypt ByteString
password = do
  ByteString
salt <- Int -> m ByteString
forall (m :: * -> *). MonadIO m => Int -> m ByteString
newSalt (Int -> m ByteString) -> Int -> m ByteString
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ScryptParameters
defaultScryptParams.saltLength
  let params :: ScryptParameters
params = ScryptParameters
defaultScryptParams
  let hashedKey :: ByteString
hashedKey = ScryptParameters -> ByteString -> ByteString -> ByteString
forall password salt.
(ByteArrayAccess password, ByteArrayAccess salt) =>
ScryptParameters -> password -> salt -> ByteString
hashPasswordWithParams ScryptParameters
params ByteString
password ByteString
salt
  ScryptHashedPassword -> m ScryptHashedPassword
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScryptHashedPassword -> m ScryptHashedPassword)
-> ScryptHashedPassword -> m ScryptHashedPassword
forall a b. (a -> b) -> a -> b
$! ScryptHashedPassword {ByteString
ScryptParameters
$sel:params:ScryptHashedPassword :: ScryptParameters
$sel:salt:ScryptHashedPassword :: ByteString
$sel:hashedKey:ScryptHashedPassword :: ByteString
salt :: ByteString
params :: ScryptParameters
hashedKey :: ByteString
..}

encodeScryptPassword :: ScryptHashedPassword -> Text
encodeScryptPassword :: ScryptHashedPassword -> Text
encodeScryptPassword ScryptHashedPassword {ByteString
ScryptParameters
$sel:params:ScryptHashedPassword :: ScryptHashedPassword -> ScryptParameters
$sel:salt:ScryptHashedPassword :: ScryptHashedPassword -> ByteString
$sel:hashedKey:ScryptHashedPassword :: ScryptHashedPassword -> ByteString
params :: ScryptParameters
salt :: ByteString
hashedKey :: ByteString
..} =
  Text -> [Text] -> Text
Text.intercalate
    Text
"|"
    [ Word32 -> Text
forall a. Show a => a -> Text
showT ScryptParameters
defaultScryptParams.rounds,
      Word32 -> Text
forall a. Show a => a -> Text
showT ScryptParameters
defaultScryptParams.blockSize,
      Word32 -> Text
forall a. Show a => a -> Text
showT ScryptParameters
defaultScryptParams.parallelism,
      ByteString -> Text
Text.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B64.encode (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString
salt,
      ByteString -> Text
Text.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B64.encode (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString
hashedKey
    ]

hashPasswordArgon2id :: (MonadIO m) => Argon2.Options -> ByteString -> m Argon2HashedPassword
hashPasswordArgon2id :: forall (m :: * -> *).
MonadIO m =>
Options -> ByteString -> m Argon2HashedPassword
hashPasswordArgon2id Options
opts ByteString
pwd = do
  ByteString
salt <- Int -> m ByteString
forall (m :: * -> *). MonadIO m => Int -> m ByteString
newSalt Int
16
  Argon2HashedPassword -> m Argon2HashedPassword
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Argon2HashedPassword -> m Argon2HashedPassword)
-> Argon2HashedPassword -> m Argon2HashedPassword
forall a b. (a -> b) -> a -> b
$! Options -> ByteString -> ByteString -> Argon2HashedPassword
hashPasswordArgon2idWithSalt Options
opts ByteString
salt ByteString
pwd

hashPasswordArgon2idWithSalt :: Argon2.Options -> ByteString -> ByteString -> Argon2HashedPassword
hashPasswordArgon2idWithSalt :: Options -> ByteString -> ByteString -> Argon2HashedPassword
hashPasswordArgon2idWithSalt Options
opts ByteString
salt ByteString
pwd = do
  let hashedKey :: ByteString
hashedKey = Options -> ByteString -> ByteString -> ByteString
hashPasswordWithOptions Options
opts ByteString
pwd ByteString
salt
   in Argon2HashedPassword {ByteString
Options
$sel:opts:Argon2HashedPassword :: Options
$sel:salt:Argon2HashedPassword :: ByteString
$sel:hashedKey:Argon2HashedPassword :: ByteString
opts :: Options
salt :: ByteString
hashedKey :: ByteString
..}

encodeArgon2HashedPassword :: Argon2HashedPassword -> Text
encodeArgon2HashedPassword :: Argon2HashedPassword -> Text
encodeArgon2HashedPassword Argon2HashedPassword {ByteString
Options
$sel:opts:Argon2HashedPassword :: Argon2HashedPassword -> Options
$sel:salt:Argon2HashedPassword :: Argon2HashedPassword -> ByteString
$sel:hashedKey:Argon2HashedPassword :: Argon2HashedPassword -> ByteString
opts :: Options
salt :: ByteString
hashedKey :: ByteString
..} =
  let optsStr :: Text
optsStr =
        Text -> [Text] -> Text
Text.intercalate
          Text
","
          [ Text
"m=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word32 -> Text
forall a. Show a => a -> Text
showT Options
opts.memory,
            Text
"t=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word32 -> Text
forall a. Show a => a -> Text
showT Options
opts.iterations,
            Text
"p=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word32 -> Text
forall a. Show a => a -> Text
showT Options
opts.parallelism
          ]
   in Text
"$argon2"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate
          Text
"$"
          [ Variant -> Text
variantToCode Options
opts.variant,
            Text
"v=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
versionToNum Options
opts.version,
            Text
optsStr,
            ByteString -> Text
encodeWithoutPadding ByteString
salt,
            ByteString -> Text
encodeWithoutPadding ByteString
hashedKey
          ]
  where
    encodeWithoutPadding :: ByteString -> Text
encodeWithoutPadding = (Char -> Bool) -> Text -> Text
Text.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=') (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B64.encode

parsePassword :: Text -> Either String Password
parsePassword :: Text -> Either [Char] Password
parsePassword Text
expected =
  case Text -> Either [Char] Argon2HashedPassword
parseArgon2idPasswordHashOptions Text
expected of
    Right Argon2HashedPassword
hashedPassword -> Password -> Either [Char] Password
forall a b. b -> Either a b
Right (Password -> Either [Char] Password)
-> Password -> Either [Char] Password
forall a b. (a -> b) -> a -> b
$ Argon2HashedPassword -> Password
Argon2Password Argon2HashedPassword
hashedPassword
    Left [Char]
argon2ParseError ->
      case ByteString -> Either [Char] ScryptHashedPassword
parseScryptPasswordHashParams (ByteString -> Either [Char] ScryptHashedPassword)
-> ByteString -> Either [Char] ScryptHashedPassword
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
Text.encodeUtf8 Text
expected of
        Right ScryptHashedPassword
hashedPassword -> Password -> Either [Char] Password
forall a b. b -> Either a b
Right (Password -> Either [Char] Password)
-> Password -> Either [Char] Password
forall a b. (a -> b) -> a -> b
$ ScryptHashedPassword -> Password
ScryptPassword ScryptHashedPassword
hashedPassword
        Left [Char]
scryptParseError ->
          [Char] -> Either [Char] Password
forall a b. a -> Either a b
Left ([Char] -> Either [Char] Password)
-> [Char] -> Either [Char] Password
forall a b. (a -> b) -> a -> b
$
            [Char]
"Failed to parse Argon2 or Scrypt. Argon2 parse error: "
              [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
argon2ParseError
              [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
", Scrypt parse error: "
              [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
scryptParseError

newSalt :: (MonadIO m) => Int -> m ByteString
newSalt :: forall (m :: * -> *). MonadIO m => Int -> m ByteString
newSalt Int
i = IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> 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 #-}

parseArgon2idPasswordHashOptions :: Text -> Either String Argon2HashedPassword
parseArgon2idPasswordHashOptions :: Text -> Either [Char] Argon2HashedPassword
parseArgon2idPasswordHashOptions Text
passwordHash = do
  let paramsList :: [Text]
paramsList = (Char -> Bool) -> Text -> [Text]
Text.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'$') Text
passwordHash
  -- The first param is empty string b/c the string begins with a separator `$`.
  case [Text]
paramsList of
    [Text
"", Text
variantStr, Text
verStr, Text
opts, Text
salt, Text
hashedKey64] -> do
      Version
version <- Text -> Either [Char] Version
parseVersion Text
verStr
      Text
-> Version
-> Text
-> Text
-> Text
-> Either [Char] Argon2HashedPassword
parseAll Text
variantStr Version
version Text
opts Text
salt Text
hashedKey64
    [Text
"", Text
variantStr, Text
opts, Text
salt, Text
hashedKey64] -> do
      Text
-> Version
-> Text
-> Text
-> Text
-> Either [Char] Argon2HashedPassword
parseAll Text
variantStr Version
Argon2.Version10 Text
opts Text
salt Text
hashedKey64
    [Text]
_ -> [Char] -> Either [Char] Argon2HashedPassword
forall a b. a -> Either a b
Left ([Char] -> Either [Char] Argon2HashedPassword)
-> [Char] -> Either [Char] Argon2HashedPassword
forall a b. (a -> b) -> a -> b
$ [Char]
"failed to parse argon2id hashed password, expected 5 or 6 params, got: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show ([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
paramsList)
  where
    parseVersion :: Text -> Either [Char] Version
parseVersion =
      Either [Char] Version
-> (Version -> Either [Char] Version)
-> Maybe Version
-> Either [Char] Version
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Either [Char] Version
forall a b. a -> Either a b
Left [Char]
"failed to parse argon2 version") Version -> Either [Char] Version
forall a b. b -> Either a b
Right
        (Maybe Version -> Either [Char] Version)
-> (Text -> Maybe Version) -> Text -> Either [Char] Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (Text -> Maybe Version) -> Text -> Maybe Version
forall a. Text -> (Text -> Maybe a) -> Text -> Maybe a
splitMaybe Text
"v=" Text -> Maybe Version
numToVersion

    parseAll :: Text -> Argon2.Version -> Text -> Text -> Text -> Either String Argon2HashedPassword
    parseAll :: Text
-> Version
-> Text
-> Text
-> Text
-> Either [Char] Argon2HashedPassword
parseAll Text
variantStr Version
version Text
parametersStr Text
salt64 Text
hashedKey64 = do
      Variant
variant <- Text -> Either [Char] Variant
parseVariant Text
variantStr
      (Word32
memory, Word32
iterations, Word32
parallelism) <- Text -> Either [Char] (Word32, Word32, Word32)
forall {a} {b} {c}.
(Read a, Read b, Read c) =>
Text -> Either [Char] (a, b, c)
parseParameters Text
parametersStr
      -- We pad the Base64 with '=' chars because we drop them while encoding this.
      -- At the time of implementation we've opted to be consistent with how the
      -- CLI of the reference implementation of Argon2id outputs this.
      ByteString
salt <- Text -> Either [Char] ByteString
from64 (Text -> Either [Char] ByteString)
-> Text -> Either [Char] ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Text
unsafePad64 Text
salt64
      ByteString
hashedKey <- Text -> Either [Char] ByteString
from64 (Text -> Either [Char] ByteString)
-> Text -> Either [Char] ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Text
unsafePad64 Text
hashedKey64
      Argon2HashedPassword -> Either [Char] Argon2HashedPassword
forall a. a -> Either [Char] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Argon2HashedPassword -> Either [Char] Argon2HashedPassword)
-> Argon2HashedPassword -> Either [Char] Argon2HashedPassword
forall a b. (a -> b) -> a -> b
$ Argon2HashedPassword {$sel:opts:Argon2HashedPassword :: Options
opts = (Argon2.Options {Word32
Version
Variant
variant :: Variant
version :: Version
iterations :: Word32
memory :: Word32
parallelism :: Word32
version :: Version
variant :: Variant
memory :: Word32
iterations :: Word32
parallelism :: Word32
..}), ByteString
$sel:salt:Argon2HashedPassword :: ByteString
$sel:hashedKey:Argon2HashedPassword :: ByteString
salt :: ByteString
hashedKey :: ByteString
..}
      where
        parseVariant :: Text -> Either [Char] Variant
parseVariant =
          Either [Char] Variant
-> (Variant -> Either [Char] Variant)
-> Maybe Variant
-> Either [Char] Variant
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Either [Char] Variant
forall a b. a -> Either a b
Left [Char]
"failed to parse argon2 variant") Variant -> Either [Char] Variant
forall a b. b -> Either a b
Right
            (Maybe Variant -> Either [Char] Variant)
-> (Text -> Maybe Variant) -> Text -> Either [Char] Variant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (Text -> Maybe Variant) -> Text -> Maybe Variant
forall a. Text -> (Text -> Maybe a) -> Text -> Maybe a
splitMaybe Text
"argon2" Text -> Maybe Variant
letterToVariant
        parseParameters :: Text -> Either [Char] (a, b, c)
parseParameters Text
paramsT =
          let paramsList :: [Text]
paramsList = (Char -> Bool) -> Text -> [Text]
Text.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',') Text
paramsT
           in [Text] -> (Maybe a, Maybe b, Maybe c) -> Either [Char] (a, b, c)
forall {a} {b} {c}.
(Read a, Read b, Read c) =>
[Text] -> (Maybe a, Maybe b, Maybe c) -> Either [Char] (a, b, c)
go [Text]
paramsList (Maybe a
forall a. Maybe a
Nothing, Maybe b
forall a. Maybe a
Nothing, Maybe c
forall a. Maybe a
Nothing)
          where
            go :: [Text] -> (Maybe a, Maybe b, Maybe c) -> Either [Char] (a, b, c)
go [] (Just a
m, Just b
t, Just c
p) = (a, b, c) -> Either [Char] (a, b, c)
forall a b. b -> Either a b
Right (a
m, b
t, c
p)
            go [] (Maybe a
Nothing, Maybe b
_, Maybe c
_) = [Char] -> Either [Char] (a, b, c)
forall a b. a -> Either a b
Left [Char]
"failed to parse Argon2Options: failed to read parameter 'm'"
            go [] (Maybe a
_, Maybe b
Nothing, Maybe c
_) = [Char] -> Either [Char] (a, b, c)
forall a b. a -> Either a b
Left [Char]
"failed to parse Argon2Options: failed to read parameter 't'"
            go [] (Maybe a
_, Maybe b
_, Maybe c
Nothing) = [Char] -> Either [Char] (a, b, c)
forall a b. a -> Either a b
Left [Char]
"failed to parse Argon2Options: failed to read parameter 'p'"
            go (Text
x : [Text]
xs) (Maybe a
m, Maybe b
t, Maybe c
p) =
              case Int -> Text -> (Text, Text)
Text.splitAt Int
2 Text
x of
                (Text
"m=", Text
i) -> [Text] -> (Maybe a, Maybe b, Maybe c) -> Either [Char] (a, b, c)
go [Text]
xs (Text -> Maybe a
forall a. Read a => Text -> Maybe a
readT Text
i, Maybe b
t, Maybe c
p)
                (Text
"t=", Text
i) -> [Text] -> (Maybe a, Maybe b, Maybe c) -> Either [Char] (a, b, c)
go [Text]
xs (Maybe a
m, Text -> Maybe b
forall a. Read a => Text -> Maybe a
readT Text
i, Maybe c
p)
                (Text
"p=", Text
i) -> [Text] -> (Maybe a, Maybe b, Maybe c) -> Either [Char] (a, b, c)
go [Text]
xs (Maybe a
m, Maybe b
t, Text -> Maybe c
forall a. Read a => Text -> Maybe a
readT Text
i)
                (Text
unknownParam, Text
_) -> [Char] -> Either [Char] (a, b, c)
forall a b. a -> Either a b
Left ([Char] -> Either [Char] (a, b, c))
-> [Char] -> Either [Char] (a, b, c)
forall a b. (a -> b) -> a -> b
$ [Char]
"failed to parse Argon2Options: Unknown param: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
Text.unpack Text
unknownParam

parseScryptPasswordHashParams :: ByteString -> Either String ScryptHashedPassword
parseScryptPasswordHashParams :: ByteString -> Either [Char] ScryptHashedPassword
parseScryptPasswordHashParams ByteString
passwordHash = do
  let paramList :: [Text]
paramList = (Char -> Bool) -> Text -> [Text]
Text.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'|') (Text -> [Text]) -> (ByteString -> Text) -> ByteString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeUtf8 (ByteString -> [Text]) -> ByteString -> [Text]
forall a b. (a -> b) -> a -> b
$ ByteString
passwordHash
  case [Text]
paramList of
    [Text
roundsStr, Text
blockSizeStr, Text
parallelismStr, Text
salt64, Text
hashedKey64] -> do
      Word32
rounds <- [Char] -> Maybe Word32 -> Either [Char] Word32
forall a. [Char] -> Maybe a -> Either [Char] a
eitherFromMaybe [Char]
"rounds" (Maybe Word32 -> Either [Char] Word32)
-> Maybe Word32 -> Either [Char] Word32
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Word32
forall a. Read a => Text -> Maybe a
readT Text
roundsStr
      Word32
blockSize <- [Char] -> Maybe Word32 -> Either [Char] Word32
forall a. [Char] -> Maybe a -> Either [Char] a
eitherFromMaybe [Char]
"blockSize" (Maybe Word32 -> Either [Char] Word32)
-> Maybe Word32 -> Either [Char] Word32
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Word32
forall a. Read a => Text -> Maybe a
readT Text
blockSizeStr
      Word32
parallelism <- [Char] -> Maybe Word32 -> Either [Char] Word32
forall a. [Char] -> Maybe a -> Either [Char] a
eitherFromMaybe [Char]
"parellelism" (Maybe Word32 -> Either [Char] Word32)
-> Maybe Word32 -> Either [Char] Word32
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Word32
forall a. Read a => Text -> Maybe a
readT Text
parallelismStr
      ByteString
salt <- Text -> Either [Char] ByteString
from64 Text
salt64
      ByteString
hashedKey <- Text -> Either [Char] ByteString
from64 Text
hashedKey64
      let outputLength :: Word32
outputLength = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
C8.length ByteString
hashedKey
          saltLength :: Word32
saltLength = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
C8.length ByteString
salt
      ScryptHashedPassword -> Either [Char] ScryptHashedPassword
forall a. a -> Either [Char] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScryptHashedPassword -> Either [Char] ScryptHashedPassword)
-> ScryptHashedPassword -> Either [Char] ScryptHashedPassword
forall a b. (a -> b) -> a -> b
$ ScryptHashedPassword {$sel:params:ScryptHashedPassword :: ScryptParameters
params = ScryptParameters {Word32
$sel:saltLength:ScryptParameters :: Word32
$sel:rounds:ScryptParameters :: Word32
$sel:blockSize:ScryptParameters :: Word32
$sel:parallelism:ScryptParameters :: Word32
$sel:outputLength:ScryptParameters :: Word32
rounds :: Word32
blockSize :: Word32
parallelism :: Word32
outputLength :: Word32
saltLength :: Word32
..}, ByteString
$sel:salt:ScryptHashedPassword :: ByteString
$sel:hashedKey:ScryptHashedPassword :: ByteString
salt :: ByteString
hashedKey :: ByteString
..}
    [Text]
_ -> [Char] -> Either [Char] ScryptHashedPassword
forall a b. a -> Either a b
Left ([Char] -> Either [Char] ScryptHashedPassword)
-> [Char] -> Either [Char] ScryptHashedPassword
forall a b. (a -> b) -> a -> b
$ [Char]
"failed to parse ScryptHashedPassword: expected exactly 5 params"
  where
    eitherFromMaybe :: String -> Maybe a -> Either String a
    eitherFromMaybe :: forall a. [Char] -> Maybe a -> Either [Char] a
eitherFromMaybe [Char]
paramName = Either [Char] a
-> (a -> Either [Char] a) -> Maybe a -> Either [Char] a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Either [Char] a
forall a b. a -> Either a b
Left ([Char] -> Either [Char] a) -> [Char] -> Either [Char] a
forall a b. (a -> b) -> a -> b
$ [Char]
"failed to parse scrypt parameter: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
paramName) a -> Either [Char] a
forall a b. b -> Either a b
Right

-------------------------------------------------------------------------------

hashPasswordWithOptions :: Argon2.Options -> ByteString -> ByteString -> ByteString
hashPasswordWithOptions :: Options -> ByteString -> ByteString -> ByteString
hashPasswordWithOptions Options
opts ByteString
password ByteString
salt = do
  let tagSize :: Int
tagSize = Int
16
  case (Options
-> ByteString -> ByteString -> Int -> CryptoFailable ByteString
forall password salt out.
(ByteArrayAccess password, ByteArrayAccess salt, ByteArray out) =>
Options -> password -> salt -> Int -> CryptoFailable out
Argon2.hash Options
opts ByteString
password ByteString
salt Int
tagSize) of
    -- CryptoFailed occurs when salt, output or input are too small/big.
    -- since we control those values ourselves, it should never have a runtime error
    CryptoFailed CryptoError
cErr -> [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char]
"Impossible error: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> CryptoError -> [Char]
forall a. Show a => a -> [Char]
show CryptoError
cErr
    CryptoPassed ByteString
hash -> ByteString
hash

hashPasswordWithParams ::
  ( ByteArrayAccess password,
    ByteArrayAccess salt
  ) =>
  ScryptParameters ->
  password ->
  salt ->
  ByteString
hashPasswordWithParams :: forall password salt.
(ByteArrayAccess password, ByteArrayAccess salt) =>
ScryptParameters -> password -> salt -> ByteString
hashPasswordWithParams ScryptParameters
parameters password
password salt
salt = Bytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (Parameters -> password -> salt -> Bytes
forall password salt output.
(ByteArrayAccess password, ByteArrayAccess salt,
 ByteArray output) =>
Parameters -> password -> salt -> output
generate (ScryptParameters -> Parameters
fromScrypt ScryptParameters
parameters) password
password salt
salt :: Bytes)

--------------------------------------------------------------------------------

-- | Makes a letter out of the variant
variantToCode :: Argon2.Variant -> Text
variantToCode :: Variant -> Text
variantToCode = \case
  Variant
Argon2.Argon2i -> Text
"i"
  Variant
Argon2.Argon2d -> Text
"d"
  Variant
Argon2.Argon2id -> Text
"id"

-- | Parses the variant parameter in the encoded hash
letterToVariant :: Text -> Maybe Argon2.Variant
letterToVariant :: Text -> Maybe Variant
letterToVariant = \case
  Text
"i" -> Variant -> Maybe Variant
forall a. a -> Maybe a
Just Variant
Argon2.Argon2i
  Text
"d" -> Variant -> Maybe Variant
forall a. a -> Maybe a
Just Variant
Argon2.Argon2d
  Text
"id" -> Variant -> Maybe Variant
forall a. a -> Maybe a
Just Variant
Argon2.Argon2id
  Text
_ -> Maybe Variant
forall a. Maybe a
Nothing

-- | Parses the "v=" parameter in the encoded hash
numToVersion :: Text -> Maybe Argon2.Version
numToVersion :: Text -> Maybe Version
numToVersion Text
"16" = Version -> Maybe Version
forall a. a -> Maybe a
Just Version
Argon2.Version10
numToVersion Text
"19" = Version -> Maybe Version
forall a. a -> Maybe a
Just Version
Argon2.Version13
numToVersion Text
_ = Maybe Version
forall a. Maybe a
Nothing

-- | Makes number for the "v=" parameter in the encoded hash
versionToNum :: Argon2.Version -> Text
versionToNum :: Version -> Text
versionToNum Version
Argon2.Version10 = Text
"16"
versionToNum Version
Argon2.Version13 = Text
"19"

-- | Strips the given 'match' if it matches and uses
--   the function on the remainder of the given text.
splitMaybe :: Text -> (Text -> Maybe a) -> Text -> Maybe a
splitMaybe :: forall a. Text -> (Text -> Maybe a) -> Text -> Maybe a
splitMaybe Text
match Text -> Maybe a
f Text
t =
  Text -> Text -> Maybe Text
Text.stripPrefix Text
match Text
t Maybe Text -> (Text -> Maybe a) -> Maybe a
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe a
f

-- | (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 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
Text.length Text
t Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
4
    pad :: Text
pad = Int -> Text -> Text
Text.replicate (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
remains) Text
"="

--------------------------------------------------------------------------------
-- Type that can be used to pass a plaintext password as a request body

newtype PasswordReqBody = PasswordReqBody
  {PasswordReqBody -> Maybe PlainTextPassword6
fromPasswordReqBody :: Maybe PlainTextPassword6}
  deriving stock (PasswordReqBody -> PasswordReqBody -> Bool
(PasswordReqBody -> PasswordReqBody -> Bool)
-> (PasswordReqBody -> PasswordReqBody -> Bool)
-> Eq PasswordReqBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PasswordReqBody -> PasswordReqBody -> Bool
== :: PasswordReqBody -> PasswordReqBody -> Bool
$c/= :: PasswordReqBody -> PasswordReqBody -> Bool
/= :: PasswordReqBody -> PasswordReqBody -> Bool
Eq, Int -> PasswordReqBody -> ShowS
[PasswordReqBody] -> ShowS
PasswordReqBody -> [Char]
(Int -> PasswordReqBody -> ShowS)
-> (PasswordReqBody -> [Char])
-> ([PasswordReqBody] -> ShowS)
-> Show PasswordReqBody
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PasswordReqBody -> ShowS
showsPrec :: Int -> PasswordReqBody -> ShowS
$cshow :: PasswordReqBody -> [Char]
show :: PasswordReqBody -> [Char]
$cshowList :: [PasswordReqBody] -> ShowS
showList :: [PasswordReqBody] -> ShowS
Show)
  deriving ([PasswordReqBody] -> Value
[PasswordReqBody] -> Encoding
PasswordReqBody -> Value
PasswordReqBody -> Encoding
(PasswordReqBody -> Value)
-> (PasswordReqBody -> Encoding)
-> ([PasswordReqBody] -> Value)
-> ([PasswordReqBody] -> Encoding)
-> ToJSON PasswordReqBody
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: PasswordReqBody -> Value
toJSON :: PasswordReqBody -> Value
$ctoEncoding :: PasswordReqBody -> Encoding
toEncoding :: PasswordReqBody -> Encoding
$ctoJSONList :: [PasswordReqBody] -> Value
toJSONList :: [PasswordReqBody] -> Value
$ctoEncodingList :: [PasswordReqBody] -> Encoding
toEncodingList :: [PasswordReqBody] -> Encoding
A.ToJSON, Value -> Parser [PasswordReqBody]
Value -> Parser PasswordReqBody
(Value -> Parser PasswordReqBody)
-> (Value -> Parser [PasswordReqBody]) -> FromJSON PasswordReqBody
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser PasswordReqBody
parseJSON :: Value -> Parser PasswordReqBody
$cparseJSONList :: Value -> Parser [PasswordReqBody]
parseJSONList :: Value -> Parser [PasswordReqBody]
A.FromJSON, Typeable PasswordReqBody
Typeable PasswordReqBody =>
(Proxy PasswordReqBody -> Declare (Definitions Schema) NamedSchema)
-> ToSchema PasswordReqBody
Proxy PasswordReqBody -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a =>
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
$cdeclareNamedSchema :: Proxy PasswordReqBody -> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy PasswordReqBody -> Declare (Definitions Schema) NamedSchema
S.ToSchema) via Schema PasswordReqBody

instance ToSchema PasswordReqBody where
  schema :: ValueSchema NamedSwaggerDoc PasswordReqBody
schema =
    Text
-> SchemaP SwaggerDoc Object [Pair] PasswordReqBody PasswordReqBody
-> ValueSchema NamedSwaggerDoc PasswordReqBody
forall doc doc' a b.
HasObject doc doc' =>
Text
-> SchemaP doc Object [Pair] a b -> SchemaP doc' Value Value a b
object Text
"PasswordReqBody" (SchemaP SwaggerDoc Object [Pair] PasswordReqBody PasswordReqBody
 -> ValueSchema NamedSwaggerDoc PasswordReqBody)
-> SchemaP SwaggerDoc Object [Pair] PasswordReqBody PasswordReqBody
-> ValueSchema NamedSwaggerDoc PasswordReqBody
forall a b. (a -> b) -> a -> b
$
      Maybe PlainTextPassword6 -> PasswordReqBody
PasswordReqBody
        (Maybe PlainTextPassword6 -> PasswordReqBody)
-> SchemaP
     SwaggerDoc Object [Pair] PasswordReqBody (Maybe PlainTextPassword6)
-> SchemaP SwaggerDoc Object [Pair] PasswordReqBody PasswordReqBody
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PasswordReqBody -> Maybe PlainTextPassword6
fromPasswordReqBody (PasswordReqBody -> Maybe PlainTextPassword6)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe PlainTextPassword6)
     (Maybe PlainTextPassword6)
-> SchemaP
     SwaggerDoc Object [Pair] PasswordReqBody (Maybe PlainTextPassword6)
forall (p :: * -> * -> *) a a' b.
Profunctor p =>
(a -> a') -> p a' b -> p a b
.= SchemaP
  SwaggerDoc
  Object
  [Pair]
  PlainTextPassword6
  (Maybe PlainTextPassword6)
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     (Maybe PlainTextPassword6)
     (Maybe PlainTextPassword6)
forall w d v a b.
Monoid w =>
SchemaP d v w a b -> SchemaP d v w (Maybe a) b
maybe_ (Text
-> SchemaP
     NamedSwaggerDoc Value Value PlainTextPassword6 PlainTextPassword6
-> SchemaP
     SwaggerDoc
     Object
     [Pair]
     PlainTextPassword6
     (Maybe PlainTextPassword6)
forall doc doc' a b.
(HasOpt doc, HasField doc' doc) =>
Text
-> SchemaP doc' Value Value a b
-> SchemaP doc Object [Pair] a (Maybe b)
optField Text
"password" SchemaP
  NamedSwaggerDoc Value Value PlainTextPassword6 PlainTextPassword6
forall a. ToSchema a => ValueSchema NamedSwaggerDoc a
schema)