From c5b3622562f919b19a35cfc97b57dfc34c5fa4a9 Mon Sep 17 00:00:00 2001
From: Luke Taylor <tekul.hs@gmail.com>
Date: Sun, 20 Dec 2015 23:32:08 +0000
Subject: [PATCH] Add an OTP resynchronize function

Allows server to reset its counter to the client's current value, given
a sequence of one or more OTP values.
---
 Crypto/OTP.hs    | 29 +++++++++++++++++++++++++++++
 tests/KAT_OTP.hs | 11 +++++++++++
 2 files changed, 40 insertions(+)

diff --git a/Crypto/OTP.hs b/Crypto/OTP.hs
index 9035d86..af507f5 100644
--- a/Crypto/OTP.hs
+++ b/Crypto/OTP.hs
@@ -2,6 +2,7 @@
 module Crypto.OTP where
 
 import           Data.Bits (shiftL, shiftR, (.&.), (.|.))
+import           Data.List (elemIndex)
 import           Data.Word
 import           Foreign.Storable (pokeByteOff)
 import           Crypto.Hash (SHA1)
@@ -31,6 +32,34 @@ hotp d k c = dt `mod` digitsPower d
          (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 :: ByteArrayAccess key
+    => 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
+    -> key
+    -- ^ The shared secret
+    -> Word64
+    -- ^ The current server counter value
+    -> Word32
+    -- ^ The first OTP submitted by the client
+    -> [Word32]
+    -- ^ Additional sequential OTPs (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
+resynchronize 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
+
+    range = map (hotp d k)[c..c + fromIntegral s]
 
 digitsPower :: OTPDigits -> Word32
 digitsPower OTP4 = 10000
diff --git a/tests/KAT_OTP.hs b/tests/KAT_OTP.hs
index e397951..deba93e 100644
--- a/tests/KAT_OTP.hs
+++ b/tests/KAT_OTP.hs
@@ -7,6 +7,7 @@ module KAT_OTP
 where
 
 import Crypto.OTP
+import Data.ByteString (ByteString)
 import Imports
 
 -- | Test values from Appendix D of http://tools.ietf.org/html/rfc4226
@@ -36,6 +37,16 @@ makeKATs = concatMap makeTest (zip3 is counts hotps)
         [ testCase (show i) (assertEqual "" password (hotp OTP6 hotpKey count))
         ]
 
+-- 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)
+  where
+    key = "1234" :: ByteString
+    otp = hotp OTP6 key ctr
+
+
 tests = testGroup "OTP"
     [ testGroup "KATs" makeKATs
+    , testGroup "properties"
+        [ testProperty "resync-expected" prop_resyncExpected
+        ]
     ]