content: {-# LANGUAGE DisambiguateRecordFields #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# 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.User.Password
    ( NewPasswordReset (..),
      CompletePasswordReset (..),
      PasswordResetIdentity (..),
      PasswordResetKey (..),
      mkPasswordResetKey,
      PasswordResetCode (..),
  
      -- * deprecated
      PasswordReset (..),
    )
  where
  
  import Cassandra qualified as C
  import Control.Lens ((?~))
  import Crypto.Hash
  import Data.Aeson qualified as A
  import Data.Aeson.Types (Parser)
  import Data.ByteArray qualified as ByteArray
  import Data.ByteString qualified as BS
  import Data.ByteString.Conversion
  import Data.Id
  import Data.Misc (PlainTextPassword8)
  import Data.OpenApi qualified as S
  import Data.OpenApi.ParamSchema
  import Data.Proxy (Proxy (Proxy))
  import Data.Range (Ranged (..))
  import Data.Schema as Schema
  import Data.Text.Ascii
  import Data.Tuple.Extra
  import Imports
  import Servant (FromHttpApiData (..))
  import Wire.API.User.EmailAddress
  import Wire.API.User.Phone
  import Wire.Arbitrary (Arbitrary, GenericUniform (..))
  
  --------------------------------------------------------------------------------
  -- NewPasswordReset
  
  -- | The payload for initiating a password reset.
  data NewPasswordReset
    = NewPasswordReset EmailAddress
    | -- | Resetting via phone is not really supported anymore, but this is still
      -- here to support older versions of the endpoint.
      NewPasswordResetUnsupportedPhone
    deriving stock (Eq, Show, Generic)
    deriving (Arbitrary) via (GenericUniform NewPasswordReset)
    deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema NewPasswordReset
  
  instance ToSchema NewPasswordReset where
    schema =
      objectWithDocModifier "NewPasswordReset" objectDesc $
        (toTuple .= newPasswordResetTupleObjectSchema) `withParser` fromTuple
      where
        objectDesc :: NamedSwaggerDoc -> NamedSwaggerDoc
        objectDesc = description ?~ "Data to initiate a password reset"
  
        newPasswordResetTupleObjectSchema :: ObjectSchema SwaggerDoc (Maybe EmailAddress, Maybe Text)
        newPasswordResetTupleObjectSchema =
          (,)
            <$> fst .= maybe_ (optFieldWithDocModifier "email" phoneDocs schema)
            <*> snd .= maybe_ (optFieldWithDocModifier "phone" emailDocs schema)
          where
            emailDocs :: NamedSwaggerDoc -> NamedSwaggerDoc
            emailDocs = description ?~ "Email"
  
            phoneDocs :: NamedSwaggerDoc -> NamedSwaggerDoc
            phoneDocs = description ?~ "Phone"
  
        fromTuple :: (Maybe EmailAddress, Maybe a) -> Parser NewPasswordReset
        fromTuple = \case
          (Just _, Just _) -> fail "Only one of 'email' or 'phone' allowed."
          (Just email, Nothing) -> pure $ NewPasswordReset email
          (Nothing, Just _) -> pure NewPasswordResetUnsupportedPhone
          (Nothing, Nothing) -> fail "One of 'email' or 'phone' required."
  
        toTuple :: NewPasswordReset -> (Maybe EmailAddress, Maybe Text)
        toTuple = \case
          NewPasswordReset e -> (Just e, Nothing)
          NewPasswordResetUnsupportedPhone -> (Nothing, Just "")
  
  --------------------------------------------------------------------------------
  -- CompletePasswordReset
  
  -- | The payload for completing a password reset.
  data CompletePasswordReset = CompletePasswordReset
    { cpwrIdent :: PasswordResetIdentity,
      cpwrCode :: PasswordResetCode,
      cpwrPassword :: PlainTextPassword8
    }
    deriving stock (Eq, Show, Generic)
    deriving (Arbitrary) via (GenericUniform CompletePasswordReset)
    deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema CompletePasswordReset
  
  instance ToSchema CompletePasswordReset where
    schema =
      objectWithDocModifier "CompletePasswordReset" objectDocs $
        CompletePasswordReset
          <$> (maybePasswordResetIdentityToTuple . cpwrIdent) .= maybePasswordResetIdentityObjectSchema
          <*> cpwrCode .= fieldWithDocModifier "code" codeDocs schema
          <*> cpwrPassword .= fieldWithDocModifier "password" pwDocs schema
      where
        objectDocs :: NamedSwaggerDoc -> NamedSwaggerDoc
        objectDocs = description ?~ "Data to complete a password reset"
  
        codeDocs :: NamedSwaggerDoc -> NamedSwaggerDoc
        codeDocs = description ?~ "Password reset code"
  
        pwDocs :: NamedSwaggerDoc -> NamedSwaggerDoc
        pwDocs = description ?~ "New password (6 - 1024 characters)"
  
        maybePasswordResetIdentityObjectSchema :: ObjectSchemaP SwaggerDoc (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone) PasswordResetIdentity
        maybePasswordResetIdentityObjectSchema =
          withParser passwordResetIdentityTupleObjectSchema maybePasswordResetIdentityTargetFromTuple
          where
            passwordResetIdentityTupleObjectSchema :: ObjectSchema SwaggerDoc (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
            passwordResetIdentityTupleObjectSchema =
              (,,)
                <$> fst3 .= maybe_ (optFieldWithDocModifier "key" keyDocs schema)
                <*> snd3 .= maybe_ (optFieldWithDocModifier "email" emailDocs schema)
                <*> thd3 .= maybe_ (optFieldWithDocModifier "phone" phoneDocs schema)
              where
                keyDocs = description ?~ "An opaque key for a pending password reset."
                emailDocs = description ?~ "A known email with a pending password reset."
                phoneDocs = description ?~ "A known phone number with a pending password reset."
  
            maybePasswordResetIdentityTargetFromTuple :: (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone) -> Parser PasswordResetIdentity
            maybePasswordResetIdentityTargetFromTuple = \case
              (Just key, _, _) -> pure $ PasswordResetIdentityKey key
              (_, Just email, _) -> pure $ PasswordResetEmailIdentity email
              (_, _, Just phone) -> pure $ PasswordResetPhoneIdentity phone
              _ -> fail "key, email or phone must be present"
  
        maybePasswordResetIdentityToTuple :: PasswordResetIdentity -> (Maybe PasswordResetKey, Maybe EmailAddress, Maybe Phone)
        maybePasswordResetIdentityToTuple = \case
          PasswordResetIdentityKey key -> (Just key, Nothing, Nothing)
          PasswordResetEmailIdentity email -> (Nothing, Just email, Nothing)
          PasswordResetPhoneIdentity phone -> (Nothing, Nothing, Just phone)
  
  --------------------------------------------------------------------------------
  -- PasswordResetIdentity
  
  -- | The target identity of a password reset.
  data PasswordResetIdentity
    = -- | An opaque identity key for a pending password reset.
      PasswordResetIdentityKey PasswordResetKey
    | -- | A known email address with a pending password reset.
      PasswordResetEmailIdentity EmailAddress
    | -- | A known phone number with a pending password reset.
      PasswordResetPhoneIdentity Phone
    deriving stock (Eq, Show, Generic)
    deriving (Arbitrary) via (GenericUniform PasswordResetIdentity)
  
  -- | Opaque identifier per user (SHA256 of the user ID).
  newtype PasswordResetKey = PasswordResetKey
    {fromPasswordResetKey :: AsciiBase64Url}
    deriving stock (Eq, Show, Ord)
    deriving newtype (ToSchema, FromByteString, ToByteString, A.FromJSON, A.ToJSON, Arbitrary)
  
  mkPasswordResetKey :: UserId -> PasswordResetKey
  mkPasswordResetKey userId =
    PasswordResetKey
      . encodeBase64Url
      . BS.pack
      . ByteArray.unpack
      $ hashWith SHA256 (toByteString' userId)
  
  instance ToParamSchema PasswordResetKey where
    toParamSchema _ = toParamSchema (Proxy @Text)
  
  instance FromHttpApiData PasswordResetKey where
    parseQueryParam = fmap PasswordResetKey . parseQueryParam
  
  deriving instance C.Cql PasswordResetKey
  
  --------------------------------------------------------------------------------
  -- PasswordResetCode
  
  -- | Random code, acting as a very short-lived, single-use password.
  newtype PasswordResetCode = PasswordResetCode
    {fromPasswordResetCode :: AsciiBase64Url}
    deriving stock (Eq, Show, Generic)
    deriving newtype (ToSchema, FromByteString, ToByteString, A.FromJSON, A.ToJSON)
    deriving (Arbitrary) via (Ranged 6 1024 AsciiBase64Url)
  
  deriving instance C.Cql PasswordResetCode
  
  --------------------------------------------------------------------------------
  -- DEPRECATED
  
  data PasswordReset = PasswordReset
    { pwrCode :: PasswordResetCode,
      pwrPassword :: PlainTextPassword8
    }
    deriving stock (Eq, Show, Generic)
    deriving (Arbitrary) via (GenericUniform PasswordReset)
    deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema PasswordReset
  
  instance ToSchema PasswordReset where
    schema =
      objectWithDocModifier "PasswordReset" objectDocs $
        PasswordReset
          <$> pwrCode .= fieldWithDocModifier "code" codeDocs schema
          <*> pwrPassword .= fieldWithDocModifier "password" pwDocs schema
      where
        objectDocs :: NamedSwaggerDoc -> NamedSwaggerDoc
        objectDocs = description ?~ "Data to complete a password reset"
  
        codeDocs :: NamedSwaggerDoc -> NamedSwaggerDoc
        codeDocs = description ?~ "Password reset code"
  
        pwDocs :: NamedSwaggerDoc -> NamedSwaggerDoc
        pwDocs = description ?~ "New password (6 - 1024 characters)"
  