{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | One-time password implementation as defined by the
-- <http://tools.ietf.org/html/rfc4226 HOTP> and <http://tools.ietf.org/html/rfc6238 TOTP>
-- specifications.
--
-- Both implementations use a shared key between the client and the server. HOTP passwords
-- are based on a synchronized counter. TOTP passwords use the same approach but calculate
-- the counter as a number of time steps from the Unix epoch to the current time, thus
-- requiring that both client and server have synchronized clocks.
--
-- Probably the best-known use of TOTP is in Google's 2-factor authentication.
--
-- The TOTP API doesn't depend on any particular time package, so the user needs to supply
-- the current @OTPTime@ value, based on the system time. For example, using the @hourglass@
-- package, you could create a @getOTPTime@ function:
--
-- >>> import Time.System
-- >>> import Time.Types
-- >>>
-- >>> let getOTPTime = timeCurrent >>= \(Elapsed t) -> return (fromIntegral t :: OTPTime)
--
-- Or if you prefer, the @time@ package could be used:
--
-- >>> import Data.Time.Clock.POSIX
-- >>>
-- >>> let getOTPTime = getPOSIXTime >>= \t -> return (floor t :: OTPTime)
module Crypto.OTP (
    OTP,
    OTPDigits (..),
    OTPTime,
    minimumDigestSize,
    hotp,
    resynchronize,
    totp,
    totpVerify,
    TOTPParams,
    ClockSkew (..),
    defaultTOTPParams,
    mkTOTPParams,
)
where

import Control.Monad (unless)
import Crypto.Hash (HashAlgorithm, SHA1 (..), hashDigestSize)
import Crypto.Internal.ByteArray (ByteArrayAccess, Bytes)
import qualified Crypto.Internal.ByteArray as B
import Crypto.MAC.HMAC
import Data.Bits (complement, shiftL, shiftR, xor, (.&.), (.|.))
import Data.ByteArray.Mapping (fromW64BE)
import qualified Data.List as L
import Data.Word

-- | A one-time password which is a sequence of 4 to 9 digits.
type OTP = Word32

-- | The strength of the calculated HOTP value, namely
-- the number of digits (between 4 and 9) in the extracted value.
data OTPDigits = OTP4 | OTP5 | OTP6 | OTP7 | OTP8 | OTP9 deriving (Int -> OTPDigits -> ShowS
[OTPDigits] -> ShowS
OTPDigits -> String
(Int -> OTPDigits -> ShowS)
-> (OTPDigits -> String)
-> ([OTPDigits] -> ShowS)
-> Show OTPDigits
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OTPDigits -> ShowS
showsPrec :: Int -> OTPDigits -> ShowS
$cshow :: OTPDigits -> String
show :: OTPDigits -> String
$cshowList :: [OTPDigits] -> ShowS
showList :: [OTPDigits] -> ShowS
Show)

-- | An integral time value in seconds.
type OTPTime = Word64

-- | The smallest hash digest 'hotp' can be used with, in bytes.
--
-- RFC 4226 section 5.3 defines dynamic truncation over the 20-byte HMAC-SHA-1
-- output: the offset is the low four bits of the last byte, so it selects any
-- of the first 16 bytes, and four bytes are then read starting there.  The
-- highest byte that can be reached is therefore byte 18, and a shorter digest
-- would make that read run off the end of the MAC.
minimumDigestSize :: Int
minimumDigestSize :: Int
minimumDigestSize = Int
20

-- | Calculate an HOTP value as defined by RFC 4226.
--
-- The hash must produce a digest of at least 'minimumDigestSize' bytes, which
-- is what the dynamic truncation step is defined over; 'error' is raised
-- otherwise.
hotp
    :: forall hash key
     . (HashAlgorithm hash, ByteArrayAccess key)
    => hash
    -> OTPDigits
    -- ^ Number of digits in the HOTP value extracted from the calculated HMAC
    -> key
    -- ^ Shared secret between the client and server
    -> Word64
    -- ^ Counter value synchronized between the client and server
    -> OTP
    -- ^ The HOTP value
hotp :: forall hash key.
(HashAlgorithm hash, ByteArrayAccess key) =>
hash -> OTPDigits -> key -> Word64 -> Word32
hotp hash
_ OTPDigits
d key
k Word64
c
    | Int
macLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
minimumDigestSize =
        String -> Word32
forall a. HasCallStack => String -> a
error (String -> Word32) -> String -> Word32
forall a b. (a -> b) -> a -> b
$
            String
"Crypto.OTP.hotp: hash digest is "
                String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
macLen
                String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" bytes, but at least "
                String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
minimumDigestSize
                String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" are required"
    | Bool
otherwise = Word32
dt Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`mod` OTPDigits -> Word32
digitsPower OTPDigits
d
  where
    mac :: HMAC hash
mac = key -> Bytes -> HMAC hash
forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
hmac key
k (Word64 -> Bytes
forall ba. ByteArray ba => Word64 -> ba
fromW64BE Word64
c :: Bytes) :: HMAC hash
    macLen :: Int
macLen = HMAC hash -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length HMAC hash
mac
    offset :: Int
offset = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HMAC hash -> Int -> Word8
forall a. ByteArrayAccess a => a -> Int -> Word8
B.index HMAC hash
mac (Int
macLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xf)
    dt :: Word32
dt =
        (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HMAC hash -> Int -> Word8
forall a. ByteArrayAccess a => a -> Int -> Word8
B.index HMAC hash
mac Int
offset Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7f) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
24)
            Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HMAC hash -> Int -> Word8
