haskell/cryptonite
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge pull request #63 from tekul/otp

Browse Source 
[For Review] HOTP and TOTP implementation
This commit is contained in:
Vincent Hanquez 2017-01-29 20:09:29 +00:00 committed by GitHub
commit e76bbaa8a7
4 changed files with 286 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

179
Crypto/OTP.hs Normal file
View File

@ -0,0 +1,179 @@
{-# 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>
-- 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

4
cryptonite.cabal
View File

@ -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

102
tests/KAT_OTP.hs Normal file
View File

@ -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)
]
]
]

2
tests/Tests.hs
View File

@ -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