{-|
Module      : Botan.Low.TOTP
Description : Time-based one time passwords
Copyright   : (c) 2023-2024, Apotheca Labs
              (c) 2024-2025, Haskell Foundation
License     : BSD-3-Clause
Maintainer  : joris@well-typed.com, leo@apotheca.io
Stability   : experimental
Portability : POSIX

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.

-}

module Botan.Low.TOTP (

  -- * Time-based one time passwords
  -- $introduction
  -- * Usage
  -- $usage

  -- * TOTP

    TOTP(..)
  , TOTPHashName
  , TOTPTimestep
  , TOTPTimestamp
  , TOTPCode
  , withTOTP
  , totpInit
  , totpDestroy
  , totpGenerate
  , totpCheck

  -- * TOTP Hashes

  , pattern TOTP_SHA1
  , pattern TOTP_SHA256
  , pattern TOTP_SHA512

  -- * Convenience

  , totpHashes

  ) where

import           Botan.Bindings.ConstPtr (ConstPtr (..))
import           Botan.Bindings.TOTP
import           Botan.Low.Error.Internal
import           Botan.Low.Hash
import           Botan.Low.Internal.ByteString
import           Botan.Low.Remake
import           Control.Monad
import           Data.ByteString (ByteString)
import           Data.Word
import           Foreign.C.Types
import           Foreign.ForeignPtr
import           Foreign.Marshal.Alloc
import           Foreign.Ptr
import           Foreign.Storable

-- NOTE: RFC 6238

{- $introduction

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.

TOTP generates OTPs that are a short numeric sequence, between 6
and 8 digits (most applications use 6 digits), created using a
64-bit timestamp 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 their clocks synchronized.

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.

TOTP is based on the same algorithm as HOTP, but instead of a
counter a timestamp is used.

-}

{- $usage

To use TOTP for MFA / 2FA, the client authenticator must generate a
client-specific shared secret, and securely communicate it to the
server authenticator.

The secret key may be any bytestring value with more than 160 bits, such as
a Bcrypt digest or SRP6 shared key.

> import Botan.Low.TOTP
> import Botan.Low.RNG
> import Data.Time.Clock.POSIX
> timestep = 30
> drift = 3
> sharedSecret <- systemRNGGet 16

The client and server authenticators are now in a shared state, and any login
attempts from a new device may be authenticated using TOTP as MFA.

A client has requested a new connection, and TOTP is being used as MFA/2FA to
authenticate their request. The server authenticator receives the client connection
request and initializes a TOTP session using the stored client-specific shared
secret, and then sends an authentication request to the client authenticator:

> -- serverSharedSecret <- lookupServerSharedSecret
> serverSession <- totpInit serverSharedSecret TOTP_SHA512 8 timestep
> -- sendMFAAuthenticationRequest

> NOTE: We are using a timestep value of 30 seconds, which means that the
> code will refresh every 30 seconds

The client authenticator receives the authentication request, generates a
client-side code using their timestamp, and displays the TOTP code to
the user:

> -- clientSharedSecret <- lookupClientSharedSecret
> clientSession <- totpInit clientSharedSecret TOTP_SHA512 8 timestep
> (clientTimestamp :: TOTPTimestamp) <- round <$> getPOSIXTime
> clientCode <- totpGenerate clientSession clientTimestamp
> -- displayClientCode clientCode

The client then sends the client code to the server authenticator using the
unauthenticated / requested connection:

> -- clientCode <- readClientCode
> -- sendMFAAuthenticationResponse clientCode

The server authenticator receives the authentication response, and performs
a check of the key, with an acceptable clock drift in steps, in case the client
and server are slightly desynchronized.

> -- serverClientCode <- didreceiveMFAAuthenticationResponse
> (serverTimestamp :: TOTPTimestamp) <- round <$> getPOSIXTime
> isValid <- totpCheck serverSession serverClientCode serverTimestamp drift

> NOTE: We are using a acceptable clock drift value of 3, which means that the
> codes for the previous 3 time steps are still valid.

If the code is valid, then the signin may be completed on the new connection
as normal.

The server should discontinue the session and refuse any new connections
to the account after multiple unsuccessful authentication attempts.
The user should then be notified.

-}