forall a. ByteArrayAccess a => a -> Int -> Word8
B.index HMAC hash
mac (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xff) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
16)
            Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HMAC hash -> Int -> Word8
forall a. ByteArrayAccess a => a -> Int -> Word8
B.index HMAC hash
mac (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xff) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
8)
            Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HMAC hash -> Int -> Word8
forall a. ByteArrayAccess a => a -> Int -> Word8
B.index HMAC hash
mac (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xff)

-- | Attempt to resynchronize the server's counter value
-- with the client, given a sequence of HOTP values.
--
-- Every counter in the window is tried and every submitted value is compared,
-- whatever matches, so the time taken does not depend on where in the window
-- the client's counter was found, nor on how many of the submitted values were
-- right.  The cost of a call is therefore one HMAC per counter in the window
-- plus one per extra value, every time.
resynchronize
    :: (HashAlgorithm hash, ByteArrayAccess key)
    => hash
    -> OTPDigits
    -> Word16
    -- ^ The look-ahead window parameter. Up to this many values will
    -- be calculated and checked against the value(s) submitted by the client
    -> key
    -- ^ The shared secret
    -> Word64
    -- ^ The current server counter value
    -> (OTP, [OTP])
    -- ^ The first OTP submitted by the client and a list of additional
    -- sequential OTPs (which may be empty)
    -> Maybe Word64
    -- ^ The new counter value, synchronized with the client's current counter
    -- or Nothing if the submitted OTP values didn't match anywhere within the window
resynchronize :: forall hash key.
(HashAlgorithm hash, ByteArrayAccess key) =>
hash
-> OTPDigits
-> Word16
-> key
-> Word64
-> (Word32, [Word32])
-> Maybe Word64
resynchronize hash
h OTPDigits
d Word16
s key
k Word64
c (Word32
p1, [Word32]
extras)
    | Word64
accepted Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 = Maybe Word64
forall a. Maybe a
Nothing
    | Bool
otherwise = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Word64
afterFirst Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Word32] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word32]
extras))
  where
    -- Every counter in the window is tried and every extra value is compared,
    -- whatever matches: the search does not stop at the first hit and the
    -- check of the extra values does not stop at the first miss.  Each skipped
    -- counter used to save an HMAC, so the time taken revealed where in the
    -- window the client's counter sat and how many of its extra values were
    -- right -- the second of which a client that submits guesses cannot learn
    -- from the answer itself, since that is 'Nothing' either way.
    accepted :: Word64
accepted = Word64
matched Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
extrasMatched

    range :: [Word32]
