diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,8 @@ +# CHANGELOG + +## 1.0.0.0 + +* Forked from OTP (https://github.com/matshch/OTP) +* Rewrote with `cryptohash` +* Add multiple hash functions support +* Tests improoved: all RFC test verctors passed diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,18 @@ +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 +IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,72 @@ +# What + +One time password implementation according to RFC4226 and RFC6238 in +Haskell. + +# Generation 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 passwords + +```haskell +hotpCheck :: (HashAlgorithm a) + => a -- ^ Hashing algorithm + -> ByteString -- ^ Shared secret + -> (Word64, Word64) -- ^ how much counters to take lower and higher than ideal + -> Word64 -- ^ ideal (expected) counter value + -> Word -- ^ 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. + +There is also some protection, so if you specify `(minBound, +maxBound)` then function will check just 1000 counters around ideal. + +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 new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/one-time-password.cabal b/one-time-password.cabal new file mode 100644 --- /dev/null +++ b/one-time-password.cabal @@ -0,0 +1,66 @@ +name: one-time-password +-- PVP summary: +-+------- breaking API changes +-- | | +----- non-breaking API additions +-- | | | +--- code changes with no API change +version: 1.0.0.0 +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, 2015 Aleksey Uimanov +author: Artem Leshchev, Aleksey Uimanov +maintainer: s9gf4ult@gmail.com +homepage: https://github.com/s9gf4ult/one-time-password +bug-reports: https://github.com/s9gf4ult/one-time-password/issues +category: Cryptography +build-type: Simple +cabal-version: >=1.10 + +extra-source-files: CHANGELOG.md + , README.md + +source-repository head + type: git + location: git://github.com/s9gf4ult/one-time-password.git + +library + default-language: Haskell2010 + hs-source-dirs: src + + default-extensions: OverloadedStrings + + exposed-modules: Data.OTP + + build-depends: base >= 3 && < 5 + , byteable + , bytestring + , cereal + , cryptohash + , time >= 1.1 + + ghc-options: -Wall + +test-suite tests + default-language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: test + + default-extensions: ExistentialQuantification + , OverloadedStrings + , RankNTypes + + main-is: Test.hs + + build-depends: base >= 3 && < 5 + , bytestring + , cryptohash + , one-time-password + , tasty + , tasty-hunit + , time >= 1.1 + + ghc-options: -Wall 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,259 @@ +-- |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 + hotp + , hotpCheck + -- * TOTP + , totp + , totpCheck + -- * Auxiliary + , totpCounter + , counterRange + , totpCounterRange + ) where + +import Crypto.Hash +import Data.Bits +import Data.Byteable +import Data.ByteString (ByteString) +import Data.Serialize.Get +import Data.Serialize.Put +import Data.Time +import Data.Time.Clock.POSIX +import Data.Word + +import qualified Data.ByteString as BS + + + +{- | Compute an HOTP 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 a) + => a -- ^ Hashing algorithm from module "Crypto.Hash" + -> ByteString -- ^ Shared secret + -> Word64 -- ^ Counter value + -> Word -- ^ Number of digits in password + -> Word32 -- ^ HOTP +hotp alg secr cnt digit = + let h = trunc + $ toBytes + $ hmacAlg alg secr + $ runPut + $ putWord64be cnt + in h `mod` (10^digit) + where + trunc :: ByteString -> Word32 + trunc b = + let 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 + in case runGet getWord32be rb of + Left e -> error e + Right res -> res .&. (0x80000000 - 1) -- reset highest bit + +{- | Check given one time password considering counter resinchronization +desynchronisation + +>>> 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 a) + => a -- ^ Hashing algorithm + -> ByteString -- ^ Shared secret + -> (Word64, Word64) -- ^ how much counters to take lower and higher than ideal + -> Word64 -- ^ ideal (expected) counter value + -> Word -- ^ Number of digits in password + -> Word32 -- ^ Password entered by user + -> Bool -- ^ True if password acceptable +hotpCheck alg secr rng cnt digits pass = + let counters = counterRange rng cnt + passwds = map (\c -> hotp alg secr c digits) counters + in any (pass ==) passwds + +{- | Compute an TOTP 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 a) + => a -- ^ Hash algorithm to use + -> ByteString -- ^ Shared secret + -> UTCTime -- ^ Time of TOTP + -> Word64 -- ^ Time period in seconds + -> Word -- ^ Number of digits in password + -> Word32 -- ^ TOTP +totp alg secr time period digits = + hotp alg secr (totpCounter time period) digits + +{- | Same as 'hotpCheck' but checks TOTP + +>>> 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 a) + => a -- ^ Hashing algorithm + -> ByteString -- ^ Shared secret + -> (Word64, Word64) -- ^ How much counters to take lower and higher than ideal + -> UTCTime -- ^ Time of totp + -> Word64 -- ^ Time period in seconds + -> Word -- ^ Numer of digits in password + -> Word32 -- ^ Password given by user + -> Bool -- ^ True if password acceptable +totpCheck alg secr rng time period digits pass = + let counters = totpCounterRange rng time period + passwds = map (\c -> hotp alg secr c digits) counters + in any (pass ==) passwds + + +{- | Calculate counter for `hotp` 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 period in seconds + -> Word64 -- ^ Resulting counter +totpCounter time period = + let timePOSIX = floor $ utcTimeToPOSIXSeconds time + in timePOSIX `div` period + +{- | Return sequence of acceptable counters. It protects you from +arithmetic overflow and truncates output to 1000 values, because huge +counter ranges are not secure. + +>>> 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 not to use big values for higher and lower counter +ranges +-} + +counterRange :: (Word64, Word64) -- ^ How much counters to take lower than ideal and higher + -> Word64 -- ^ Ideal counter value + -> [Word64] +counterRange (tolow', tohigh') ideal = + let tolow = min 500 tolow' + tohigh = min 499 tohigh' + l = trim 0 ideal (ideal - tolow) + h = trim ideal maxBound (ideal + tohigh) + in [l..h] + where + trim l h = max l . min h + +{- | Same as 'counterRange' but used for time-based counters. + +>>> 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 :: (Word64, Word64) + -> UTCTime + -> Word64 + -> [Word64] +totpCounterRange rng time period = + counterRange rng $ totpCounter time period diff --git a/test/Test.hs b/test/Test.hs new file mode 100644 --- /dev/null +++ b/test/Test.hs @@ -0,0 +1,79 @@ +module Main where + +import Crypto.Hash +import Data.ByteString (ByteString) +import Data.OTP +import Data.Time +import Data.Word +import Test.Tasty +import Test.Tasty.HUnit + +import qualified Data.ByteString.Char8 as BC + +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 + ] + + +data SomeAlg = forall a. (HashAlgorithm a, Show a) => SomeAlg a + +instance Show SomeAlg where + show (SomeAlg a) = show a + + +testTotp :: (ByteString, UTCTime, SomeAlg, Word32) -> TestTree +testTotp (secr, key, alg', result) = + testCase (show alg' ++ " => " ++ show result) $ case alg' of + SomeAlg alg -> 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, SomeAlg, Word32)] +totpData = + [ (sha1Secr, read "1970-01-01 00:00:59 UTC", SomeAlg SHA1, 94287082) + , (sha256Secr, read "1970-01-01 00:00:59 UTC", SomeAlg SHA256, 46119246) + , (sha512Secr, read "1970-01-01 00:00:59 UTC", SomeAlg SHA512, 90693936) + , (sha1Secr, read "2005-03-18 01:58:29 UTC", SomeAlg SHA1, 07081804) + , (sha256Secr, read "2005-03-18 01:58:29 UTC", SomeAlg SHA256, 68084774) + , (sha512Secr, read "2005-03-18 01:58:29 UTC", SomeAlg SHA512, 25091201) + , (sha1Secr, read "2005-03-18 01:58:31 UTC", SomeAlg SHA1, 14050471) + , (sha256Secr, read "2005-03-18 01:58:31 UTC", SomeAlg SHA256, 67062674) + , (sha512Secr, read "2005-03-18 01:58:31 UTC", SomeAlg SHA512, 99943326) + , (sha1Secr, read "2009-02-13 23:31:30 UTC", SomeAlg SHA1, 89005924) + , (sha256Secr, read "2009-02-13 23:31:30 UTC", SomeAlg SHA256, 91819424) + , (sha512Secr, read "2009-02-13 23:31:30 UTC", SomeAlg SHA512, 93441116) + , (sha1Secr, read "2033-05-18 03:33:20 UTC", SomeAlg SHA1, 69279037) + , (sha256Secr, read "2033-05-18 03:33:20 UTC", SomeAlg SHA256, 90698825) + , (sha512Secr, read "2033-05-18 03:33:20 UTC", SomeAlg SHA512, 38618901) + , (sha1Secr, read "2603-10-11 11:33:20 UTC", SomeAlg SHA1, 65353130) + , (sha256Secr, read "2603-10-11 11:33:20 UTC", SomeAlg SHA256, 77737706) + , (sha512Secr, read "2603-10-11 11:33:20 UTC", SomeAlg SHA512, 47863826) + ] + + +main :: IO () +main = defaultMain $ testGroup "test vectors" + [ testGroup "hotp" $ map (uncurry testHotp) $ zip [0..] hotpResults + , testGroup "totp" $ map testTotp totpData + ]