diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,9 @@ +## 0.1.0.0 + +* Major API rewrite ([#3](https://github.com/hvr/OTP/pull/3)) +* Add support for SHA256 and SHA512 besides SHA-1 ([#1](https://github.com/hvr/OTP/pull/1)) +* Provide support via cabal flag for using pure Haskell [SHA](http://hackage.haskell.org/package/SHA) implementation + +## 0.0.0.1 + +Initial version of `OTP` diff --git a/Data/OTP.hs b/Data/OTP.hs deleted file mode 100644 --- a/Data/OTP.hs +++ /dev/null @@ -1,39 +0,0 @@ --- |Implements HMAC-Based One-Time Password Algorithm as defined in RFC 4226 and --- Time-Based One-Time Password Algorithm as defined in RFC 6238. -module Data.OTP (hotp, totp) where - -import Codec.Utils -import Data.Bits -import Data.HMAC -import Data.Time.Clock -import Data.Time.Clock.POSIX - --- | Compute an HOTP using secret key and counter value. -hotp - :: [Octet] -- ^ Secret key - -> Int -- ^ Counter value - -> Int -- ^ Number of digits in password - -> Int -- ^ HOTP -hotp key count digit' = truncate_hotp (hmac_sha1 key count') digit' - where truncate_hotp hmac_result digit' = snum `mod` (10 ^ digit') - where snum = fromTwosComp sbits - sbits = dt hmac_result - dt hmac_r = [(head p) .&. 0x7F] ++ (tail p) - where offsetBits = (hmacr !! 19) .&. 0xF - offset = fromTwosComp [offsetBits] - p = take 4 (drop offset hmacr) - hmacr = pad hmac_r - where pad xs = if length xs < 20 then pad (0 : xs) else xs - count' = pad (toTwosComp count) - where pad xs = if length xs < 8 then pad (0 : xs) else xs - --- | Compute an TOTP using secret key and time. -totp - :: [Octet] -- ^ Secret key - -> UTCTime -- ^ Time - -> Int -- ^ Number of digits in password - -> Int -- ^ Period - -> Int -- ^ TOTP -totp key time digit' period = hotp key timeCounter digit' - where timePOSIX = utcTimeToPOSIXSeconds time - timeCounter = (floor timePOSIX) `div` period diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,18 +1,20 @@ -Copyright (c) 2012 Artem Leshchev - -Permission is hereby granted, free of charge, to any person obtaining a copy -of this software and associated documentation files (the "Software"), to deal -in the Software without restriction, including without limitation the rights -to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies -of the Software, and to permit persons to whom the Software is furnished -to do so, subject to the following conditions: - -The above copyright notice and this permission notice shall be included -in all copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS -FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR -COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER -IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR +Copyright (c) 2012 Artem Leshchev + 2016 Aleksey Uimanov, + 2018 Herbert Valerio Riedel + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies +of the Software, and to permit persons to whom the Software is furnished +to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS +FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR +COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER +IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/OTP.cabal b/OTP.cabal --- a/OTP.cabal +++ b/OTP.cabal @@ -1,35 +1,85 @@ -name: OTP --- PVP summary: +-+------- breaking API changes --- | | +----- non-breaking API additions --- | | | +--- code changes with no API change -version: 0.0.0.1 -synopsis: HMAC-Based and Time-Based One-Time Passwords -description: Implements HMAC-Based One-Time Password Algorithm as defined in RFC 4226 and Time-Based One-Time Password Algorithm as defined in RFC 6238. -license: MIT -license-file: LICENSE -copyright: (c) 2012 Artem Leshchev -author: Artem Leshchev -maintainer: matshch@gmail.com -homepage: https://github.com/matshch/OTP -bug-reports: https://github.com/matshch/OTP/issues -category: Cryptography -build-type: Simple -cabal-version: >=1.8 - -library - exposed-modules: Data.OTP - build-depends: base >= 3 && < 5, Crypto >= 4, time >= 1.1 - -Test-Suite tests - type: exitcode-stdio-1.0 - main-is: Test/opt.hs - build-depends: base >= 3 && < 5, Crypto >= 4, time >= 1.1 - -source-repository head - type: git - location: git://github.com/matshch/OTP.git - -source-repository this - type: git - location: git://github.com/matshch/OTP.git - tag: v0.0.0.1 +cabal-version: 1.12 +name: OTP +version: 0.1.0.0 +synopsis: HMAC-Based and Time-Based One-Time Passwords (HOTP & TOTP) + +description: Implements the /HMAC-Based One-Time Password Algorithm/ (HOTP) as + defined in [RFC 4226](https://tools.ietf.org/html/rfc4226) + and the /Time-Based One-Time Password Algorithm/ (TOTP) as defined + in [RFC 6238](https://tools.ietf.org/html/rfc6238). + . + The TOTP and HOTP algorithms are commonly used to implement two-step verification (2FA) + (e.g. by [Google Authenticator](https://en.wikipedia.org/wiki/Google_Authenticator) ). + . + See module "Data.OTP" for API documentation. + +license: MIT +license-file: LICENSE +copyright: 2012 Artem Leshchev, + 2016 Aleksey Uimanov, + 2018 Herbert Valerio Riedel +author: Artem Leshchev, + Aleksey Uimanov, + Herbert Valerio Riedel +maintainer: hvr@gnu.org +homepage: https://github.com/hvr/OTP +bug-reports: https://github.com/hvr/OTP/issues +category: Cryptography +build-type: Simple +tested-with: GHC==8.4.3, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2 + +extra-source-files: + CHANGELOG.md + README.md + +source-repository head + type: git + location: https://github.com/hvr/OTP.git + +flag pure-sha + manual: True + default: False + description: Use pure Haskell [SHA](http://hackage.haskell.org/package/SHA) implementation instead of @cryptohash-sha1\/256\/512@ + +library + hs-source-dirs: src + exposed-modules: Data.OTP + other-modules: HashImpl + + default-language: Haskell2010 + other-extensions: CPP + + if flag(pure-sha) + build-depends: SHA >= 1.6.4.4 && < 1.7 + , bytestring >= 0.10.0.0 && < 0.11 + , base >= 4.3.0.0 && < 4.12 + , time >= 1.2 && < 1.9 + else + build-depends: cryptohash-sha1 >= 0.11.100.1 && < 0.12 + , cryptohash-sha256 >= 0.11.100.1 && < 0.12 + , cryptohash-sha512 >= 0.11.100.1 && < 0.12 + , bytestring >= 0.9.2.0 && < 0.11 + , base >= 4.5.0.0 && < 4.12 + , time >= 1.4 && < 1.9 + + ghc-options: -Wall + + +test-suite tests + type: exitcode-stdio-1.0 + + hs-source-dirs: test + main-is: Test.hs + + default-language: Haskell2010 + other-extensions: OverloadedStrings + + build-depends: base + , bytestring + , OTP + , time + -- dependency constraints not inherited via 'OTP' component + , tasty == 1.1.* + , tasty-hunit == 0.10.* + + ghc-options: -Wall diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,69 @@ +# `OTP`: HMAC-Based and Time-Based One-Time Passwords (HOTP & TOTP) [![Hackage](https://img.shields.io/hackage/v/OTP.svg)](https://hackage.haskell.org/package/OTP) [![Build Status](https://travis-ci.org/haskell-hvr/OTP.svg)](https://travis-ci.org/haskell-hvr/OTP) + +**Please refer to the [package description](https://hackage.haskell.org/package/OTP#description) for an overview of `OTP`.** + +## Usage examples + +### Generating one-time passwords + +If you need to generate HOTP password described in RFC4226, then use + +```haskell +>>> hotp SHA1 "1234" 100 6 +317569 + +>>> hotp SHA512 "1234" 100 6 +134131 +``` + +Or + +```haskell +>>> totp SHA1 "1234" (read "2010-10-10 00:01:00 UTC") 30 8 +43388892 +``` + +to generate TOTP password described in RFC6238. + +### Checking one-time passwords + +```haskell +hotpCheck :: HashAlgorithm -- ^ Hashing algorithm + -> Secret -- ^ Shared secret + -> (Word8, Word8) -- ^ how much counters to take lower and higher than ideal + -> Word64 -- ^ ideal (expected) counter value + -> Word8 -- ^ Number of digits in password + -> Word32 -- ^ Password entered by user + -> Bool -- ^ True if password acceptable +``` + +```haskell +>>> hotpCheck SHA1 "1234" (0,0) 10 6 50897 +True + +>>> hotpCheck SHA1 "1234" (0,0) 9 6 50897 +False + +>>> hotpCheck SHA1 "1234" (0,1) 9 6 50897 +True +``` + +Here almost the same aguments as for `hotp` function, but there is +also `(0, 0)` tuple. This tuple describes range of counters to check +in case of desynchronisation of counters between client and +server. I.e. if you specify `(1, 1)` and ideal counter will be `10` +then function will check passwords for `[9, 10, 11]` list of +counters. + +Here is the same for TOTP: + +```haskell +>>> totpCheck SHA1 "1234" (0, 0) (read "2010-10-10 00:00:00 UTC") 30 6 778374 +True + +>>> totpCheck SHA1 "1234" (0, 0) (read "2010-10-10 00:00:30 UTC") 30 6 778374 +False + +>>> totpCheck SHA1 "1234" (1, 0) (read "2010-10-10 00:00:30 UTC") 30 6 778374 +True +``` diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,2 @@ -import Distribution.Simple -main = defaultMain +import Distribution.Simple +main = defaultMain diff --git a/Test/opt.hs b/Test/opt.hs deleted file mode 100644 --- a/Test/opt.hs +++ /dev/null @@ -1,23 +0,0 @@ -module Main where - -import Codec.Utils -import Data.OTP -import Data.Time -import System.Exit (exitFailure) - -secret_otp :: [Octet] -secret_otp = [49,50,51,52,53,54,55,56,57,48,49,50,51,52,53,54,55,56,57,48] - -hotp_t = zipWith (\x y -> (hotp secret_otp x 6) == y) [0..9] - [755224, 287082, 359152, 969429, 338314, 254676, 287922, 162583, 399871, 520489] - -totp_t = zipWith (\x y -> (totp secret_otp x 8 30) == y) (map (read) ["1970-01-01 00:00:59 UTC", - "2005-03-18 01:58:29 UTC", "2005-03-18 01:58:31 UTC", "2009-02-13 23:31:30 UTC", - "2033-05-18 03:33:20 UTC"]) - [94287082, 07081804, 14050471, 89005924, 69279037] -tests = hotp_t ++ totp_t - -main = if (and tests) then putStrLn "Tests succeful!" - else do - putStrLn "Tests falls!" - exitFailure diff --git a/src/Data/OTP.hs b/src/Data/OTP.hs new file mode 100644 --- /dev/null +++ b/src/Data/OTP.hs @@ -0,0 +1,286 @@ +-- | SPDX-License-Identifier: MIT +-- +-- Implements the /HMAC-Based One-Time Password Algorithm/ (HOTP) as +-- defined in [RFC 4226](https://tools.ietf.org/html/rfc4226) +-- and the /Time-Based One-Time Password Algorithm/ (TOTP) as defined +-- in [RFC 6238](https://tools.ietf.org/html/rfc6238). +-- +-- Many operations in this module take or return a 'Word32' OTP value +-- (whose most significant bit is always 0) which is truncated modulo +-- @10^digits@ according to the 'Word8' /digits/ +-- parameter. Consequently, passing a value above 10 won't produce +-- more than 10 digits and will effectively return the raw +-- non-truncated 31-bit OTP value. +-- +-- @since 0.1.0.0 +module Data.OTP + ( -- * HOTP + hotp + , hotpCheck + -- * TOTP + , totp + , totpCheck + -- * Auxiliary + , totpCounter + , counterRange + , totpCounterRange + + , HashAlgorithm(..) + , Secret + ) where + +import Data.Bits +import qualified Data.ByteString as BS +import Data.Time +import Data.Time.Clock.POSIX +import Data.Word + +import HashImpl + +{- | Compute /HMAC-Based One-Time Password/ using secret key and counter value. + +>>> hotp SHA1 "1234" 100 6 +317569 + +>>> hotp SHA512 "1234" 100 6 +134131 + +>>> hotp SHA512 "1234" 100 8 +55134131 + +-} + +hotp + :: HashAlgorithm -- ^ Hashing algorithm + -> Secret -- ^ Shared secret + -> Word64 -- ^ Counter value + -> Word8 -- ^ Number of base10 digits in HOTP value + -> Word32 -- ^ HOTP value +hotp alg key cnt digits + | digits >= 10 = snum + | otherwise = snum `rem` (10 ^ digits) + where + -- C + msg = bsFromW64 cnt + + -- Snum = StToNum(Sbits) + -- Sbits = DT(HS) + -- HS = HMAC(K,C) + snum = trunc $ hmac alg key msg + + -- DT(HS) + trunc :: BS.ByteString -> Word32 + trunc b = case bsToW32 rb of + Left e -> error e + Right res -> res .&. (0x80000000 - 1) -- reset highest bit + where + offset = BS.last b .&. 15 -- take low 4 bits of last byte + rb = BS.take 4 $ BS.drop (fromIntegral offset) b -- resulting 4 byte value + + -- StToNum(Sbits) + bsToW32 :: BS.ByteString -> Either String Word32 + bsToW32 bs = case BS.unpack bs of + [ b0, b1, b2, b3 ] -> Right $! (((((fI b0 `shiftL` 8) .|. fI b1) `shiftL` 8) .|. fI b2) `shiftL` 8) .|. fI b3 + _ -> Left "bsToW32: the impossible happened" + where + fI = fromIntegral + + bsFromW64 :: Word64 -> BS.ByteString + bsFromW64 w = BS.pack [ b j | j <- [ 7, 6 .. 0 ] ] + where + b j = fromIntegral (w `shiftR` (j*8)) + +{- | Check presented password against a valid range. + +>>> hotp SHA1 "1234" 10 6 +50897 + +>>> hotpCheck SHA1 "1234" (0,0) 10 6 50897 +True + +>>> hotpCheck SHA1 "1234" (0,0) 9 6 50897 +False + +>>> hotpCheck SHA1 "1234" (0,1) 9 6 50897 +True + +>>> hotpCheck SHA1 "1234" (1,0) 11 6 50897 +True + +>>> hotpCheck SHA1 "1234" (2,2) 8 6 50897 +True + +>>> hotpCheck SHA1 "1234" (2,2) 7 6 50897 +False + +>>> hotpCheck SHA1 "1234" (2,2) 12 6 50897 +True + +>>> hotpCheck SHA1 "1234" (2,2) 13 6 50897 +False + +-} + +hotpCheck + :: HashAlgorithm -- ^ Hash algorithm to use + -> Secret -- ^ Shared secret + -> (Word8, Word8) -- ^ Valid counter range, before and after ideal + -> Word64 -- ^ Ideal (expected) counter value + -> Word8 -- ^ Number of base10 digits in a password + -> Word32 -- ^ Password (i.e. HOTP value) entered by user + -> Bool -- ^ True if password is valid +hotpCheck alg secr rng cnt len pass = + let counters = counterRange rng cnt + passwds = map (\c -> hotp alg secr c len) counters + in any (pass ==) passwds + +{- | Compute a /Time-Based One-Time Password/ using secret key and time. + +>>> totp SHA1 "1234" (read "2010-10-10 00:01:00 UTC") 30 6 +388892 + +>>> totp SHA1 "1234" (read "2010-10-10 00:01:00 UTC") 30 8 +43388892 + +>>> totp SHA1 "1234" (read "2010-10-10 00:01:15 UTC") 30 8 +43388892 + +>>> totp SHA1 "1234" (read "2010-10-10 00:01:31 UTC") 30 8 +39110359 + +-} + +totp + :: HashAlgorithm -- ^ Hash algorithm to use + -> Secret -- ^ Shared secret + -> UTCTime -- ^ Time of TOTP + -> Word64 -- ^ Time range in seconds + -> Word8 -- ^ Number of base10 digits in TOTP value + -> Word32 -- ^ TOTP value +totp alg secr time period len = + hotp alg secr (totpCounter time period) len + +{- | Check presented password against time periods. + +>>> totp SHA1 "1234" (read "2010-10-10 00:00:00 UTC") 30 6 +778374 + +>>> totpCheck SHA1 "1234" (0, 0) (read "2010-10-10 00:00:00 UTC") 30 6 778374 +True + +>>> totpCheck SHA1 "1234" (0, 0) (read "2010-10-10 00:00:30 UTC") 30 6 778374 +False + +>>> totpCheck SHA1 "1234" (1, 0) (read "2010-10-10 00:00:30 UTC") 30 6 778374 +True + +>>> totpCheck SHA1 "1234" (1, 0) (read "2010-10-10 00:01:00 UTC") 30 6 778374 +False + +>>> totpCheck SHA1 "1234" (2, 0) (read "2010-10-10 00:01:00 UTC") 30 6 778374 +True +-} + +totpCheck + :: HashAlgorithm -- ^ Hash algorithm to use + -> Secret -- ^ Shared secret + -> (Word8, Word8) -- ^ Valid counter range, before and after ideal + -> UTCTime -- ^ Time of TOTP + -> Word64 -- ^ Time range in seconds + -> Word8 -- ^ Number of base10 digits in a password + -> Word32 -- ^ Password given by user + -> Bool -- ^ True if password is valid +totpCheck alg secr rng time period len pass = + let counters = totpCounterRange rng time period + passwds = map (\c -> hotp alg secr c len) counters + in any (pass ==) passwds + + +{- | Calculate HOTP counter using time. Starting time (T0 +according to RFC6238) is 0 (begining of UNIX epoch) + +>>> totpCounter (read "2010-10-10 00:00:00 UTC") 30 +42888960 + +>>> totpCounter (read "2010-10-10 00:00:30 UTC") 30 +42888961 + +>>> totpCounter (read "2010-10-10 00:01:00 UTC") 30 +42888962 + +-} + +totpCounter + :: UTCTime -- ^ Time of totp + -> Word64 -- ^ Time range in seconds + -> Word64 -- ^ Resulting counter +totpCounter time period = + let timePOSIX = floor $ utcTimeToPOSIXSeconds time + in timePOSIX `div` period + +{- | Make a sequence of acceptable counters, protected from +arithmetic overflow. + +>>> counterRange (0, 0) 9000 +[9000] + +>>> counterRange (1, 0) 9000 +[8999,9000] + +>>> length $ counterRange (5000, 0) 9000 +501 + +>>> length $ counterRange (5000, 5000) 9000 +1000 + +>>> counterRange (2, 2) maxBound +[18446744073709551613,18446744073709551614,18446744073709551615] + +>>> counterRange (2, 2) minBound +[0,1,2] + +>>> counterRange (2, 2) (maxBound `div` 2) +[9223372036854775805,9223372036854775806,9223372036854775807,9223372036854775808,9223372036854775809] + +>>> counterRange (5, 5) 9000 +[8995,8996,8997,8998,8999,9000,9001,9002,9003,9004,9005] + +RFC recommends avoiding excessively large values for counter ranges. +-} + +counterRange + :: (Word8, Word8) -- ^ Number of counters before and after ideal + -> Word64 -- ^ Ideal counter value + -> [Word64] +counterRange (tolow, tohigh) ideal = [l..h] + where + l' = ideal - fromIntegral tolow + l | l' <= ideal = l' + | otherwise = 0 + + h' = ideal + fromIntegral tohigh + h | ideal <= h' = h' + | otherwise = maxBound + +{- | Make a sequence of acceptable periods. + +>>> totpCounterRange (0, 0) (read "2010-10-10 00:01:00 UTC") 30 +[42888962] + +>>> totpCounterRange (2, 0) (read "2010-10-10 00:01:00 UTC") 30 +[42888960,42888961,42888962] + +>>> totpCounterRange (0, 2) (read "2010-10-10 00:01:00 UTC") 30 +[42888962,42888963,42888964] + +>>> totpCounterRange (2, 2) (read "2010-10-10 00:01:00 UTC") 30 +[42888960,42888961,42888962,42888963,42888964] + +-} + +totpCounterRange :: (Word8, Word8) + -> UTCTime + -> Word64 + -> [Word64] +totpCounterRange rng time period = + counterRange rng $ totpCounter time period diff --git a/src/HashImpl.hs b/src/HashImpl.hs new file mode 100644 --- /dev/null +++ b/src/HashImpl.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE CPP #-} + +-- | SPDX-License-Identifier: MIT +-- +-- @since 0.1.0.0 +module HashImpl where + +#if defined(MIN_VERSION_SHA) +import qualified Data.ByteString.Lazy as BS.L +import qualified Data.Digest.Pure.SHA as SHA +#else +import qualified Crypto.Hash.SHA1 as SHA1 +import qualified Crypto.Hash.SHA256 as SHA256 +import qualified Crypto.Hash.SHA512 as SHA512 +#endif + +import qualified Data.ByteString as BS + + +-- | Shared secret encoded as raw octets +type Secret = BS.ByteString + +-- | Hash algorithm used for HOTP\/TOTP computations +data HashAlgorithm = SHA1 + | SHA256 + | SHA512 + deriving (Eq,Show) + +hmac :: HashAlgorithm -> Secret -> BS.ByteString -> BS.ByteString +hmac alg key msg = case alg of +#if defined(MIN_VERSION_SHA) + SHA1 -> BS.L.toStrict (SHA.bytestringDigest (SHA.hmacSha1 (BS.L.fromStrict key) (BS.L.fromStrict msg))) + SHA256 -> BS.L.toStrict (SHA.bytestringDigest (SHA.hmacSha256 (BS.L.fromStrict key) (BS.L.fromStrict msg))) + SHA512 -> BS.L.toStrict (SHA.bytestringDigest (SHA.hmacSha512 (BS.L.fromStrict key) (BS.L.fromStrict msg))) +#else + SHA1 -> SHA1.hmac key msg + SHA256 -> SHA256.hmac key msg + SHA512 -> SHA512.hmac key msg +#endif diff --git a/test/Test.hs b/test/Test.hs new file mode 100644 --- /dev/null +++ b/test/Test.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as BC +import Data.Time +import Data.Word +import Test.Tasty +import Test.Tasty.HUnit + +-- IUT +import Data.OTP + + +hotpSecret :: ByteString +hotpSecret = "12345678901234567890" + +testHotp :: Word64 -> Word32 -> TestTree +testHotp key result = testCase (show result) $ do + let h = hotp SHA1 hotpSecret key 6 + result @=? h + +hotpResults :: [Word32] +hotpResults = + [ 755224, 287082, 359152 + , 969429, 338314, 254676 + , 287922, 162583, 399871 + , 520489 + ] + + +testTotp :: (ByteString, UTCTime, HashAlgorithm, Word32) -> TestTree +testTotp (secr, key, alg, result) = + testCase (show alg ++ " => " ++ show result) $ do + let t = totp alg secr key 30 8 + result @=? t + +sha1Secr :: ByteString +sha1Secr = BC.pack $ take 20 $ cycle "12345678901234567890" + +sha256Secr :: ByteString +sha256Secr = BC.pack $ take 32 $ cycle "12345678901234567890" + +sha512Secr :: ByteString +sha512Secr = BC.pack $ take 64 $ cycle "12345678901234567890" + +totpData :: [(ByteString, UTCTime, HashAlgorithm, Word32)] +totpData = + [ (sha1Secr, read "1970-01-01 00:00:59 UTC", SHA1, 94287082) + , (sha256Secr, read "1970-01-01 00:00:59 UTC", SHA256, 46119246) + , (sha512Secr, read "1970-01-01 00:00:59 UTC", SHA512, 90693936) + , (sha1Secr, read "2005-03-18 01:58:29 UTC", SHA1, 07081804) + , (sha256Secr, read "2005-03-18 01:58:29 UTC", SHA256, 68084774) + , (sha512Secr, read "2005-03-18 01:58:29 UTC", SHA512, 25091201) + , (sha1Secr, read "2005-03-18 01:58:31 UTC", SHA1, 14050471) + , (sha256Secr, read "2005-03-18 01:58:31 UTC", SHA256, 67062674) + , (sha512Secr, read "2005-03-18 01:58:31 UTC", SHA512, 99943326) + , (sha1Secr, read "2009-02-13 23:31:30 UTC", SHA1, 89005924) + , (sha256Secr, read "2009-02-13 23:31:30 UTC", SHA256, 91819424) + , (sha512Secr, read "2009-02-13 23:31:30 UTC", SHA512, 93441116) + , (sha1Secr, read "2033-05-18 03:33:20 UTC", SHA1, 69279037) + , (sha256Secr, read "2033-05-18 03:33:20 UTC", SHA256, 90698825) + , (sha512Secr, read "2033-05-18 03:33:20 UTC", SHA512, 38618901) + , (sha1Secr, read "2603-10-11 11:33:20 UTC", SHA1, 65353130) + , (sha256Secr, read "2603-10-11 11:33:20 UTC", SHA256, 77737706) + , (sha512Secr, read "2603-10-11 11:33:20 UTC", SHA512, 47863826) + ] + + +main :: IO () +main = defaultMain $ testGroup "test vectors" + [ testGroup "hotp" $ map (uncurry testHotp) $ zip [0..] hotpResults + , testGroup "totp" $ map testTotp totpData + ]