range = (Word64 -> Word32) -> [Word64] -> [Word32]
forall a b. (a -> b) -> [a] -> [b]
map (hash -> OTPDigits -> key -> Word64 -> Word32
forall hash key.
(HashAlgorithm hash, ByteArrayAccess key) =>
hash -> OTPDigits -> key -> Word64 -> Word32
hotp hash
h OTPDigits
d key
k) [Word64
c .. Word64
c Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
s]

    -- the offset of the first match, accumulated without stopping there
    (Word64
matched, Word64
offset) = ((Word64, Word64) -> (Word64, Word32) -> (Word64, Word64))
-> (Word64, Word64) -> [(Word64, Word32)] -> (Word64, Word64)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' (Word64, Word64) -> (Word64, Word32) -> (Word64, Word64)
pick (Word64
0, Word64
0) ([Word64] -> [Word32] -> [(Word64, Word32)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word64
0 ..] [Word32]
range)
    pick :: (Word64, Word64) -> (Word64, Word32) -> (Word64, Word64)
pick (!Word64
m, !Word64
off) (Word64
i, Word32
candidate) = (Word64
m Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
hit, Word64
off Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word64
hit Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
i))
      where
        -- zero once something has matched, so only the first match counts
        hit :: Word64
hit = Word32 -> Word32 -> Word64
eqMask Word32
candidate Word32
p1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64 -> Word64
forall a. Bits a => a -> a
complement Word64
m

    -- the counter the first submitted value matched, plus one
    afterFirst :: Word64
afterFirst = Word64
c Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
offset Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1

    -- the counters continue past the window, and wrap where the old
    -- 'checkExtraOtps' wrapped
    extrasMatched :: Word64
extrasMatched =
        (Word64 -> (Word64, Word32) -> Word64)
-> Word64 -> [(Word64, Word32)] -> Word64
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' Word64 -> (Word64, Word32) -> Word64
step (Word64 -> Word64
forall a. Bits a => a -> a
complement Word64
0) ([Word64] -> [Word32] -> [(Word64, Word32)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Word64 -> Word64) -> Word64 -> [Word64]
forall a. (a -> a) -> a -> [a]
iterate (Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1) Word64
afterFirst) [Word32]
extras)
    step :: Word64 -> (Word64, Word32) -> Word64
step Word64
acc (Word64
ctr, Word32
p) = Word64
acc Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word32 -> Word32 -> Word64
eqMask (hash -> OTPDigits -> key -> Word64 -> Word32
forall hash key.
(HashAlgorithm hash, ByteArrayAccess key) =>
hash -> OTPDigits -> key -> Word64 -> Word32
hotp hash
h OTPDigits
d key
k Word64
ctr) Word32
p

-- | All ones when the two values are equal, zero otherwise, without branching
-- on either of them.
eqMask :: OTP -> OTP -> Word64
eqMask :: Word32 -> Word32 -> Word64
eqMask Word32
a Word32
b = Word64 -> Word64
forall a. Num a => a -> a
negate (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
1 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
nonZero))
  where
    v :: Word32
v = Word32
a Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
b
    -- 0 when v is zero, 1 otherwise
    nonZero :: Word32
nonZero = (Word32
v Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32 -> Word32
forall a. Num a => a -> a
negate Word32
v) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
31

digitsPower :: OTPDigits -> Word32
digitsPower :: OTPDigits -> Word32
digitsPower OTPDigits
OTP4 = Word32
10000
digitsPower OTPDigits
OTP5 = Word32
100000
digitsPower OTPDigits
OTP6 = Word32
1000000
digitsPower OTPDigits
OTP7 = Word32
10000000
digitsPower OTPDigits
OTP8 = Word32
100000000
digitsPower OTPDigits
OTP9 = Word32
1000000000

data TOTPParams h = TP !h !OTPTime !Word16 !OTPDigits !ClockSkew deriving (Int -> TOTPParams h -> ShowS
[TOTPParams h] -> ShowS
TOTPParams h -> String
(Int -> TOTPParams h -> ShowS)
-> (TOTPParams h -> String)
-> ([TOTPParams h] -> ShowS)
-> Show (TOTPParams h)
forall h. Show h => Int -> TOTPParams h -> ShowS
forall h. Show h => [TOTPParams h] -> ShowS
forall h. Show h => TOTPParams h -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall h. Show h => Int -> TOTPParams h -> ShowS
showsPrec :: Int -> TOTPParams h -> ShowS
$cshow :: forall h. Show h => TOTPParams h -> String
show :: TOTPParams h -> String
$cshowList :: forall h. Show h => [TOTPParams h] -> ShowS
showList :: [TOTPParams h] -> ShowS
Show)

