Add TOTP function and KATs

Just uses SHA1 for now. HashAlgorithm is ignored.

Crypto/OTP.hs

@@ -1,11 +1,18 @@
 
-module Crypto.OTP where
+module Crypto.OTP
+    ( hotp
+    , OTPDigits (..)
+    , resynchronize
+    , totp
+    )
+where
 
 import           Data.Bits (shiftL, shiftR, (.&.), (.|.))
+import           Data.Time.Clock.POSIX
 import           Data.List (elemIndex)
 import           Data.Word
 import           Foreign.Storable (pokeByteOff)
-import           Crypto.Hash (SHA1)
+import           Crypto.Hash (HashAlgorithm, SHA1)
 import           Crypto.MAC.HMAC
 import           Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, Bytes)
 import qualified Crypto.Internal.ByteArray as B
@@ -68,7 +75,25 @@ digitsPower OTP7 = 10000000
 digitsPower OTP8 = 100000000
 digitsPower OTP9 = 1000000000
 
-totp = undefined
+
+totp :: (HashAlgorithm hash, ByteArrayAccess key)
+    => hash
+    -> Word32
+    -- ^ The time step parameter X
+    -> Word64
+    -- ^ The T0 parameter in seconds. This is the Unix time from which to start
+    -- counting steps (usually zero)
+    -> OTPDigits
+    -> key
+    -- ^ The shared secret
+    -> POSIXTime
+    -- ^ The time for which the OTP should be calculated.
+    -- This is usually the current time as returned by @Data.Time.Clock.POSIX.getPOSIXTime@
+    -> Word32
+    -- ^ The OTP value
+totp h x t0 d k now = hotp d k t
+  where
+    t = floor ((now - fromIntegral t0) / fromIntegral x)
 
 -- TODO: Put this in memory package
 fromW64BE :: (ByteArray ba) => Word64 -> ba

cryptonite.cabal

@@ -178,6 +178,7 @@ Library
                    , bytestring
                    , memory >= 0.8
                    , ghc-prim
+                   , time
   ghc-options:       -Wall -fwarn-tabs -optc-O3 -fno-warn-unused-imports
   default-language:  Haskell2010
   cc-options:        -std=gnu99

tests/KAT_OTP.hs

@@ -6,6 +6,7 @@ module KAT_OTP
     )
 where
 
+import Crypto.Hash.Algorithms (SHA1(..))
 import Crypto.OTP
 import Data.ByteString (ByteString)
 import Imports
@@ -24,17 +25,40 @@ hotpExpected =
     , (9, 520489)
     ]
 
-makeKATs = concatMap makeTest (zip3 is counts hotps)
+totpExpected :: [(Word64, Word32)]
+totpExpected =
+    [ (59        , 94287082)
+    , (1111111109, 07081804)
+    , (1111111111, 14050471)
+    , (1234567890, 89005924)
+    , (2000000000, 69279037)
+    , (20000000000, 65353130)
+    ]
+
+otpKey = "12345678901234567890" :: ByteString
+
+makeHOTPKATs = concatMap makeTest (zip3 is counts hotps)
   where
     is :: [Int]
     is = [1..]
-    hotpKey = "12345678901234567890" :: ByteString
 
     counts = map fst hotpExpected
     hotps  = map snd hotpExpected
 
     makeTest (i, count, password) =
-        [ testCase (show i) (assertEqual "" password (hotp OTP6 hotpKey count))
+        [ testCase (show i) (assertEqual "" password (hotp OTP6 otpKey count))
+        ]
+
+makeTOTPKATs = concatMap makeTest (zip3 is times otps)
+  where
+    is :: [Int]
+    is = [1..]
+
+    times = map fst totpExpected
+    otps  = map snd totpExpected
+
+    makeTest (i, now, password) =
+        [ testCase (show i) (assertEqual "" password (totp SHA1 30 0 OTP8 otpKey (fromIntegral now)))
         ]
 
 -- resynching with the expected value should just return the current counter + 1
@@ -45,8 +69,13 @@ prop_resyncExpected ctr window = resynchronize OTP6 window key ctr (otp, []) ==
 
 
 tests = testGroup "OTP"
-    [ testGroup "KATs" makeKATs
+    [ testGroup "HOTP"
-    , testGroup "properties"
+        [ testGroup "KATs" makeHOTPKATs
-        [ testProperty "resync-expected" prop_resyncExpected
+        , testGroup "properties"
+            [ testProperty "resync-expected" prop_resyncExpected
+            ]
+        ]
+    , testGroup "TOTP"
+        [ testGroup "KATs" makeTOTPKATs
         ]
     ]