newtype TOTP = MkTOTP { TOTP -> ForeignPtr BotanTOTPStruct
foreignPtr :: ForeignPtr BotanTOTPStruct }

withTOTP     :: TOTP -> (BotanTOTP -> IO a) -> IO a
totpDestroy  :: TOTP -> IO ()
createTOTP   :: (Ptr BotanTOTP -> IO CInt) -> IO TOTP
(TOTP -> (BotanTOTP -> IO a) -> IO a
withTOTP, TOTP -> IO ()
totpDestroy, (Ptr BotanTOTP -> IO CInt) -> IO TOTP
createTOTP)
    = (Ptr BotanTOTPStruct -> BotanTOTP)
-> (BotanTOTP -> Ptr BotanTOTPStruct)
-> (ForeignPtr BotanTOTPStruct -> TOTP)
-> (TOTP -> ForeignPtr BotanTOTPStruct)
-> FinalizerPtr BotanTOTPStruct
-> (TOTP -> (BotanTOTP -> IO a) -> IO a, TOTP -> IO (),
    (Ptr BotanTOTP -> IO CInt) -> IO TOTP)
forall botan struct object a.
Storable botan =>
(Ptr struct -> botan)
-> (botan -> Ptr struct)
-> (ForeignPtr struct -> object)
-> (object -> ForeignPtr struct)
-> FinalizerPtr struct
-> (object -> (botan -> IO a) -> IO a, object -> IO (),
    (Ptr botan -> IO CInt) -> IO object)
mkBindings
        Ptr BotanTOTPStruct -> BotanTOTP
MkBotanTOTP (.ptr)
        ForeignPtr BotanTOTPStruct -> TOTP
MkTOTP (.foreignPtr)
        FinalizerPtr BotanTOTPStruct
botan_totp_destroy

type TOTPHashName = HashName

pattern TOTP_SHA1
    ,   TOTP_SHA256
    ,   TOTP_SHA512
    ::  TOTPHashName

