{-# LANGUAGE OverloadedStrings #-}

-- | Time-based One-Time Passwords (TOTP) with the HMAC-SHA-1, HMAC-SHA-256 and HMAC-SHA-512 algorithms.
--
-- They are single-use codes used for <https://en.wikipedia.org/wiki/Multi-factor_authentication 2-Factor Authentication>.
module OTP.TOTP
  ( -- ** Usage
    -- $usage
    OTP

    -- ** HMAC-SHA-1
  , newSHA1Key
  , totpSHA1
  , totpSHA1Check

    -- ** HMAC-SHA-256
  , newSHA256Key
  , totpSHA256
  , totpSHA256Check

    -- ** HMAC-SHA-512
  , newSHA512Key
  , totpSHA512
  , totpSHA512Check

    -- ** URI Generation
  , totpToURI
  ) where

import Chronos (Time (..), Timespan (..), asSeconds)
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Display (display)
import Data.Word (Word64)
import Network.URI (escapeURIString, isUnescapedInURI)
import Sel.HMAC.SHA256 qualified as SHA256
import Sel.HMAC.SHA512 qualified as SHA512

import OTP.Commons
  ( Algorithm
  , Digits
  , OTP
  , totpCounter
  , totpCounterRange
  )
import OTP.HOTP
  ( hotpSHA1
  , hotpSHA256
  , hotpSHA512
  , newSHA1Key
  , newSHA256Key
  , newSHA512Key
  )

-- $usage
--
-- > import Chronos (Timespan, now, second)
-- > import Data.ByteString.Base32 qualified as Base32
-- > import Data.Maybe (fromJust)
-- > import Data.Text (Text)
-- > import OTP.Commons
-- > import OTP.TOTP
-- > import Sel.HMAC.SHA256 qualified as HMAC
-- > import Torsor (scale)
-- >
-- > period :: Timespan
-- > period = scale 30 second
-- >
-- > sixDigits :: Digits
-- > sixDigits = fromJust $ mkDigits 6
-- >
-- > uriFromKey :: Text -> Text -> HMAC.AuthenticationKey -> Text
-- > uriFromKey domain email key =
-- >  let
-- >    issuer = "your-domain"
-- >   in
-- >    totpToURI
-- >      (Base32.encodeBase32Unpadded $ HMAC.unsafeAuthenticationKeyToBinary key)
-- >      email
-- >      issuer
-- >      sixDigits
-- >      period
-- >      HMAC_SHA1
-- >
-- > validateTOTP :: HMAC.AuthenticationKey -> Text -> IO Bool
-- > validateTOTP key code = do
-- >  timestamp <- now
-- >  pure $
-- >    totpSHA1Check
-- >      key
-- >      (1, 1)
-- >      timestamp
-- >      period
-- >      sixDigits
-- >      code

-- | Compute a Time-based One-Time Password using secret key and time.
--
-- @since 3.0.0.0
totpSHA1
  :: SHA256.AuthenticationKey
  -- ^ Shared secret
  -> Time
  -- ^ Time of TOTP
  -> Timespan
  -- ^ Time range in seconds
  -> Digits
  -- ^ Number of digits in a password
  -> OTP
  -- ^ TOTP
totpSHA1 :: AuthenticationKey -> Time -> Timespan -> Digits -> OTP
totpSHA1 AuthenticationKey
secret Time
time Timespan
period = AuthenticationKey -> Word64 -> Digits -> OTP
hotpSHA1 AuthenticationKey
secret (Time -> Timespan -> Word64
totpCounter Time
time Timespan
period)

-- | Compute a Time-based One-Time Password using secret key and time.
--
-- @since 3.0.0.0
totpSHA256
  :: SHA256.AuthenticationKey
  -- ^ Shared secret
  -> Time
  -- ^ Time of TOTP
  -> Timespan
  -- ^ Time range in seconds
  -> Digits
  -- ^ Number of digits in a password
  -> OTP
  -- ^ TOTP
totpSHA256 :: AuthenticationKey -> Time -> Timespan -> Digits -> OTP
totpSHA256 AuthenticationKey
secret Time
time Timespan
period = AuthenticationKey -> Word64 -> Digits -> OTP
hotpSHA256 AuthenticationKey
secret (Time -> Timespan -> Word64
totpCounter Time
time Timespan
period)

-- | Compute a Time-based One-Time Password using secret key and time.
--
-- @since 3.0.0.0
totpSHA512
  :: SHA512.AuthenticationKey
  -- ^ Shared secret
  -> Time
  -- ^ Time of TOTP
  -> Timespan
  -- ^ Time range in seconds
  -> Digits
  -- ^ Number of digits in a password
  -> OTP
  -- ^ TOTP
totpSHA512 :: AuthenticationKey -> Time -> Timespan -> Digits -> OTP
totpSHA512 AuthenticationKey
secret Time
time Timespan
period = AuthenticationKey -> Word64 -> Digits -> OTP
hotpSHA512 AuthenticationKey
secret (Time -> Timespan -> Word64
totpCounter Time
time Timespan
period)

-- | Check presented password against time periods.
--
-- @since 3.0.0.0
totpSHA1Check
  :: SHA256.AuthenticationKey
  -- ^ Shared secret
  -> (Word64, Word64)
  -- ^ Valid counter range, before and after ideal
  -> Time
  -- ^ Time of TOTP
  -> Timespan
  -- ^ Time range in seconds
  -> Digits
  -- ^ Numer of digits in a password
  -> Text
  -- ^ Password given by user
  -> Bool
  -- ^ True if password is valid
totpSHA1Check :: AuthenticationKey
-> (Word64, Word64) -> Time -> Timespan -> Digits -> Text -> Bool
totpSHA1Check AuthenticationKey
secret (Word64, Word64)
range Time
time Timespan
period Digits
digits Text
pass =
  let counters :: [Word64]
counters = (Word64, Word64) -> Time -> Timespan -> [Word64]
totpCounterRange (Word64, Word64)
range Time
time Timespan
period
      passwords :: [Text]
passwords = (Word64 -> Text) -> [Word64] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Word64
c -> OTP -> Text
forall a. Display a => a -> Text
display (OTP -> Text) -> OTP -> Text
forall a b. (a -> b) -> a -> b
$ AuthenticationKey -> Word64 -> Digits -> OTP
hotpSHA1 AuthenticationKey
secret Word64
c Digits
digits) [Word64]
counters
   in Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Text
