content: {-# LANGUAGE CPP #-}
  {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE DerivingStrategies #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE StandaloneDeriving #-}
  {-# LANGUAGE TypeOperators #-}
  {-# LANGUAGE UndecidableInstances #-}
  {-# OPTIONS_GHC -fno-warn-orphans #-}
  
  {-|
  Module      : Data.Password.Instances
  Copyright   : (c) Dennis Gosnell, 2019; Felix Paulusma, 2020
  License     : BSD-style (see LICENSE file)
  Maintainer  : cdep.illabout@gmail.com
  Stability   : experimental
  Portability : POSIX
  
  This module provides additional typeclass instances
  for 'Password' and 'PasswordHash'.
  
  See the "Data.Password.Types" module for more information.
  -}
  
  module Data.Password.Instances () where
  
  import Data.Aeson (FromJSON(..), ToJSON(..))
  import Data.Password.Types (Password, PasswordHash(..), mkPassword)
  #if !MIN_VERSION_base(4,13,0)
  import Data.Semigroup ((<>))
  #endif
  import Data.Text (pack)
  import Data.Text.Encoding as TE (decodeUtf8')
  import Database.Persist (PersistValue(..))
  import Database.Persist.Class (PersistField(..))
  import Database.Persist.Sql (PersistFieldSql(..))
  import GHC.TypeLits (TypeError, ErrorMessage(..))
  import Web.HttpApiData (FromHttpApiData(..), ToHttpApiData(..))
  
  
  -- $setup
  -- >>> :set -XOverloadedStrings
  -- >>> :set -XDataKinds
  --
  -- Import needed functions.
  --
  -- >>> import Data.Aeson (decode)
  -- >>> import Data.Password.Bcrypt (Salt(..), hashPasswordWithSalt, unsafeShowPassword)
  -- >>> import Database.Persist.Class (PersistField(toPersistValue))
  -- >>> import Web.HttpApiData (parseUrlPiece)
  
  -- | This instance allows a 'Password' to be created from a JSON blob.
  --
  -- >>> let maybePassword = decode "\"foobar\"" :: Maybe Password
  -- >>> fmap unsafeShowPassword maybePassword
  -- Just "foobar"
  --
  -- There is no instance for 'ToJSON' for 'Password' because we don't want to
  -- accidentally encode a plain-text 'Password' to JSON and send it to the end-user.
  --
  -- Similarly, there is no 'ToJSON' and 'FromJSON' instance for 'PasswordHash'
  -- because we don't want to accidentally send the password hash to the end
  -- user.
  instance FromJSON Password where
    parseJSON = fmap mkPassword . parseJSON
  
  type ErrMsg e = 'Text "Warning! Tried to convert plain-text Password to " ':<>: 'Text e ':<>: 'Text "!"
            ':$$: 'Text "  This is likely a security leak. Please make sure whether this was intended."
            ':$$: 'Text "  If this is intended, please use 'unsafeShowPassword' before converting to " ':<>: 'Text e
            ':$$: 'Text ""
  
  -- | Type error! Do not use 'toJSON' on a 'Password'!
  instance TypeError (ErrMsg "JSON") => ToJSON Password where
    toJSON = error "unreachable"
  
  -- | This instance allows a 'Password' to be created with functions like
  -- 'Web.HttpApiData.parseUrlPiece' or 'Web.HttpApiData.parseQueryParam'.
  --
  -- >>> let eitherPassword = parseUrlPiece "foobar"
  -- >>> fmap unsafeShowPassword eitherPassword
  -- Right "foobar"
  instance FromHttpApiData Password where
    parseUrlPiece = fmap mkPassword . parseUrlPiece
  
  -- | Type error! Do not transmit plain-text 'Password's over HTTP!
  instance TypeError (ErrMsg "HttpApiData") => ToHttpApiData Password where
    toUrlPiece = error "unreachable"
  
  -- | This instance allows a 'PasswordHash' to be stored as a field in a database using
  -- "Database.Persist".
  --
  -- >>> let salt = Salt "abcdefghijklmnop"
  -- >>> let pass = mkPassword "foobar"
  -- >>> let hashedPassword = hashPasswordWithSalt 10 salt pass
  -- >>> toPersistValue hashedPassword
  -- PersistText "$2b$10$WUHhXETkX0fnYkrqZU3ta.N8Utt4U77kW4RVbchzgvBvBBEEdCD/u"
  --
  -- In the example above, the long 'PersistText' will be the value you store in
  -- the database.
  --
  -- We don't provide an instance of 'PersistField' for 'Password', because we don't
  -- want to make it easy to store a plain-text password in the database.
  instance PersistField (PasswordHash a) where
    toPersistValue (PasswordHash hpw) = PersistText hpw
    fromPersistValue = \case
        PersistText txt -> Right $ PasswordHash txt
        PersistByteString bs ->
          either failed (Right . PasswordHash) $ TE.decodeUtf8' bs
        _ -> Left "did not parse PasswordHash from PersistValue"
      where
        failed e = Left $ "Failed decoding PasswordHash to UTF8: " <> pack (show e)
  
  -- | This instance allows a 'PasswordHash' to be stored as a field in an SQL
  -- database in "Database.Persist.Sql".
  deriving newtype instance PersistFieldSql (PasswordHash a)
  
  -- | Type error! Do not store plain-text 'Password's in your database!
  instance TypeError (ErrMsg "PersistValue") => PersistField Password where
    toPersistValue = error "unreachable"
    fromPersistValue = error "unreachable"
  