pattern $bTOTP_SHA1 :: TOTPHashName
$mTOTP_SHA1 :: forall {r}. TOTPHashName -> ((# #) -> r) -> ((# #) -> r) -> r
TOTP_SHA1   = SHA1
pattern $bTOTP_SHA256 :: TOTPHashName
$mTOTP_SHA256 :: forall {r}. TOTPHashName -> ((# #) -> r) -> ((# #) -> r) -> r
TOTP_SHA256 = SHA256
pattern $bTOTP_SHA512 :: TOTPHashName
$mTOTP_SHA512 :: forall {r}. TOTPHashName -> ((# #) -> r) -> ((# #) -> r) -> r
TOTP_SHA512 = SHA512

-- TODO: Do any other hashes work?
totpHashes :: [TOTPHashName]
totpHashes :: [TOTPHashName]
totpHashes =
    [ TOTPHashName
TOTP_SHA1
    , TOTPHashName
TOTP_SHA256
    , TOTPHashName
TOTP_SHA512
    ]

type TOTPTimestep = Word64
type TOTPTimestamp = Word64
type TOTPCode = Word32

-- | Initialize a TOTP instance
--
-- NOTE: Digits should be 6-8
totpInit
    :: ByteString   -- ^ __key[]__
    -> TOTPHashName -- ^ __hash_algo__
    -> Int          -- ^ __digits__
    -> TOTPTimestep -- ^ __time_step__
    -> IO TOTP      -- ^ __totp__
totpInit :: TOTPHashName -> TOTPHashName -> Int -> TOTPTimestep -> IO TOTP
totpInit TOTPHashName
key TOTPHashName
algo Int
digits TOTPTimestep
timestep = TOTPHashName -> (Ptr Word8 -> CSize -> IO TOTP) -> IO TOTP
forall byte a. TOTPHashName -> (Ptr byte -> CSize -> IO a) -> IO a
asBytesLen TOTPHashName
key ((Ptr Word8 -> CSize -> IO TOTP) -> IO TOTP)
-> (Ptr Word8 -> CSize -> IO TOTP) -> IO TOTP
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
keyPtr CSize
keyLen -> do
    TOTPHashName -> (Ptr CChar -> IO TOTP) -> IO TOTP
forall a. TOTPHashName -> (Ptr CChar -> IO a) -> IO a
asCString TOTPHashName
algo ((Ptr CChar -> IO TOTP) -> IO TOTP)
-> (Ptr CChar -> IO TOTP) -> IO TOTP
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
algoPtr -> do
        (Ptr BotanTOTP -> IO CInt) -> IO TOTP
createTOTP ((Ptr BotanTOTP -> IO CInt) -> IO TOTP)
-> (Ptr BotanTOTP -> IO CInt) -> IO TOTP
forall a b. (a -> b) -> a -> b
$ \ Ptr BotanTOTP
out -> Ptr BotanTOTP
-> ConstPtr Word8
-> CSize
-> ConstPtr CChar
-> CSize
-> CSize
-> IO CInt
botan_totp_init
            Ptr BotanTOTP
out
            (Ptr Word8 -> ConstPtr Word8
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr Word8
keyPtr)
            CSize
keyLen
            (Ptr CChar -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr CChar
algoPtr)
            (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
digits)
            (TOTPTimestep -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral TOTPTimestep
timestep)

-- | Generate a TOTP code for the provided timestamp
totpGenerate
    :: TOTP             -- ^ __totp__: the TOTP object
    -> TOTPTimestamp    -- ^ __totp_code__: the OTP code will be written here
    -> IO TOTPCode      -- ^ __timestamp__: the current local timestamp
totpGenerate :: TOTP -> TOTPTimestep -> IO Word32
totpGenerate TOTP
totp TOTPTimestep
timestamp = TOTP -> (BotanTOTP -> IO Word32) -> IO Word32
forall a. TOTP -> (BotanTOTP -> IO a) -> IO a
withTOTP TOTP
totp ((BotanTOTP -> IO Word32) -> IO Word32)
-> (BotanTOTP -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \ BotanTOTP
totpPtr -> do
    (Ptr Word32 -> IO Word32) -> IO Word32
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word32 -> IO Word32) -> IO Word32)
-> (Ptr Word32 -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \ Ptr Word32
outPtr -> do
        IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ HasCallStack => IO CInt -> IO CInt
IO CInt -> IO CInt
throwBotanIfNegative (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$ BotanTOTP -> Ptr Word32 -> TOTPTimestep -> IO CInt
botan_totp_generate BotanTOTP
totpPtr Ptr Word32
outPtr TOTPTimestep
timestamp
        Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
outPtr

-- | Verify a TOTP code
totpCheck ::
     TOTP             -- ^ __totp__: the TOTP object
  -> TOTPCode         -- ^ __totp_code__: the presented OTP
  -> TOTPTimestamp    -- ^ __timestamp__: the current local timestamp
  -> Int              -- ^ __acceptable_clock_drift__: specifies the acceptable amount
                      --   of clock drift (in terms of time steps) between the two hosts.
  -> IO Bool
totpCheck :: TOTP -> Word32 -> TOTPTimestep -> Int -> IO Bool
totpCheck TOTP
totp Word32
code TOTPTimestep
timestamp Int
drift =
    TOTP -> (BotanTOTP -> IO Bool) -> IO Bool
forall a. TOTP -> (BotanTOTP -> IO a) -> IO a
withTOTP TOTP
totp ((BotanTOTP -> IO Bool) -> IO Bool)
-> (BotanTOTP -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ BotanTOTP
totpPtr ->
    HasCallStack => IO CInt -> IO Bool
IO CInt -> IO Bool
throwBotanCatchingInvalidVerifier (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$ BotanTOTP -> Word32 -> TOTPTimestep -> CSize -> IO CInt
botan_totp_check BotanTOTP
totpPtr Word32
code TOTPTimestep
timestamp (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
drift)