data ClockSkew = NoSkew | OneStep | TwoSteps | ThreeSteps | FourSteps
    deriving (Int -> ClockSkew
ClockSkew -> Int
ClockSkew -> [ClockSkew]
ClockSkew -> ClockSkew
ClockSkew -> ClockSkew -> [ClockSkew]
ClockSkew -> ClockSkew -> ClockSkew -> [ClockSkew]
(ClockSkew -> ClockSkew)
-> (ClockSkew -> ClockSkew)
-> (Int -> ClockSkew)
-> (ClockSkew -> Int)
-> (ClockSkew -> [ClockSkew])
-> (ClockSkew -> ClockSkew -> [ClockSkew])
-> (ClockSkew -> ClockSkew -> [ClockSkew])
-> (ClockSkew -> ClockSkew -> ClockSkew -> [ClockSkew])
-> Enum ClockSkew
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ClockSkew -> ClockSkew
succ :: ClockSkew -> ClockSkew
$cpred :: ClockSkew -> ClockSkew
pred :: ClockSkew -> ClockSkew
$ctoEnum :: Int -> ClockSkew
toEnum :: Int -> ClockSkew
$cfromEnum :: ClockSkew -> Int
fromEnum :: ClockSkew -> Int
$cenumFrom :: ClockSkew -> [ClockSkew]
enumFrom :: ClockSkew -> [ClockSkew]
$cenumFromThen :: ClockSkew -> ClockSkew -> [ClockSkew]
enumFromThen :: ClockSkew -> ClockSkew -> [ClockSkew]
$cenumFromTo :: ClockSkew -> ClockSkew -> [ClockSkew]
enumFromTo :: ClockSkew -> ClockSkew -> [ClockSkew]
$cenumFromThenTo :: ClockSkew -> ClockSkew -> ClockSkew -> [ClockSkew]
enumFromThenTo :: ClockSkew -> ClockSkew -> ClockSkew -> [ClockSkew]
Enum, Int -> ClockSkew -> ShowS
[ClockSkew] -> ShowS
ClockSkew -> String
(Int -> ClockSkew -> ShowS)
-> (ClockSkew -> String)
-> ([ClockSkew] -> ShowS)
-> Show ClockSkew
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClockSkew -> ShowS
showsPrec :: Int -> ClockSkew -> ShowS
$cshow :: ClockSkew -> String
show :: ClockSkew -> String
$cshowList :: [ClockSkew] -> ShowS
showList :: [ClockSkew] -> ShowS
Show)

-- | The default TOTP configuration.
defaultTOTPParams :: TOTPParams SHA1
defaultTOTPParams :: TOTPParams SHA1
defaultTOTPParams = SHA1
-> Word64 -> Word16 -> OTPDigits -> ClockSkew -> TOTPParams SHA1
forall h.
h -> Word64 -> Word16 -> OTPDigits -> ClockSkew -> TOTPParams h
TP SHA1
SHA1 Word64
0 Word16
30 OTPDigits
OTP6 ClockSkew
TwoSteps

-- | Create a TOTP configuration with customized parameters.
mkTOTPParams
    :: HashAlgorithm hash
    => hash
    -> OTPTime
    -- ^ The T0 parameter in seconds. This is the Unix time from which to start
    -- counting steps (default 0). Must be before the current time.
    -> Word16
    -- ^ The time step parameter X in seconds (default 30, maximum allowed 300)
    -> OTPDigits
    -- ^ Number of required digits in the OTP (default 6)
    -> ClockSkew
    -- ^ The number of time steps to check either side of the current value
    -- to allow for clock skew between client and server and or delay in
    -- submitting the value. The default is two time steps.
    -> Either String (TOTPParams hash)
mkTOTPParams :: forall hash.
HashAlgorithm hash =>
hash
-> Word64
-> Word16
-> OTPDigits
-> ClockSkew
-> Either String (TOTPParams hash)
mkTOTPParams hash
h Word64
t0 Word16
x OTPDigits
d ClockSkew
skew = do
    Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word16
x Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
> Word16
0) (String -> Either String ()
forall a b. a -> Either a b
Left String
"Time step must be greater than zero")
    Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word16
x Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word16
300) (String -> Either String ()
forall a b. a -> Either a b
Left String
"Time step cannot be greater than 300 seconds")
    Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
        (hash -> Int
forall a. HashAlgorithm a => a -> Int
hashDigestSize hash
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
minimumDigestSize)
        ( String -> Either String ()
forall a b. a -> Either a b
Left (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$
            String
"Hash digest must be at least "
                String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
minimumDigestSize
                String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" bytes"
        )
    TOTPParams hash -> Either String (TOTPParams hash)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (hash
-> Word64 -> Word16 -> OTPDigits -> ClockSkew -> TOTPParams hash
forall h.
h -> Word64 -> Word16 -> OTPDigits -> ClockSkew -> TOTPParams h
TP hash
h Word64
t0 Word16
x OTPDigits
d ClockSkew
skew)

-- | Calculate a totp value for the given time.
totp
    :: (HashAlgorithm hash, ByteArrayAccess key)
    => TOTPParams hash
    -> key
    -- ^ The shared secret
    -> OTPTime
    -- ^ The time for which the OTP should be calculated.
    -- This is usually the current time as returned by @Data.Time.Clock.POSIX.getPOSIXTime@
    -> OTP
totp :: forall hash key.
(HashAlgorithm hash, ByteArrayAccess key) =>
TOTPParams hash -> key -> Word64 -> Word32
totp (TP hash
h Word64
t0 Word16
x OTPDigits
d ClockSkew
_) key
k Word64
now = hash -> OTPDigits -> key -> Word64 -> Word32
forall hash key.
(HashAlgorithm hash, ByteArrayAccess key) =>
hash -> OTPDigits -> key -> Word64 -> Word32
hotp hash
h OTPDigits
d key
k (Word64 -> Word64 -> Word16 -> Word64
timeToCounter Word64
now Word64
t0 Word16
x)

-- | Check a supplied TOTP value is valid for the given time,
-- within the window defined by the skew parameter.
totpVerify
    :: (HashAlgorithm hash, ByteArrayAccess key)
    => TOTPParams hash
    -> key
    -> OTPTime
    -> OTP
    -> Bool
totpVerify :: forall hash key.
(HashAlgorithm hash, ByteArrayAccess key) =>
TOTPParams hash -> key -> Word64 -> Word32 -> Bool
totpVerify (TP hash
h Word64
t0 Word16
x OTPDigits
d ClockSkew
skew) key
k Word64
now Word32
otp = Word64
matched Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0
  where
    t :: Word64
t = Word64 -> Word64 -> Word16 -> Word64
timeToCounter Word64
now Word64
t0 Word16
x
    window :: Word64
window = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ClockSkew -> Int
forall a. Enum a => a -> Int
fromEnum ClockSkew
skew)
    range :: Word64 -> [Word64] -> [Word64]
range Word64
0 [Word64]
acc = Word64
t Word64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
: [Word64]
acc
    range Word64
n [Word64]
acc = Word64 -> [Word64] -> [Word64]
range (Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1) ((Word64
t Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
n) Word64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
: (Word64
t Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
n) Word64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
: [Word64]
acc)

    -- every candidate is compared, and none of the comparisons stops early, so
    -- neither which step matched nor how far a mismatch got is visible in how
    -- long this takes
    matched :: Word64
matched = (Word64 -> Word32 -> Word64) -> Word64 -> [Word32] -> Word64
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' Word64 -> Word32 -> Word64
step Word64
0 ((Word64 -> Word32) -> [Word64] -> [Word32]
forall a b. (a -> b) -> [a] -> [b]
map (hash -> OTPDigits -> key -> Word64 -> Word32
forall hash key.
(HashAlgorithm hash, ByteArrayAccess key) =>
hash -> OTPDigits -> key -> Word64 -> Word32
hotp hash
h OTPDigits
d key
k) (Word64 -> [Word64] -> [Word64]
range Word64
window []))
    step :: Word64 -> Word32 -> Word64
step Word64
acc Word32
candidate = Word64
acc Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word32 -> Word32 -> Word64
eqMask Word32
candidate Word32
otp

timeToCounter :: Word64 -> Word64 -> Word16 -> Word64
timeToCounter :: Word64 -> Word64 -> Word16 -> Word64
timeToCounter Word64
now Word64
t0 Word16
x = (Word64
now Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
t0) Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
x