One-time password (OTP) implementation

Initial commit

- Implementation of HOTP algorithm as defined in RFC 4226
- Tests using values from the spec

Crypto/OTP.hs

@@ -0,0 +1,55 @@
+
+module Crypto.OTP where
+
+import           Data.Bits (shiftL, shiftR, (.&.), (.|.))
+import           Data.Word
+import           Foreign.Storable (pokeByteOff)
+import           Crypto.Hash (SHA1)
+import           Crypto.MAC.HMAC
+import           Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, Bytes)
+import qualified Crypto.Internal.ByteArray as B
+
+-- | 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
+
+hotp :: ByteArrayAccess key
+    => 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
+    -> Word32
+    -- ^ The HOTP value
+hotp d k c = dt `mod` digitsPower d
+  where
+    mac = hmac k (fromW64BE c :: Bytes) :: HMAC SHA1
+    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)
+
+
+digitsPower :: OTPDigits -> Word32
+digitsPower OTP4 = 10000
+digitsPower OTP5 = 100000
+digitsPower OTP6 = 1000000
+digitsPower OTP7 = 10000000
+digitsPower OTP8 = 100000000
+digitsPower OTP9 = 1000000000
+
+totp = undefined
+
+-- TODO: Put this in memory package
+fromW64BE :: (ByteArray ba) => Word64 -> ba
+fromW64BE n = B.allocAndFreeze 8 $ \p -> do
+    pokeByteOff p 0 (fromIntegral (shiftR n 56) :: Word8)
+    pokeByteOff p 1 (fromIntegral (shiftR n 48) :: Word8)
+    pokeByteOff p 2 (fromIntegral (shiftR n 40) :: Word8)
+    pokeByteOff p 3 (fromIntegral (shiftR n 32) :: Word8)
+    pokeByteOff p 4 (fromIntegral (shiftR n 24) :: Word8)
+    pokeByteOff p 5 (fromIntegral (shiftR n 16) :: Word8)
+    pokeByteOff p 6 (fromIntegral (shiftR n  8) :: Word8)
+    pokeByteOff p 7 (fromIntegral n             :: Word8)

cryptonite.cabal

@@ -107,6 +107,7 @@ Library
                      Crypto.Hash
                      Crypto.Hash.IO
                      Crypto.Hash.Algorithms
+                     Crypto.OTP
                      Crypto.PubKey.Curve25519
                      Crypto.PubKey.MaskGenFunction
                      Crypto.PubKey.DH
@@ -283,6 +284,7 @@ Test-Suite test-cryptonite
                      KAT_Ed25519
                      KAT_HMAC
                      KAT_PBKDF2
+                     KAT_OTP
                      KAT_PubKey.DSA
                      KAT_PubKey.ECC
                      KAT_PubKey.ECDSA

tests/KAT_OTP.hs

@@ -0,0 +1,41 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+
+module KAT_OTP
+    ( tests
+    )
+where
+
+import Crypto.OTP
+import Imports
+
+-- | Test values from Appendix D of http://tools.ietf.org/html/rfc4226
+hotpExpected :: [(Word64, Word32)]
+hotpExpected =
+    [ (0, 755224)
+    , (1, 287082)
+    , (3, 969429)
+    , (4, 338314)
+    , (5, 254676)
+    , (6, 287922)
+    , (7, 162583)
+    , (8, 399871)
+    , (9, 520489)
+    ]
+
+makeKATs = 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))
+        ]
+
+tests = testGroup "OTP"
+    [ testGroup "KATs" makeKATs
+    ]

tests/Tests.hs

@@ -14,6 +14,7 @@ import qualified KAT_HMAC
 import qualified KAT_PBKDF2
 import qualified KAT_Curve25519
 import qualified KAT_Ed25519
+import qualified KAT_OTP
 import qualified KAT_PubKey
 import qualified KAT_Scrypt
 -- symmetric cipher --------------------
@@ -38,6 +39,7 @@ tests = testGroup "cryptonite"
     , KAT_Curve25519.tests
     , KAT_Ed25519.tests
     , KAT_PubKey.tests
+    , KAT_OTP.tests
     , testGroup "KDF"
         [ KAT_PBKDF2.tests
         , KAT_Scrypt.tests