{-|
Module      : Botan.Low.HOTP
Description : Hash-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.HOTP (

  -- * Hash-based One Time Password
  -- $introduction
  -- * Usage
  -- $usage

  -- * HOTP

    HOTP(..)
  , HOTPHashName
  , HOTPCounter
  , HOTPCode
  , withHOTP
  , hotpInit
  , hotpDestroy
  , hotpGenerate
  , hotpCheck

  -- * HOTP Hashes

  , pattern HOTP_SHA1
  , pattern HOTP_SHA256
  , pattern HOTP_SHA512

  -- * Convenience

  , hotpHashes

  ) where

import           Botan.Bindings.ConstPtr (ConstPtr (..))
import           Botan.Bindings.HOTP
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 4226
-- NOTE: I think this *only* takes SHA-2, specificaly "SHA-256" and "SHA-512",
--  and probably because the RFC specifically uses it?

{- $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.

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.

-}

{- $usage

> WARNING: Guarding against concurrent access to the stored counter is
> beyond the scope of this tutorial.

To use HOTP for MFA / 2FA, the client authenticator must generate a
client-specific shared secret and counter value, and securely communicate
them 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. The counter value is not required to be
a secret; it may start at 0 for simplicity, or it may start at a value that
was selected at random.

> import Botan.Low.HOTP
> import Botan.Low.RNG
> import Botan.Low.MPI
> import Data.Bits
> sharedSecret <- systemRNGGet 16
> -- TODO: Use random:System.Random.Stateful.Uniform instead of MPI in `botan`
> (hi :: Word32) <- mpInit >>= \ w -> mpRandBits w rng 32 >> mpToWord32 w
> (lo :: Word32) <- mpInit >>= \ w -> mpRandBits w rng 32 >> mpToWord32 w
> (counter :: Word64) = shiftL (fromIntegral hi) 32 `xor` fromIntegral lo

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

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

> -- (serverSharedSecret, serverCounter) <- lookupServerSharedSecretAndCounter
> serverSession <- hotpInit serverSharedSecret HOTP_SHA512 8
> -- sendMFAAuthenticationRequest

The client authenticator receives the authentication request, generates a
client-side code, increments their counter, and displays the HOTP code to
the user:

> -- (clientSharedSecret, clientCounter) <- lookupClientSharedSecretAndCounter
> clientSession <- hotpInit clientSharedSecret HOTP_SHA512 8
> clientCode <- hotpGenerate clientSession clientCounter
> -- incrementAndPersistClientCounter
> -- displayClientCode clientCode

> NOTE: The client authenticator is responsible for incrementing and persisting
> their own counter manually.

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 a resync range of R in case the client has generated
a few codes without logging in successfully:

> -- serverClientCode <- didreceiveMFAAuthenticationResponse
> (isValid,nextCounter) <- hotpCheck serverSession serverClientCode serverCounter 10
> persistClientCounter nextCounter

> NOTE: The server authentication check returns an incremented and resynced
> counter which must be persisted manually. If the authentication check fails,
> the counter value is return unchanged.

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 T unsuccessful authentication attempts, where T < R.
The user should then be notified.

-}

newtype HOTP = MkHOTP { HOTP -> ForeignPtr BotanHOTPStruct
foreignPtr :: ForeignPtr BotanHOTPStruct }

withHOTP     :: HOTP -> (BotanHOTP -> IO a) -> IO a
hotpDestroy  :: HOTP -> IO ()
createHOTP   :: (Ptr BotanHOTP -> IO CInt) -> IO HOTP
(HOTP -> (BotanHOTP -> IO a) -> IO a
withHOTP, HOTP -> IO ()
hotpDestroy, (Ptr BotanHOTP -> IO CInt) -> IO HOTP
createHOTP)
    = (Ptr BotanHOTPStruct -> BotanHOTP)
-> (BotanHOTP -> Ptr BotanHOTPStruct)
-> (ForeignPtr BotanHOTPStruct -> HOTP)
-> (HOTP -> ForeignPtr BotanHOTPStruct)
-> FinalizerPtr BotanHOTPStruct
-> (HOTP -> (BotanHOTP -> IO a) -> IO a, HOTP -> IO (),
    (Ptr BotanHOTP -> IO CInt) -> IO HOTP)
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 BotanHOTPStruct -> BotanHOTP
MkBotanHOTP (.ptr)
        ForeignPtr BotanHOTPStruct -> HOTP
MkHOTP (.foreignPtr)
        FinalizerPtr BotanHOTPStruct
botan_hotp_destroy

type HOTPHashName = HashName

pattern HOTP_SHA1
    ,   HOTP_SHA256
    ,   HOTP_SHA512
    ::  HOTPHashName

pattern $bHOTP_SHA1 :: HOTPHashName
$mHOTP_SHA1 :: forall {r}. HOTPHashName -> ((# #) -> r) -> ((# #) -> r) -> r
HOTP_SHA1   = SHA1
pattern $bHOTP_SHA256 :: HOTPHashName
$mHOTP_SHA256 :: forall {r}. HOTPHashName -> ((# #) -> r) -> ((# #) -> r) -> r
HOTP_SHA256 = SHA256
pattern $bHOTP_SHA512 :: HOTPHashName
$mHOTP_SHA512 :: forall {r}. HOTPHashName -> ((# #) -> r) -> ((# #) -> r) -> r
HOTP_SHA512 = SHA512

-- TODO: Do any other hashes work?
hotpHashes :: [HOTPHashName]
hotpHashes :: [HOTPHashName]
hotpHashes =
    [ HOTPHashName
HOTP_SHA1
    , HOTPHashName
HOTP_SHA256
    , HOTPHashName
HOTP_SHA512
    ]

type HOTPCounter = Word64
type HOTPCode = Word32

-- NOTE: Digits should be 6-8
hotpInit
    :: ByteString   -- ^ __key[]__
    -> HashName     -- ^ __hash_algo__
    -> Int          -- ^ __digits__
    -> IO HOTP      -- ^ __hotp__
hotpInit :: HOTPHashName -> HOTPHashName -> Int -> IO HOTP
hotpInit HOTPHashName
key HOTPHashName
algo Int
digits = HOTPHashName -> (Ptr Word8 -> CSize -> IO HOTP) -> IO HOTP
forall byte a. HOTPHashName -> (Ptr byte -> CSize -> IO a) -> IO a
asBytesLen HOTPHashName
key ((Ptr Word8 -> CSize -> IO HOTP) -> IO HOTP)
-> (Ptr Word8 -> CSize -> IO HOTP) -> IO HOTP
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
keyPtr CSize
keyLen -> do
    HOTPHashName -> (Ptr CChar -> IO HOTP) -> IO HOTP
forall a. HOTPHashName -> (Ptr CChar -> IO a) -> IO a
asCString HOTPHashName
algo ((Ptr CChar -> IO HOTP) -> IO HOTP)
-> (Ptr CChar -> IO HOTP) -> IO HOTP
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
algoPtr -> do
        (Ptr BotanHOTP -> IO CInt) -> IO HOTP
createHOTP ((Ptr BotanHOTP -> IO CInt) -> IO HOTP)
-> (Ptr BotanHOTP -> IO CInt) -> IO HOTP
forall a b. (a -> b) -> a -> b
$ \ Ptr BotanHOTP
out -> Ptr BotanHOTP
-> ConstPtr Word8 -> CSize -> ConstPtr CChar -> CSize -> IO CInt
botan_hotp_init
            Ptr BotanHOTP
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)

-- NOTE: User is responsible for incrementing counter at this level
hotpGenerate
    :: HOTP         -- ^ __hotp__
    -> HOTPCounter  -- ^ __hotp_counter__
    -> IO HOTPCode  -- ^ __hotp_code__
hotpGenerate :: HOTP -> Word64 -> IO Word32
hotpGenerate HOTP
hotp Word64
counter = HOTP -> (BotanHOTP -> IO Word32) -> IO Word32
forall a. HOTP -> (BotanHOTP -> IO a) -> IO a
withHOTP HOTP
hotp ((BotanHOTP -> IO Word32) -> IO Word32)
-> (BotanHOTP -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \ BotanHOTP
hotpPtr -> 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
$ BotanHOTP -> Ptr Word32 -> Word64 -> IO CInt
botan_hotp_generate BotanHOTP
hotpPtr Ptr Word32
outPtr Word64
counter
        Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
outPtr

-- NOTE:
--      "Returns a pair of (is_valid,next_counter_to_use). If the OTP is
--      invalid then always returns (false,starting_counter), since the
--      last successful authentication counter has not changed. ""
-- NOTE: "Depending on the environment a resync_range of 3 to 10 might be appropriate."
hotpCheck ::
     HOTP                     -- ^ __hotp__
  -> HOTPCode                 -- ^ __hotp_code__
  -> HOTPCounter              -- ^ __hotp_counter__
  -> Int                      -- ^ __resync_range__
  -> IO (Bool, HOTPCounter)   -- ^ __(valid,next_counter)__
hotpCheck :: HOTP -> Word32 -> Word64 -> Int -> IO (Bool, Word64)
hotpCheck HOTP
hotp Word32
code Word64
counter Int
resync =
    HOTP -> (BotanHOTP -> IO (Bool, Word64)) -> IO (Bool, Word64)
forall a. HOTP -> (BotanHOTP -> IO a) -> IO a
withHOTP HOTP
hotp ((BotanHOTP -> IO (Bool, Word64)) -> IO (Bool, Word64))
-> (BotanHOTP -> IO (Bool, Word64)) -> IO (Bool, Word64)
forall a b. (a -> b) -> a -> b
$ \ BotanHOTP
hotpPtr ->
    (Ptr Word64 -> IO (Bool, Word64)) -> IO (Bool, Word64)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word64 -> IO (Bool, Word64)) -> IO (Bool, Word64))
-> (Ptr Word64 -> IO (Bool, Word64)) -> IO (Bool, Word64)
forall a b. (a -> b) -> a -> b
$ \ Ptr Word64
outPtr -> do
      Bool
valid <- 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
$ BotanHOTP -> Ptr Word64 -> Word32 -> Word64 -> CSize -> IO CInt
botan_hotp_check BotanHOTP
hotpPtr Ptr Word64
outPtr Word32
code Word64
counter (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
resync)
      Word64
nextCounter <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
outPtr
      (Bool, Word64) -> IO (Bool, Word64)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
valid, Word64
nextCounter)