{-# LANGUAGE BangPatterns       #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE LambdaCase         #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE RecordWildCards    #-}
{-# LANGUAGE Trustworthy        #-}

{-|

Module      : Crypto.Argon2
License     : BSD3
Maintainer  : hvr@gnu.org

"Crypto.Argon2" provides bindings to the
<https://github.com/P-H-C/phc-winner-argon2 reference implementation> of Argon2,
the password-hashing function that won the
<https://password-hashing.net/ Password Hashing Competition (PHC)>.

The main entry points to this module are 'hashEncoded', which produces a
crypt-like ASCII output; and 'hash' which produces a 'BS.ByteString' (a stream
of bytes). Argon2 is a configurable hash function, and can be configured by
supplying a particular set of 'HashOptions' - 'defaultHashOptions' should provide
a good starting point. See 'HashOptions' for more documentation on the particular
parameters that can be adjusted.

For (unsafe) access directly to the C interface, see "Crypto.Argon2.FFI".

@since 1.3.0.0
-}
module Crypto.Argon2
    ( -- * Hash computation & verification
      -- ** Binary hash representation
      hash
      -- ** ASCII-encoded representation
      --
      -- | These operations use the [PHC string format](https://github.com/P-H-C/phc-string-format/blob/master/phc-sf-spec.md), a [crypt(3)](https://en.wikipedia.org/wiki/Crypt_\(C\))-like serialization format for password hashes.
    , hashEncoded
    , verifyEncoded
      -- * Configuring hashing
    , HashOptions(..)
    , Argon2Variant(..)
    , Argon2Version(..)
    , defaultHashOptions
      -- * Status codes
    , Argon2Status(..)
    ) where

import           Control.DeepSeq   (NFData (rnf))
import           Control.Exception
import qualified Crypto.Argon2.FFI as FFI
import qualified Data.ByteString   as BS
import qualified Data.Text.Short   as TS
import           Data.Typeable
import           Foreign
import           Foreign.C
import           GHC.Generics      (Generic)
import           System.IO.Unsafe  (unsafePerformIO)

-- | Which variant of Argon2 to use. You should choose the variant that is most
-- applicable to your intention to hash inputs.
data Argon2Variant
  = Argon2i  -- ^ Argon2i uses data-independent memory access, which is preferred
             -- for password hashing and password-based key derivation. Argon2i
             -- is slower as it makes more passes over the memory to protect from
             -- tradeoff attacks.
  | Argon2d  -- ^ Argon2d is faster and uses data-depending memory access, which
             -- makes it suitable for cryptocurrencies and applications with no
             -- threats from side-channel timing attacks.
  | Argon2id -- ^ Argon2id works as Argon2i for the first half of the first iteration
             -- over the memory, and as Argon2d for the rest, thus providing both
             -- side-channel attack protection and brute-force cost savings due to
             -- time-memory tradeoffs.
  deriving (Eq,Ord,Read,Show,Bounded,Generic,Typeable,Enum)

instance NFData Argon2Variant where rnf !_ = ()

toArgon2Type :: Argon2Variant -> FFI.Argon2_type
toArgon2Type Argon2i  = FFI.Argon2_i
toArgon2Type Argon2d  = FFI.Argon2_d
toArgon2Type Argon2id = FFI.Argon2_id

-- | Version of the Argon2 algorithm.
data Argon2Version
  = Argon2Version10 -- ^ Version 1.0 (deprecated)
  | Argon2Version13 -- ^ Version 1.3 (See [this announcment](https://www.ietf.org/mail-archive/web/cfrg/current/msg07948.html) for more details)
  deriving (Eq,Ord,Read,Show,Bounded,Generic,Typeable,Enum)

instance NFData Argon2Version where rnf !_ = ()

toArgon2Ver :: Argon2Version -> FFI.Argon2_version
toArgon2Ver Argon2Version10 = FFI.ARGON2_VERSION_10
toArgon2Ver Argon2Version13 = FFI.ARGON2_VERSION_13

-- | Parameters that can be adjusted to change the runtime performance of the
-- hashing. See also 'defaultHashOptions'.
data HashOptions =
  HashOptions { hashIterations  :: !Word32 -- ^ The time cost, which defines the amount of computation realized and therefore the execution time, given in number of iterations.
                                         --
                                         -- 'FFI.ARGON2_MIN_TIME' <= 'hashIterations' <= 'FFI.ARGON2_MAX_TIME'

              , hashMemory      :: !Word32 -- ^ The memory cost, which defines the memory usage, given in [kibibytes](https://en.wikipedia.org/wiki/Kibibyte).
                                     --
                                     -- max 'FFI.ARGON2_MIN_MEMORY' (8 * 'hashParallelism') <= 'hashMemory' <= 'FFI.ARGON2_MAX_MEMORY'

              , hashParallelism :: !Word32 -- ^ A parallelism degree, which defines the number of parallel threads.
                                          --
                                          -- 'FFI.ARGON2_MIN_LANES' <= 'hashParallelism' <= 'FFI.ARGON2_MAX_LANES' && 'FFI.ARGON_MIN_THREADS' <= 'hashParallelism' <= 'FFI.ARGON2_MAX_THREADS'

              , hashVariant     :: !Argon2Variant -- ^ Which variant of Argon2 to use.

              , hashVersion     :: !Argon2Version -- ^ Which version of Argon2 to use for generating hashes.

              , hashLength      :: !Word32        -- ^ Desired length of hash expressed in octets.
              }
  deriving (Eq,Ord,Read,Show,Bounded,Generic,Typeable)

instance NFData HashOptions where rnf !_ = ()

-- | A set of default 'HashOptions', taken from the @argon2@ executable.
--
-- @
-- 'defaultHashOptions' :: 'HashOptions'
-- 'defaultHashOptions' =
--   'HashOptions' { 'hashIterations'  = 3
--               , 'hashMemory'      = 2 ^ 12 -- 4 MiB
--               , 'hashParallelism' = 1
--               , 'hashVariant'     = 'Argon2i'
--               , 'hashVersion'     = 'Argon2Version13'
--               , 'hashLength'      = 2 ^ 5 -- 32 bytes
--               }
-- @
--
-- For more information on how to select these parameters for your application, see section 6.4 of the [Argon2 specification](https://github.com/P-H-C/phc-winner-argon2/blob/master/argon2-specs.pdf).
--
defaultHashOptions :: HashOptions
defaultHashOptions = HashOptions
    { hashIterations  = 3
    , hashMemory      = 2 ^ (12 :: Int) -- 4 MiB
    , hashParallelism = 1
    , hashVariant     = Argon2i
    , hashVersion     = Argon2Version13
    , hashLength      = 32
    }

-- | Encode a password with a given salt and 'HashOptions' and produce a binary stream
-- of bytes (of size 'hashLength').
hash :: HashOptions -- ^ Options pertaining to how expensive the hash is to calculate.
     -> BS.ByteString -- ^ The password to hash. Must be less than 4294967295 bytes.
     -> BS.ByteString -- ^ The salt to use when hashing. Must be less than 4294967295 bytes.
     -> Either Argon2Status BS.ByteString -- ^ The un-encoded password hash (or error code in case of failure).
hash options password salt = unsafePerformIO $ try $ hash' options password salt

-- | Encode a password with a given salt and 'HashOptions' and produce a textual
-- encoding according to the [PHC string format](https://github.com/P-H-C/phc-string-format/blob/master/phc-sf-spec.md) of the result.
--
-- Use 'verifyEncoded' to verify.
hashEncoded :: HashOptions   -- ^ Options pertaining to how expensive the hash is to calculate.
            -> BS.ByteString -- ^ The password to hash. Must be less than 4294967295 bytes.
            -> BS.ByteString -- ^ The salt to use when hashing. Must be less than 4294967295 bytes.
            -> Either Argon2Status TS.ShortText  -- ^ The encoded password hash (or error code in case of failure).
hashEncoded options password salt = unsafePerformIO $ try $ hashEncoded' options password salt

-- | Verify that a given password could result in a given hash output.
-- Automatically determines the correct 'HashOptions' based on the
-- encoded hash (using the [PHC string format](https://github.com/P-H-C/phc-string-format/blob/master/phc-sf-spec.md) as produced by 'hashEncoded').
--
-- Returns 'Argon2Ok' on successful verification. If decoding is
-- successful but the password mismatches, 'Argon2VerifyMismatch' is
-- returned; if decoding fails, the respective 'Argon2Status' code is
-- returned.
verifyEncoded :: TS.ShortText -> BS.ByteString -> Argon2Status
verifyEncoded encoded password
  -- c.f. https://github.com/P-H-C/phc-string-format/blob/master/phc-sf-spec.md
  | "$argon2id$" `TS.isPrefixOf` encoded = unsafePerformIO $ go FFI.Argon2_id
  | "$argon2i$"  `TS.isPrefixOf` encoded = unsafePerformIO $ go FFI.Argon2_i
  | "$argon2d$"  `TS.isPrefixOf` encoded = unsafePerformIO $ go FFI.Argon2_d
  | otherwise                            = Argon2DecodingFail
  where
    go v = BS.useAsCString password $ \pwd ->
             BS.useAsCString (TS.toByteString encoded) $ \enc ->
               toArgon2Status <$> FFI.argon2_verify enc pwd (fromIntegral (BS.length password)) v


-- | Returned status code for Argon2 functions.
--
-- Not all 'HashOptions' can necessarily be used to compute hashes. If
-- you supply unsupported or invalid 'HashOptions' (or hashing
-- otherwise fails) an 'Argon2Status' value will be returned to
-- describe the failure.
--
-- Note that this enumeration contains some status codes which are not
-- expected to be returned by the operation provided by the Haskell
-- API.
data Argon2Status
    = Argon2Ok                            -- ^ OK (operation succeeded)
    | Argon2OutputPtrNull                 -- ^ Output pointer is @NULL@
    | Argon2OutputTooShort                -- ^ Output is too short
    | Argon2OutputTooLong                 -- ^ Output is too long
    | Argon2PwdTooShort                   -- ^ Password is too short
    | Argon2PwdTooLong                    -- ^ Password is too long
    | Argon2SaltTooShort                  -- ^ Salt is too short
    | Argon2SaltTooLong                   -- ^ Salt is too long
    | Argon2AdTooShort                    -- ^ Associated data is too short
    | Argon2AdTooLong                     -- ^ Associated data is too long
    | Argon2SecretTooShort                -- ^ Secret is too short
    | Argon2SecretTooLong                 -- ^ Secret is too long
    | Argon2TimeTooSmall                  -- ^ Time cost is too small
    | Argon2TimeTooLarge                  -- ^ Time cost is too large
    | Argon2MemoryTooLittle               -- ^ Memory cost is too small
    | Argon2MemoryTooMuch                 -- ^ Memory cost is too large
    | Argon2LanesTooFew                   -- ^ Too few lanes
    | Argon2LanesTooMany                  -- ^ Too many lanes
    | Argon2PwdPtrMismatch                -- ^ Password pointer is @NULL@, but password length is not 0
    | Argon2SaltPtrMismatch               -- ^ Salt pointer is @NULL@, but salt length is not 0
    | Argon2SecretPtrMismatch             -- ^ Secret pointer is @NULL@, but secret length is not 0
    | Argon2AdPtrMismatch                 -- ^ Associated data pointer is @NULL@, but ad length is not 0
    | Argon2MemoryAllocationError         -- ^ Memory allocation error
    | Argon2FreeMemoryCbkNull             -- ^ The free memory callback is @NULL@
    | Argon2AllocateMemoryCbkNull         -- ^ The allocate memory callback is @NULL@
    | Argon2IncorrectParameter            -- ^ @Argon2_Context@ context is @NULL@
    | Argon2IncorrectType                 -- ^ There is no such version of Argon2
    | Argon2OutPtrMismatch                -- ^ Output pointer mismatch
    | Argon2ThreadsTooFew                 -- ^ Not enough threads
    | Argon2ThreadsTooMany                -- ^ Too many threads
    | Argon2MissingArgs                   -- ^ Missing arguments
    | Argon2EncodingFail                  -- ^ Encoding failed
    | Argon2DecodingFail                  -- ^ Decoding failed
    | Argon2ThreadFail                    -- ^ Threading failure
    | Argon2DecodingLengthFail            -- ^ Some of encoded parameters are too long or too short
    | Argon2VerifyMismatch                -- ^ The password does not match the supplied hash

    | Argon2InternalError                 -- ^ Internal error or unrecognized status code
    deriving (Typeable,Eq,Ord,Read,Show,Enum,Bounded)

instance NFData Argon2Status where rnf !_ = ()

instance Exception Argon2Status

toArgon2Status :: CInt -> Argon2Status
toArgon2Status = \case
    FFI.ARGON2_OK                         -> Argon2Ok
    FFI.ARGON2_OUTPUT_PTR_NULL            -> Argon2OutputPtrNull
    FFI.ARGON2_OUTPUT_TOO_SHORT           -> Argon2OutputTooShort
    FFI.ARGON2_OUTPUT_TOO_LONG            -> Argon2OutputTooLong
    FFI.ARGON2_PWD_TOO_SHORT              -> Argon2PwdTooShort
    FFI.ARGON2_PWD_TOO_LONG               -> Argon2PwdTooLong
    FFI.ARGON2_SALT_TOO_SHORT             -> Argon2SaltTooShort
    FFI.ARGON2_SALT_TOO_LONG              -> Argon2SaltTooLong
    FFI.ARGON2_AD_TOO_SHORT               -> Argon2AdTooShort
    FFI.ARGON2_AD_TOO_LONG                -> Argon2AdTooLong
    FFI.ARGON2_SECRET_TOO_SHORT           -> Argon2SecretTooShort
    FFI.ARGON2_SECRET_TOO_LONG            -> Argon2SecretTooLong
    FFI.ARGON2_TIME_TOO_SMALL             -> Argon2TimeTooSmall
    FFI.ARGON2_TIME_TOO_LARGE             -> Argon2TimeTooLarge
    FFI.ARGON2_MEMORY_TOO_LITTLE          -> Argon2MemoryTooLittle
    FFI.ARGON2_MEMORY_TOO_MUCH            -> Argon2MemoryTooMuch
    FFI.ARGON2_LANES_TOO_FEW              -> Argon2LanesTooFew
    FFI.ARGON2_LANES_TOO_MANY             -> Argon2LanesTooMany
    FFI.ARGON2_PWD_PTR_MISMATCH           -> Argon2PwdPtrMismatch
    FFI.ARGON2_SALT_PTR_MISMATCH          -> Argon2SaltPtrMismatch
    FFI.ARGON2_SECRET_PTR_MISMATCH        -> Argon2SecretPtrMismatch
    FFI.ARGON2_AD_PTR_MISMATCH            -> Argon2AdPtrMismatch
    FFI.ARGON2_MEMORY_ALLOCATION_ERROR    -> Argon2MemoryAllocationError
    FFI.ARGON2_FREE_MEMORY_CBK_NULL       -> Argon2FreeMemoryCbkNull
    FFI.ARGON2_ALLOCATE_MEMORY_CBK_NULL   -> Argon2AllocateMemoryCbkNull
    FFI.ARGON2_INCORRECT_PARAMETER        -> Argon2IncorrectParameter
    FFI.ARGON2_INCORRECT_TYPE             -> Argon2IncorrectType
    FFI.ARGON2_OUT_PTR_MISMATCH           -> Argon2OutPtrMismatch
    FFI.ARGON2_THREADS_TOO_FEW            -> Argon2ThreadsTooFew
    FFI.ARGON2_THREADS_TOO_MANY           -> Argon2ThreadsTooMany
    FFI.ARGON2_MISSING_ARGS               -> Argon2MissingArgs
    FFI.ARGON2_ENCODING_FAIL              -> Argon2EncodingFail
    FFI.ARGON2_DECODING_FAIL              -> Argon2DecodingFail
    FFI.ARGON2_THREAD_FAIL                -> Argon2ThreadFail
    FFI.ARGON2_DECODING_LENGTH_FAIL       -> Argon2DecodingLengthFail
    FFI.ARGON2_VERIFY_MISMATCH            -> Argon2VerifyMismatch
    _                                     -> Argon2InternalError -- should never happen


hashEncoded' :: HashOptions
             -> BS.ByteString
             -> BS.ByteString
             -> IO TS.ShortText
hashEncoded' HashOptions{..} password salt =
    allocaBytes (fromIntegral outLen) $ \out -> do
        res <- BS.useAsCString password $ \password' ->
               BS.useAsCString salt $ \salt' ->
               FFI.argon2_hash
                   hashIterations
                   hashMemory
                   hashParallelism
                   password'
                   passwordLen
                   salt'
                   (fromIntegral saltLen)
                   nullPtr
                   (fromIntegral hashLength)
                   out
                   outLen
                   (toArgon2Type hashVariant)
                   (toArgon2Ver hashVersion)

        handleSuccessCode res
        res' <- TS.fromByteString <$> BS.packCString out
        case res' of
          Nothing -> throwIO Argon2InternalError
          Just t  -> evaluate t

  where
    !outLen = FFI.argon2_encodedlen
                    hashIterations
                    hashMemory
                    hashParallelism
                    saltLen
                    hashLength
                    (toArgon2Type hashVariant)

    saltLen     = fromIntegral (BS.length salt)
    passwordLen = fromIntegral (BS.length password)


hash' :: HashOptions
      -> BS.ByteString
      -> BS.ByteString
      -> IO BS.ByteString
hash' HashOptions{..} password salt =
    allocaBytes (fromIntegral hashLength) $ \out -> do
        res <- BS.useAsCString password $ \password' ->
               BS.useAsCString salt $ \salt' ->
               FFI.argon2_hash
                   hashIterations
                   hashMemory
                   hashParallelism
                   password'
                   passwordLen
                   salt'
                   saltLen
                   out
                   (fromIntegral hashLength)
                   nullPtr
                   0
                   (toArgon2Type hashVariant)
                   (toArgon2Ver hashVersion)

        handleSuccessCode res
        evaluate =<< BS.packCStringLen (out, fromIntegral hashLength)
  where
    saltLen     = fromIntegral (BS.length salt)
    passwordLen = fromIntegral (BS.length password)

handleSuccessCode :: CInt -> IO ()
handleSuccessCode res = case toArgon2Status res of
                          Argon2Ok -> return ()
                          nok      -> throwIO nok