{-|
Module      : Botan.Bindings.HOTP
Description : Hash-based one-time passwords
Copyright   : (c) Leo D, 2023
License     : BSD-3-Clause
Maintainer  : 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.

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.
-}

{-# LANGUAGE CApiFFI #-}

module Botan.Bindings.HOTP where
import Botan.Bindings.Prelude

-- | Opaque HOTP struct
data {-# CTYPE "botan/ffi.h" "struct botan_hotp_struct" #-} BotanHOTPStruct

-- | Botan HOTP object
newtype {-# CTYPE "botan/ffi.h" "botan_hotp_t" #-} BotanHOTP
    = MkBotanHOTP { BotanHOTP -> Ptr BotanHOTPStruct
runBotanHOTP :: Ptr BotanHOTPStruct }
        deriving newtype (BotanHOTP -> BotanHOTP -> Bool
(BotanHOTP -> BotanHOTP -> Bool)
-> (BotanHOTP -> BotanHOTP -> Bool) -> Eq BotanHOTP
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BotanHOTP -> BotanHOTP -> Bool
== :: BotanHOTP -> BotanHOTP -> Bool
$c/= :: BotanHOTP -> BotanHOTP -> Bool
/= :: BotanHOTP -> BotanHOTP -> Bool
Eq, Eq BotanHOTP
Eq BotanHOTP
-> (BotanHOTP -> BotanHOTP -> Ordering)
-> (BotanHOTP -> BotanHOTP -> Bool)
-> (BotanHOTP -> BotanHOTP -> Bool)
-> (BotanHOTP -> BotanHOTP -> Bool)
-> (BotanHOTP -> BotanHOTP -> Bool)
-> (BotanHOTP -> BotanHOTP -> BotanHOTP)
-> (BotanHOTP -> BotanHOTP -> BotanHOTP)
-> Ord BotanHOTP
BotanHOTP -> BotanHOTP -> Bool
BotanHOTP -> BotanHOTP -> Ordering
BotanHOTP -> BotanHOTP -> BotanHOTP
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BotanHOTP -> BotanHOTP -> Ordering
compare :: BotanHOTP -> BotanHOTP -> Ordering
$c< :: BotanHOTP -> BotanHOTP -> Bool
< :: BotanHOTP -> BotanHOTP -> Bool
$c<= :: BotanHOTP -> BotanHOTP -> Bool
<= :: BotanHOTP -> BotanHOTP -> Bool
$c> :: BotanHOTP -> BotanHOTP -> Bool
> :: BotanHOTP -> BotanHOTP -> Bool
$c>= :: BotanHOTP -> BotanHOTP -> Bool
>= :: BotanHOTP -> BotanHOTP -> Bool
$cmax :: BotanHOTP -> BotanHOTP -> BotanHOTP
max :: BotanHOTP -> BotanHOTP -> BotanHOTP
$cmin :: BotanHOTP -> BotanHOTP -> BotanHOTP
min :: BotanHOTP -> BotanHOTP -> BotanHOTP
Ord, Ptr BotanHOTP -> IO BotanHOTP
Ptr BotanHOTP -> Int -> IO BotanHOTP
Ptr BotanHOTP -> Int -> BotanHOTP -> IO ()
Ptr BotanHOTP -> BotanHOTP -> IO ()
BotanHOTP -> Int
(BotanHOTP -> Int)
-> (BotanHOTP -> Int)
-> (Ptr BotanHOTP -> Int -> IO BotanHOTP)
-> (Ptr BotanHOTP -> Int -> BotanHOTP -> IO ())
-> (forall b. Ptr b -> Int -> IO BotanHOTP)
-> (forall b. Ptr b -> Int -> BotanHOTP -> IO ())
-> (Ptr BotanHOTP -> IO BotanHOTP)
-> (Ptr BotanHOTP -> BotanHOTP -> IO ())
-> Storable BotanHOTP
forall b. Ptr b -> Int -> IO BotanHOTP
forall b. Ptr b -> Int -> BotanHOTP -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: BotanHOTP -> Int
sizeOf :: BotanHOTP -> Int
$calignment :: BotanHOTP -> Int
alignment :: BotanHOTP -> Int
$cpeekElemOff :: Ptr BotanHOTP -> Int -> IO BotanHOTP
peekElemOff :: Ptr BotanHOTP -> Int -> IO BotanHOTP
$cpokeElemOff :: Ptr BotanHOTP -> Int -> BotanHOTP -> IO ()
pokeElemOff :: Ptr BotanHOTP -> Int -> BotanHOTP -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO BotanHOTP
peekByteOff :: forall b. Ptr b -> Int -> IO BotanHOTP
$cpokeByteOff :: forall b. Ptr b -> Int -> BotanHOTP -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> BotanHOTP -> IO ()
$cpeek :: Ptr BotanHOTP -> IO BotanHOTP
peek :: Ptr BotanHOTP -> IO BotanHOTP
$cpoke :: Ptr BotanHOTP -> BotanHOTP -> IO ()
poke :: Ptr BotanHOTP -> BotanHOTP -> IO ()
Storable)

-- | Destroy a HOTP instance
foreign import capi safe "botan/ffi.h &botan_hotp_destroy"
    botan_hotp_destroy
        :: FinalizerPtr BotanHOTPStruct

-- | Initialize a HOTP instance
foreign import capi safe "botan/ffi.h botan_hotp_init"
    botan_hotp_init
        :: Ptr BotanHOTP    -- ^ __hotp__
        -> ConstPtr Word8   -- ^ __key[]__
        -> CSize            -- ^ __key_len__
        -> ConstPtr CChar   -- ^ __hash_algo__
        -> CSize            -- ^ __digits__
        -> IO CInt


-- | Generate a HOTP code for the provided counter
foreign import capi safe "botan/ffi.h botan_hotp_generate"
    botan_hotp_generate
        :: BotanHOTP    -- ^ __hotp__
        -> Ptr Word32   -- ^ __hotp_code__
        -> Word64       -- ^ __hotp_counter__
        -> IO CInt

-- | Verify a HOTP code
foreign import capi safe "botan/ffi.h botan_hotp_check"
    botan_hotp_check
        :: BotanHOTP    -- ^ __hotp__
        -> Ptr Word64   -- ^ __next_hotp_counter__
        -> Word32       -- ^ __hotp_code__
        -> Word64       -- ^ __hotp_counter__
        -> CSize        -- ^ __resync_range__
        -> IO CInt