pass [Text]
passwords

-- | Check presented password against time periods.
--
-- @since 3.0.0.0
totpSHA256Check
  :: SHA256.AuthenticationKey
  -- ^ Shared secret
  -> (Word64, Word64)
  -- ^ Valid counter range, before and after ideal
  -> Time
  -- ^ Time of TOTP
  -> Timespan
  -- ^ Time range in seconds
  -> Digits
  -- ^ Numer of digits in a password
  -> Text
  -- ^ Password given by user
  -> Bool
  -- ^ True if password is valid
totpSHA256Check :: AuthenticationKey
-> (Word64, Word64) -> Time -> Timespan -> Digits -> Text -> Bool
totpSHA256Check AuthenticationKey
secret (Word64, Word64)
range Time
time Timespan
period Digits
digits Text
pass =
  let counters :: [Word64]
counters = (Word64, Word64) -> Time -> Timespan -> [Word64]
totpCounterRange (Word64, Word64)
range Time
time Timespan
period
      passwords :: [Text]
passwords = (Word64 -> Text) -> [Word64] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Word64
c -> OTP -> Text
forall a. Display a => a -> Text
display (OTP -> Text) -> OTP -> Text
forall a b. (a -> b) -> a -> b
$ AuthenticationKey -> Word64 -> Digits -> OTP
hotpSHA256 AuthenticationKey
secret Word64
c Digits
digits) [Word64]
counters
   in Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Text
pass [Text]
passwords

-- | Check presented password against time periods.
--
-- @since 3.0.0.0
totpSHA512Check
  :: SHA512.AuthenticationKey
  -- ^ Shared secret
  -> (Word64, Word64)
  -- ^ Valid counter range, before and after ideal
  -> Time
  -- ^ Time of TOTP
  -> Timespan
  -- ^ Time range in seconds
  -> Digits
  -- ^ Numer of digits in a password
  -> Text
  -- ^ Password given by user
  -> Bool
  -- ^ True if password is valid
totpSHA512Check :: AuthenticationKey
-> (Word64, Word64) -> Time -> Timespan -> Digits -> Text -> Bool
totpSHA512Check AuthenticationKey
secret (Word64, Word64)
range Time
time Timespan
period Digits
digits Text
pass =
  let counters :: [Word64]
counters = (Word64, Word64) -> Time -> Timespan -> [Word64]
totpCounterRange (Word64, Word64)
range Time
time Timespan
period
      passwords :: [Text]
passwords = (Word64 -> Text) -> [Word64] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Word64
c -> OTP -> Text
forall a. Display a => a -> Text
display (OTP -> Text) -> OTP -> Text
forall a b. (a -> b) -> a -> b
$ AuthenticationKey -> Word64 -> Digits -> OTP
hotpSHA512 AuthenticationKey
secret Word64
c Digits
digits) [Word64]
counters
   in Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Text
pass [Text]
passwords

-- | Create a URI suitable for authenticators.
--
-- The result of this function is best given to a QR Code generator for end-users to scan.
--
-- @since 3.0.0.0
totpToURI
  :: Text
  -- ^ Shared secret key. Must be encoded in base32.
  -> Text
  -- ^ Name of the account (usually an email address)
  -> Text
  -- ^ Issuer
  -> Digits
  -- ^ Amount of digits expected from the end-user
  -> Timespan
  -- ^ Amount of time before the generated code expires
  -> Algorithm
  -- ^ Algorithm required
  -> Text
totpToURI :: Text -> Text -> Text -> Digits -> Timespan -> Algorithm -> Text
totpToURI Text
secret Text
account Text
issuer Digits
digits Timespan
period Algorithm
algorithm =
  String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
    (Char -> Bool) -> String -> String
escapeURIString Char -> Bool
isUnescapedInURI (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
      Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
        Text
"otpauth://totp/"
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
issuer
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
account
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"?secret="
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
secret
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"&issuer="
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
issuer
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"&digits="
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Digits -> Text
forall a. Display a => a -> Text
display Digits
digits
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"&algorithm="
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Algorithm -> Text
forall a. Display a => a -> Text
display Algorithm
algorithm
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"&period="
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int64 -> Text
forall a. Display a => a -> Text
display (Timespan -> Int64
asSeconds Timespan
period)