OTP.hs

{-|
Module      : Z.Crypto.OTP
Description : One Time Passwords
Copyright   : Dong Han, AnJie Dong, 2021
License     : BSD
Maintainer  : winterland1989@gmail.com
Stability   : experimental
Portability : non-portable

One time password schemes are a user authentication method that relies on a fixed secret key which is used to derive a sequence of short passwords, each of which is accepted only once. Commonly this is used to implement two-factor authentication (2FA), where the user authenticates using both a conventional password (or a public key signature) and an OTP generated by a small device such as a mobile phone.

Botan implements the HOTP and TOTP schemes from RFC 4226 and 6238.

Since the range of possible OTPs is quite small, applications must rate limit OTP authentication attempts to some small number per second. Otherwise an attacker could quickly try all 1000000 6-digit OTPs in a brief amount of time.

-}

module Z.Crypto.OTP (
  -- * HOTP
    HOTP, newHOTP, genHOTP, checkHOTP
  -- * TOTP
  , TOTP, newTOTP, genTOTP, checkTOTP
  -- * constants
  , OTPAlgo, pattern OTP_SHA1, pattern OTP_SHA256, pattern OTP_SHA512
  , OTPDigitLen, pattern OTP_DIGIT_6, pattern OTP_DIGIT_7, pattern OTP_DIGIT_8
  ) where

import           Data.Word
import           GHC.Generics
import           Z.Botan.Exception
import           Z.Botan.FFI
import           Z.Data.CBytes
import qualified Z.Data.Vector  as V
import qualified Z.Data.Text    as T
import           Z.Crypto.Hash  (HashType(..), hashTypeToCBytes)
import           Z.Foreign

-- | HOTP generates OTPs that are a short numeric sequence, between 6 and 8 digits (most applications use 6 digits), created using the HMAC of a 64-bit counter value. If the counter ever repeats the OTP will also repeat, thus both parties must assure the counter only increments and is never repeated or decremented. Thus both client and server must keep track of the next counter expected.
-- Anyone with access to the client-specific secret key can authenticate as that client, so it should be treated with the same security consideration as would be given to any other symmetric key or plaintext password.
newtype HOTP = HOTP BotanStruct
    deriving (Show, Generic)
    deriving anyclass T.Print

type OTPAlgo = HashType
pattern OTP_SHA1    :: OTPAlgo
pattern OTP_SHA256  :: OTPAlgo
pattern OTP_SHA512  :: OTPAlgo
pattern OTP_SHA1    = SHA160
pattern OTP_SHA256  = SHA256
pattern OTP_SHA512  = SHA512

type OTPDigitLen = Int
pattern OTP_DIGIT_6 :: OTPDigitLen
pattern OTP_DIGIT_7 :: OTPDigitLen
pattern OTP_DIGIT_8 :: OTPDigitLen
pattern OTP_DIGIT_6 = 6
pattern OTP_DIGIT_7 = 7
pattern OTP_DIGIT_8 = 8

newHOTP :: V.Bytes -> OTPAlgo -> OTPDigitLen -> IO HOTP
newHOTP key otpAlgo digits =
    withPrimVectorUnsafe key $ \ key' keyOff keyLen ->
    withCBytesUnsafe (hashTypeToCBytes otpAlgo) $ \ hashAlgo' ->
        HOTP <$> newBotanStruct
            (\ hotp -> hs_botan_hotp_init hotp key' keyOff keyLen hashAlgo' digits)
            botan_hotp_destroy

-- | Generate a HOTP code for the provided counter.
genHOTP :: HOTP   -- ^ the HOTP object
        -> Word64 -- ^ HOTP counter
        -> IO Word32
genHOTP (HOTP hotp) counter =
    withBotanStruct hotp $ \ hotp' ->
    fst <$> allocPrimUnsafe (\ code -> botan_hotp_generate hotp' code counter)

-- | Verify a HOTP code.
checkHOTP :: HOTP   -- ^ the HOTP object
          -> Word32 -- ^ the presented HOTP code
          -> Word64 -- ^ the HOTP counter
          -> Int    -- ^ resync range
          -> IO (Bool, Word64)
checkHOTP (HOTP totp) code c range = do
    withBotanStruct totp $ \ totp' -> do
        (nc, ret) <- allocPrimUnsafe $ \ nc' ->
            botan_hotp_check totp' nc' code c (fromIntegral range)
        if ret == BOTAN_FFI_SUCCESS
        then return (True, nc)
        else if ret > 0
            then return (False, nc)
            else throwBotanError ret

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

-- | TOTP is based on the same algorithm as HOTP, but instead of a counter a timestamp is used.
newtype TOTP = TOTP BotanStruct
    deriving (Show, Generic)
    deriving anyclass T.Print

newTOTP :: V.Bytes -> OTPAlgo -> OTPDigitLen -> Int -> IO TOTP
newTOTP key otpAlgo digits timeStep =
    withPrimVectorUnsafe key $ \ key' keyOff keyLen ->
    withCBytesUnsafe (hashTypeToCBytes otpAlgo) $ \ hashAlgo' ->
        TOTP <$> newBotanStruct
            (\ hotp -> hs_botan_totp_init hotp key' keyOff keyLen hashAlgo' digits timeStep)
            botan_totp_destroy

-- | Generate a TOTP code for the provided timestamp.
genTOTP :: TOTP   -- ^ the TOTP object
        -> Word64 -- ^ the current local timestamp
        -> IO Word32
genTOTP (TOTP totp) timestamp =
    withBotanStruct totp $ \ totp' ->
    fst <$> allocPrimUnsafe (\ code -> botan_totp_generate totp' code timestamp)

-- | Verify a TOTP code.
checkTOTP :: TOTP   -- ^ the TOTP object
          -> Word32 -- ^ the presented OTP
          -> Word64 -- ^ timestamp the current local timestamp
          -> Int    -- ^ specifies the acceptable amount of clock drift
                    --   (in terms of time steps) between the two hosts.
          -> IO Bool
checkTOTP (TOTP totp) code timestamp driftAmount = do
    withBotanStruct totp $ \ totp' -> do
        ret <- botan_totp_check totp' code timestamp (fromIntegral driftAmount)
        if ret == BOTAN_FFI_SUCCESS
        then return True
        else if ret > 0
            then return False
            else throwBotanError ret