diff --git a/Crypto/OTP.hs b/Crypto/OTP.hs new file mode 100644 index 0000000..71c1e74 --- /dev/null +++ b/Crypto/OTP.hs @@ -0,0 +1,179 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +-- | One-time password implementation as defined by the +-- and +-- specifications. +-- +-- Both implementations use a shared key between the client and the server. HOTP passwords +-- are based on a synchronized counter. TOTP passwords use the same approach but calculate +-- the counter as a number of time steps from the Unix epoch to the current time, thus +-- requiring that both client and server have synchronized clocks. +-- +-- Probably the best-known use of TOTP is in Google's 2-factor authentication. +-- +-- The TOTP API doesn't depend on any particular time package, so the user needs to supply +-- the current @OTPTime@ value, based on the system time. For example, using the @hourglass@ +-- package, you could create a @getOTPTime@ function: +-- +-- >>> import Time.System +-- >>> import Time.Types +-- >>> +-- >>> let getOTPTime = timeCurrent >>= \(Elapsed t) -> return (fromIntegral t :: OTPTime) +-- +-- Or if you prefer, the @time@ package could be used: +-- +-- >>> import Data.Time.Clock.POSIX +-- >>> +-- >>> let getOTPTime = getPOSIXTime >>= \t -> return (floor t :: OTPTime) +-- + +module Crypto.OTP + ( OTP + , OTPDigits (..) + , OTPTime + , hotp + , resynchronize + , totp + , totpVerify + , TOTPParams + , ClockSkew (..) + , defaultTOTPParams + , mkTOTPParams + ) +where + +import Data.Bits (shiftL, shiftR, (.&.), (.|.)) +import Data.ByteArray.Mapping (fromW64BE) +import Data.List (elemIndex) +import Data.Word +import Foreign.Storable (poke) +import Control.Monad (unless) +import Crypto.Hash (HashAlgorithm, SHA1(..)) +import Crypto.MAC.HMAC +import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, Bytes) +import qualified Crypto.Internal.ByteArray as B + + +-- | A one-time password which is a sequence of 4 to 9 digits. +type OTP = Word32 + +-- | 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 deriving (Show) + +-- | An integral time value in seconds. +type OTPTime = Word64 + +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 + -> Word64 + -- ^ Counter value synchronized between the client and server + -> OTP + -- ^ The HOTP value +hotp _ d k c = dt `mod` digitsPower d + where + 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) .|. + (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 :: (HashAlgorithm hash, ByteArrayAccess key) + => hash + -> OTPDigits + -> Word16 + -- ^ 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 + -> (OTP, [OTP]) + -- ^ The first OTP submitted by the client and a list of additional + -- sequential OTPs (which 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 anywhere within the window +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 h d k ctr /= p = Nothing + | otherwise = checkExtraOtps (ctr + 1) ps + + range = map (hotp h d k)[c..c + fromIntegral s] + +digitsPower :: OTPDigits -> Word32 +digitsPower OTP4 = 10000 +digitsPower OTP5 = 100000 +digitsPower OTP6 = 1000000 +digitsPower OTP7 = 10000000 +digitsPower OTP8 = 100000000 +digitsPower OTP9 = 1000000000 + + +data TOTPParams h = TP !h !OTPTime !Word16 !OTPDigits !ClockSkew deriving (Show) + +data ClockSkew = NoSkew | OneStep | TwoSteps | ThreeSteps | FourSteps deriving (Enum, Show) + +-- | The default TOTP configuration. +defaultTOTPParams :: TOTPParams SHA1 +defaultTOTPParams = TP SHA1 0 30 OTP6 TwoSteps + +-- | Create a TOTP configuration with customized parameters. +mkTOTPParams :: (HashAlgorithm hash) + => hash + -> OTPTime + -- ^ The T0 parameter in seconds. This is the Unix time from which to start + -- counting steps (default 0). Must be before the current time. + -> Word16 + -- ^ The time step parameter X in seconds (default 30, maximum allowed 300) + -> OTPDigits + -- ^ Number of required digits in the OTP (default 6) + -> ClockSkew + -- ^ The number of time steps to check either side of the current value + -- to allow for clock skew between client and server and or delay in + -- submitting the value. The default is two time steps. + -> Either String (TOTPParams hash) +mkTOTPParams h t0 x d skew = do + unless (x > 0) (Left "Time step must be greater than zero") + unless (x <= 300) (Left "Time step cannot be greater than 300 seconds") + return (TP h t0 x d skew) + +-- | Calculate a totp value for the given time. +totp :: (HashAlgorithm hash, ByteArrayAccess key) + => TOTPParams hash + -> key + -- ^ The shared secret + -> OTPTime + -- ^ The time for which the OTP should be calculated. + -- This is usually the current time as returned by @Data.Time.Clock.POSIX.getPOSIXTime@ + -> OTP +totp (TP h t0 x d _) k now = hotp h d k (timeToCounter now t0 x) + +-- | Check a supplied TOTP value is valid for the given time, +-- within the window defined by the skew parameter. +totpVerify :: (HashAlgorithm hash, ByteArrayAccess key) + => TOTPParams hash + -> key + -> OTPTime + -> OTP + -> Bool +totpVerify (TP h t0 x d skew) k now otp = otp `elem` map (hotp h d k) (range window []) + where + t = timeToCounter now t0 x + window = fromIntegral (fromEnum skew) + range 0 acc = t : acc + range n acc = range (n-1) ((t-n) : (t+n) : acc) + +timeToCounter :: Word64 -> Word64 -> Word16 -> Word64 +timeToCounter now t0 x = (now - t0) `div` fromIntegral x diff --git a/cryptonite.cabal b/cryptonite.cabal index 2d1d020..5c0b2f4 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -125,6 +125,7 @@ Library Crypto.Hash Crypto.Hash.IO Crypto.Hash.Algorithms + Crypto.OTP Crypto.PubKey.Curve25519 Crypto.PubKey.Curve448 Crypto.PubKey.MaskGenFunction @@ -204,7 +205,7 @@ Library Crypto.Internal.WordArray Build-depends: base >= 4.3 && < 5 , bytestring - , memory >= 0.8 + , memory >= 0.12 , ghc-prim ghc-options: -Wall -fwarn-tabs -optc-O3 -fno-warn-unused-imports default-language: Haskell2010 @@ -333,6 +334,7 @@ Test-Suite test-cryptonite KAT_HMAC KAT_MiyaguchiPreneel KAT_PBKDF2 + KAT_OTP KAT_PubKey.DSA KAT_PubKey.ECC KAT_PubKey.ECDSA diff --git a/tests/KAT_OTP.hs b/tests/KAT_OTP.hs new file mode 100644 index 0000000..d4d946f --- /dev/null +++ b/tests/KAT_OTP.hs @@ -0,0 +1,102 @@ +{-# LANGUAGE OverloadedStrings #-} + + +module KAT_OTP + ( tests + ) +where + +import Crypto.Hash.Algorithms (SHA1(..), SHA256(..), SHA512(..)) +import Crypto.OTP +import Data.ByteString (ByteString) +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) + ] + +-- | Test data from Appendix B of http://tools.ietf.org/html/rfc6238 +-- Note that the shared keys for the non SHA-1 values are actually +-- different (see the errata, or the Java example code). +totpSHA1Expected :: [(Word64, Word32)] +totpSHA1Expected = + [ (59 , 94287082) + , (1111111109, 07081804) + , (1111111111, 14050471) + , (1234567890, 89005924) + , (2000000000, 69279037) + , (20000000000, 65353130) + ] + +totpSHA256Expected :: [(Word64, Word32)] +totpSHA256Expected = + [ (59 , 46119246) + , (1111111109, 68084774) + , (1111111111, 67062674) + , (1234567890, 91819424) + , (2000000000, 90698825) + , (20000000000, 77737706) + ] + +totpSHA512Expected :: [(Word64, Word32)] +totpSHA512Expected = + [ (59 , 90693936) + , (1111111109, 25091201) + , (1111111111, 99943326) + , (1234567890, 93441116) + , (2000000000, 38618901) + , (20000000000, 47863826) + ] + +otpKey = "12345678901234567890" :: ByteString +totpSHA256Key = "12345678901234567890123456789012" :: ByteString +totpSHA512Key = "1234567890123456789012345678901234567890123456789012345678901234" :: ByteString + +makeKATs otp expected = concatMap (makeTest otp) (zip3 is counts otps) + where + is :: [Int] + is = [1..] + + counts = map fst expected + otps = map snd expected + +makeTest otp (i, count, password) = + [ testCase (show i) (assertEqual "" password (otp count)) + ] + +Right totpSHA1Params = mkTOTPParams SHA1 0 30 OTP8 TwoSteps +Right totpSHA256Params = mkTOTPParams SHA256 0 30 OTP8 TwoSteps +Right totpSHA512Params = mkTOTPParams SHA512 0 30 OTP8 TwoSteps + +-- resynching with the expected value should just return the current counter + 1 +prop_resyncExpected ctr window = resynchronize SHA1 OTP6 window key ctr (otp, []) == Just (ctr + 1) + where + key = "1234" :: ByteString + otp = hotp SHA1 OTP6 key ctr + + +tests = testGroup "OTP" + [ testGroup "HOTP" + [ testGroup "KATs" (makeKATs (hotp SHA1 OTP6 otpKey) hotpExpected) + , testGroup "properties" + [ testProperty "resync-expected" prop_resyncExpected + ] + ] + , testGroup "TOTP" + [ testGroup "KATs" + [ testGroup "SHA1" (makeKATs (totp totpSHA1Params otpKey . fromIntegral) totpSHA1Expected) + , testGroup "SHA256" (makeKATs (totp totpSHA256Params totpSHA256Key . fromIntegral) totpSHA256Expected) + , testGroup "SHA512" (makeKATs (totp totpSHA512Params totpSHA512Key . fromIntegral) totpSHA512Expected) + ] + ] + ] diff --git a/tests/Tests.hs b/tests/Tests.hs index 5db110b..37aad17 100644 --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -20,6 +20,7 @@ import qualified KAT_PBKDF2 import qualified KAT_Curve25519 import qualified KAT_Curve448 import qualified KAT_Ed25519 +import qualified KAT_OTP import qualified KAT_PubKey import qualified KAT_Scrypt -- symmetric cipher -------------------- @@ -50,6 +51,7 @@ tests = testGroup "cryptonite" , KAT_Curve448.tests , KAT_Ed25519.tests , KAT_PubKey.tests + , KAT_OTP.tests , testGroup "KDF" [ KAT_PBKDF2.tests , KAT_Scrypt.tests