From 0be97fc5ca650f85a6df2f0b38b08bac40680be2 Mon Sep 17 00:00:00 2001
From: Luke Taylor <tekul.hs@gmail.com>
Date: Mon, 4 Jan 2016 19:04:38 +0000
Subject: [PATCH] Add hash parameter to hotp function

While HOTP only mentions SHA1, TOTP allows the use of different hash
functions, which implicitly requires that the HOTP implementation support
them too.

This will also allow users to use HOTP with another hash if they so choose,
though it would not be compatible with most client applications, such as
Google authenticator.
---
 Crypto/OTP.hs    | 25 ++++++++++++++-----------
 tests/KAT_OTP.hs |  6 +++---
 2 files changed, 17 insertions(+), 14 deletions(-)

diff --git a/Crypto/OTP.hs b/Crypto/OTP.hs
index ceb38fb..94d6ca7 100644
--- a/Crypto/OTP.hs
+++ b/Crypto/OTP.hs
@@ -1,3 +1,4 @@
+{-# 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>
@@ -36,8 +37,9 @@ import qualified Crypto.Internal.ByteArray as B
 -- the number of digits (between 4 and 9) in the extracted value.
 data OTPDigits = OTP4 | OTP5 | OTP6 | OTP7 | OTP8 | OTP9
 
-hotp :: ByteArrayAccess key
-    => OTPDigits
+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
@@ -45,9 +47,9 @@ hotp :: ByteArrayAccess key
     -- ^ Counter value synchronized between the client and server
     -> Word32
     -- ^ The HOTP value
-hotp d k c = dt `mod` digitsPower d
+hotp _ d k c = dt `mod` digitsPower d
   where
-    mac = hmac k (fromW64BE c :: Bytes) :: HMAC SHA1
+    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) .|.
@@ -56,8 +58,9 @@ hotp d k c = dt `mod` digitsPower d
 
 -- | Attempt to resynchronize the server's counter value
 -- with the client, given a sequence of HOTP values.
-resynchronize :: ByteArrayAccess key
-    => OTPDigits
+resynchronize :: (HashAlgorithm hash, ByteArrayAccess key)
+    => hash
+    -> OTPDigits
     -> Word32
     -- ^ The look-ahead window parameter. Up to this many values will
     -- be calculated and checked against the value(s) submitted by the client
@@ -71,16 +74,16 @@ resynchronize :: ByteArrayAccess key
     -> 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 d s k c (p1, extras) = do
+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 d k ctr /= p = Nothing
-        | otherwise         = checkExtraOtps (ctr + 1) ps
+        | hotp h d k ctr /= p = Nothing
+        | otherwise           = checkExtraOtps (ctr + 1) ps
 
-    range = map (hotp d k)[c..c + fromIntegral s]
+    range = map (hotp h d k)[c..c + fromIntegral s]
 
 digitsPower :: OTPDigits -> Word32
 digitsPower OTP4 = 10000
@@ -120,7 +123,7 @@ totp :: (HashAlgorithm hash, ByteArrayAccess key)
     -- This is usually the current time as returned by @Data.Time.Clock.POSIX.getPOSIXTime@
     -> Word32
     -- ^ The OTP value
-totp (TP h t0 x d) k now = hotp d k t
+totp (TP h t0 x d) k now = hotp h d k t
   where
     t = floor ((now - fromIntegral t0) / fromIntegral x)
 
diff --git a/tests/KAT_OTP.hs b/tests/KAT_OTP.hs
index 5033279..c7f2b5d 100644
--- a/tests/KAT_OTP.hs
+++ b/tests/KAT_OTP.hs
@@ -46,7 +46,7 @@ makeHOTPKATs = concatMap makeTest (zip3 is counts hotps)
     hotps  = map snd hotpExpected
 
     makeTest (i, count, password) =
-        [ testCase (show i) (assertEqual "" password (hotp OTP6 otpKey count))
+        [ testCase (show i) (assertEqual "" password (hotp SHA1 OTP6 otpKey count))
         ]
 
 makeTOTPKATs = concatMap makeTest (zip3 is times otps)
@@ -63,10 +63,10 @@ makeTOTPKATs = concatMap makeTest (zip3 is times otps)
         ]
 
 -- resynching with the expected value should just return the current counter + 1
-prop_resyncExpected ctr window = resynchronize OTP6 window key ctr (otp, []) == Just (ctr + 1)
+prop_resyncExpected ctr window = resynchronize SHA1 OTP6 window key ctr (otp, []) == Just (ctr + 1)
   where
     key = "1234" :: ByteString
-    otp = hotp OTP6 key ctr
+    otp = hotp SHA1 OTP6 key ctr
 
 
 tests = testGroup "OTP"