    {-# 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
        , hotp
        , resynchronize
        , totp
        , totpVerify
        , TOTPParams
        , ClockSkew (..)
        , defaultTOTPParams
        , mkTOTPParams
        )
    where

    import           Data.Bits (shiftL, shiftR, (.&.), (.|.))
    import           Data.ByteArray.Mapping (fromW64BE)
    import           Data.List (elemIndex)
    import           Data.Word
    import           Foreign.Storable (poke)
    import           Control.Monad (unless)
    import           Crypto.Hash (HashAlgorithm, SHA1(..))
    import           Crypto.MAC.HMAC
    import           Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, Bytes)
    import qualified Crypto.Internal.ByteArray as B

    -- | 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 (Show)

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

    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 _ d k c = dt `mod` digitsPower d
      where
        mac = hmac k (fromW64BE c :: Bytes) :: HMAC hash
        offset = fromIntegral (B.index mac (B.length mac - 1) .&. 0xf)
        dt = (fromIntegral (B.index mac offset       .&. 0x7f) `shiftL` 24) .|.
             (fromIntegral (B.index mac (offset + 1) .&. 0xff) `shiftL` 16) .|.
             (fromIntegral (B.index mac (offset + 2) .&. 0xff) `shiftL`  8) .|.
             fromIntegral  (B.index mac (offset + 3) .&. 0xff)

    -- | Attempt to resynchronize the server's counter value
    -- with the client, given a sequence of HOTP values.
    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 h d s k c (p1, extras) = do
        offBy <- fmap fromIntegral (elemIndex p1 range)
        checkExtraOtps (c + offBy + 1) extras
      where
        checkExtraOtps ctr [] = Just ctr
        checkExtraOtps ctr (p:ps)
            | hotp h d k ctr /= p = Nothing
            | otherwise           = checkExtraOtps (ctr + 1) ps

        range = map (hotp h d k)[c..c + fromIntegral s]

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

    data TOTPParams h = TP !h !OTPTime !Word16 !OTPDigits !ClockSkew deriving (Show)

    data ClockSkew = NoSkew | OneStep | TwoSteps | ThreeSteps | FourSteps deriving (Enum, Show)

    -- | The default TOTP configuration.
    defaultTOTPParams :: TOTPParams SHA1
    defaultTOTPParams = TP SHA1 0 30 OTP6 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 h t0 x d skew = do
        unless (x > 0) (Left "Time step must be greater than zero")
        unless (x <= 300) (Left "Time step cannot be greater than 300 seconds")
        return (TP h t0 x d 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 (TP h t0 x d _) k now = hotp h d k (timeToCounter now t0 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 (TP h t0 x d skew) k now otp = otp `elem` map (hotp h d k) (range window [])
      where
        t = timeToCounter now t0 x
        window = fromIntegral (fromEnum skew)
        range 0 acc = t : acc
        range n acc = range (n-1) ((t-n) : (t+n) : acc)

    timeToCounter :: Word64 -> Word64 -> Word16 -> Word64
    timeToCounter now t0 x = (now - t0) `div` fromIntegral x