{-# LANGUAGE ScopedTypeVariables #-}
module Crypto.OTP
( OTP
, OTPDigits (..)
, OTPTime
, hotp
, resynchronize
, totp
, totpVerify
, TOTPParams
, ClockSkew (..)
, defaultTOTPParams
, mkTOTPParams
)
where
import Data.Bits (shiftL, (.&.), (.|.))
import Data.ByteArray.Mapping (fromW64BE)
import Data.List (elemIndex)
import Data.Word
import Control.Monad (unless)
import Crypto.Hash (HashAlgorithm, SHA1(..))
import Crypto.MAC.HMAC
import Crypto.Internal.ByteArray (ByteArrayAccess, Bytes)
import qualified Crypto.Internal.ByteArray as B
type OTP = Word32
data OTPDigits = OTP4 | OTP5 | OTP6 | OTP7 | OTP8 | OTP9 deriving (Int -> OTPDigits -> ShowS
[OTPDigits] -> ShowS
OTPDigits -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OTPDigits] -> ShowS
$cshowList :: [OTPDigits] -> ShowS
show :: OTPDigits -> String
$cshow :: OTPDigits -> String
showsPrec :: Int -> OTPDigits -> ShowS
$cshowsPrec :: Int -> OTPDigits -> ShowS
Show)
type OTPTime = Word64
hotp :: forall hash key. (HashAlgorithm hash, ByteArrayAccess key)
=> hash
-> OTPDigits
-> key
-> Word64
-> OTP
hotp :: forall hash key.
(HashAlgorithm hash, ByteArrayAccess key) =>
hash -> OTPDigits -> key -> Word64 -> Word32
hotp hash
_ OTPDigits
d key
k Word64
c = Word32
dt forall a. Integral a => a -> a -> a
`mod` OTPDigits -> Word32
digitsPower OTPDigits
d
where
mac :: HMAC hash
mac = forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
hmac key
k (forall ba. ByteArray ba => Word64 -> ba
fromW64BE Word64
c :: Bytes) :: HMAC hash
offset :: Int
offset = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. ByteArrayAccess a => a -> Int -> Word8
B.index HMAC hash
mac (forall ba. ByteArrayAccess ba => ba -> Int
B.length HMAC hash
mac forall a. Num a => a -> a -> a
- Int
1) forall a. Bits a => a -> a -> a
.&. Word8
0xf)
dt :: Word32
dt = (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. ByteArrayAccess a => a -> Int -> Word8
B.index HMAC hash
mac Int
offset forall a. Bits a => a -> a -> a
.&. Word8
0x7f) forall a. Bits a => a -> Int -> a
`shiftL` Int
24) forall a. Bits a => a -> a -> a
.|.
(forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. ByteArrayAccess a => a -> Int -> Word8
B.index HMAC hash
mac (Int
offset forall a. Num a => a -> a -> a
+ Int
1) forall a. Bits a => a -> a -> a
.&. Word8
0xff) forall a. Bits a => a -> Int -> a
`shiftL` Int
16) forall a. Bits a => a -> a -> a
.|.
(forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. ByteArrayAccess a => a -> Int -> Word8
B.index HMAC hash
mac (Int
offset forall a. Num a => a -> a -> a
+ Int
2) forall a. Bits a => a -> a -> a
.&. Word8
0xff) forall a. Bits a => a -> Int -> a
`shiftL` Int
8) forall a. Bits a => a -> a -> a
.|.
forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. ByteArrayAccess a => a -> Int -> Word8
B.index HMAC hash
mac (Int
offset forall a. Num a => a -> a -> a
+ Int
3) forall a. Bits a => a -> a -> a
.&. Word8
0xff)
resynchronize :: (HashAlgorithm hash, ByteArrayAccess key)
=> hash
-> OTPDigits
-> Word16
-> key
-> Word64
-> (OTP, [OTP])
-> Maybe Word64
resynchronize :: forall hash key.
(HashAlgorithm hash, ByteArrayAccess key) =>
hash
-> OTPDigits
-> Word16
-> key
-> Word64
-> (Word32, [Word32])
-> Maybe Word64
resynchronize hash
h OTPDigits
d Word16
s key
k Word64
c (Word32
p1, [Word32]
extras) = do
Word64
offBy <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Word32
p1 [Word32]
range)
Word64 -> [Word32] -> Maybe Word64
checkExtraOtps (Word64
c forall a. Num a => a -> a -> a
+ Word64
offBy forall a. Num a => a -> a -> a
+ Word64
1) [Word32]
extras
where
checkExtraOtps :: Word64 -> [Word32] -> Maybe Word64
checkExtraOtps Word64
ctr [] = forall a. a -> Maybe a
Just Word64
ctr
checkExtraOtps Word64
ctr (Word32
p:[Word32]
ps)
| forall hash key.
(HashAlgorithm hash, ByteArrayAccess key) =>
hash -> OTPDigits -> key -> Word64 -> Word32
hotp hash
h OTPDigits
d key
k Word64
ctr forall a. Eq a => a -> a -> Bool
/= Word32
p = forall a. Maybe a
Nothing
| Bool
otherwise = Word64 -> [Word32] -> Maybe Word64
checkExtraOtps (Word64
ctr forall a. Num a => a -> a -> a
+ Word64
1) [Word32]
ps
range :: [Word32]
range = forall a b. (a -> b) -> [a] -> [b]
map (forall hash key.
(HashAlgorithm hash, ByteArrayAccess key) =>
hash -> OTPDigits -> key -> Word64 -> Word32
hotp hash
h OTPDigits
d key
k)[Word64
c..Word64
c forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
s]
digitsPower :: OTPDigits -> Word32
digitsPower :: OTPDigits -> Word32
digitsPower OTPDigits
OTP4 = Word32
10000
digitsPower OTPDigits
OTP5 = Word32
100000
digitsPower OTPDigits
OTP6 = Word32
1000000
digitsPower OTPDigits
OTP7 = Word32
10000000
digitsPower OTPDigits
OTP8 = Word32
100000000
digitsPower OTPDigits
OTP9 = Word32
1000000000
data TOTPParams h = TP !h !OTPTime !Word16 !OTPDigits !ClockSkew deriving (Int -> TOTPParams h -> ShowS
forall h. Show h => Int -> TOTPParams h -> ShowS
forall h. Show h => [TOTPParams h] -> ShowS
forall h. Show h => TOTPParams h -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TOTPParams h] -> ShowS
$cshowList :: forall h. Show h => [TOTPParams h] -> ShowS
show :: TOTPParams h -> String
$cshow :: forall h. Show h => TOTPParams h -> String
showsPrec :: Int -> TOTPParams h -> ShowS
$cshowsPrec :: forall h. Show h => Int -> TOTPParams h -> ShowS
Show)
data ClockSkew = NoSkew | OneStep | TwoSteps | ThreeSteps | FourSteps deriving (Int -> ClockSkew
ClockSkew -> Int
ClockSkew -> [ClockSkew]
ClockSkew -> ClockSkew
ClockSkew -> ClockSkew -> [ClockSkew]
ClockSkew -> ClockSkew -> ClockSkew -> [ClockSkew]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ClockSkew -> ClockSkew -> ClockSkew -> [ClockSkew]
$cenumFromThenTo :: ClockSkew -> ClockSkew -> ClockSkew -> [ClockSkew]
enumFromTo :: ClockSkew -> ClockSkew -> [ClockSkew]
$cenumFromTo :: ClockSkew -> ClockSkew -> [ClockSkew]
enumFromThen :: ClockSkew -> ClockSkew -> [ClockSkew]
$cenumFromThen :: ClockSkew -> ClockSkew -> [ClockSkew]
enumFrom :: ClockSkew -> [ClockSkew]
$cenumFrom :: ClockSkew -> [ClockSkew]
fromEnum :: ClockSkew -> Int
$cfromEnum :: ClockSkew -> Int
toEnum :: Int -> ClockSkew
$ctoEnum :: Int -> ClockSkew
pred :: ClockSkew -> ClockSkew
$cpred :: ClockSkew -> ClockSkew
succ :: ClockSkew -> ClockSkew
$csucc :: ClockSkew -> ClockSkew
Enum, Int -> ClockSkew -> ShowS
[ClockSkew] -> ShowS
ClockSkew -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClockSkew] -> ShowS
$cshowList :: [ClockSkew] -> ShowS
show :: ClockSkew -> String
$cshow :: ClockSkew -> String
showsPrec :: Int -> ClockSkew -> ShowS
$cshowsPrec :: Int -> ClockSkew -> ShowS
Show)
defaultTOTPParams :: TOTPParams SHA1
defaultTOTPParams :: TOTPParams SHA1
defaultTOTPParams = forall h.
h -> Word64 -> Word16 -> OTPDigits -> ClockSkew -> TOTPParams h
TP SHA1
SHA1 Word64
0 Word16
30 OTPDigits
OTP6 ClockSkew
TwoSteps
mkTOTPParams :: (HashAlgorithm hash)
=> hash
-> OTPTime
-> Word16
-> OTPDigits
-> ClockSkew
-> Either String (TOTPParams hash)
mkTOTPParams :: forall hash.
HashAlgorithm hash =>
hash
-> Word64
-> Word16
-> OTPDigits
-> ClockSkew
-> Either String (TOTPParams hash)
mkTOTPParams hash
h Word64
t0 Word16
x OTPDigits
d ClockSkew
skew = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word16
x forall a. Ord a => a -> a -> Bool
> Word16
0) (forall a b. a -> Either a b
Left String
"Time step must be greater than zero")
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word16
x forall a. Ord a => a -> a -> Bool
<= Word16
300) (forall a b. a -> Either a b
Left String
"Time step cannot be greater than 300 seconds")
forall (m :: * -> *) a. Monad m => a -> m a
return (forall h.
h -> Word64 -> Word16 -> OTPDigits -> ClockSkew -> TOTPParams h
TP hash
h Word64
t0 Word16
x OTPDigits
d ClockSkew
skew)
totp :: (HashAlgorithm hash, ByteArrayAccess key)
=> TOTPParams hash
-> key
-> OTPTime
-> OTP
totp :: forall hash key.
(HashAlgorithm hash, ByteArrayAccess key) =>
TOTPParams hash -> key -> Word64 -> Word32
totp (TP hash
h Word64
t0 Word16
x OTPDigits
d ClockSkew
_) key
k Word64
now = forall hash key.
(HashAlgorithm hash, ByteArrayAccess key) =>
hash -> OTPDigits -> key -> Word64 -> Word32
hotp hash
h OTPDigits
d key
k (Word64 -> Word64 -> Word16 -> Word64
timeToCounter Word64
now Word64
t0 Word16
x)
totpVerify :: (HashAlgorithm hash, ByteArrayAccess key)
=> TOTPParams hash
-> key
-> OTPTime
-> OTP
-> Bool
totpVerify :: forall hash key.
(HashAlgorithm hash, ByteArrayAccess key) =>
TOTPParams hash -> key -> Word64 -> Word32 -> Bool
totpVerify (TP hash
h Word64
t0 Word16
x OTPDigits
d ClockSkew
skew) key
k Word64
now Word32
otp = Word32
otp forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map (forall hash key.
(HashAlgorithm hash, ByteArrayAccess key) =>
hash -> OTPDigits -> key -> Word64 -> Word32
hotp hash
h OTPDigits
d key
k) (Word64 -> [Word64] -> [Word64]
range Word64
window [])
where
t :: Word64
t = Word64 -> Word64 -> Word16 -> Word64
timeToCounter Word64
now Word64
t0 Word16
x
window :: Word64
window = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum ClockSkew
skew)
range :: Word64 -> [Word64] -> [Word64]
range Word64
0 [Word64]
acc = Word64
t forall a. a -> [a] -> [a]
: [Word64]
acc
range Word64
n [Word64]
acc = Word64 -> [Word64] -> [Word64]
range (Word64
nforall a. Num a => a -> a -> a
-Word64
1) ((Word64
tforall a. Num a => a -> a -> a
-Word64
n) forall a. a -> [a] -> [a]
: (Word64
tforall a. Num a => a -> a -> a
+Word64
n) forall a. a -> [a] -> [a]
: [Word64]
acc)
timeToCounter :: Word64 -> Word64 -> Word16 -> Word64
timeToCounter :: Word64 -> Word64 -> Word16 -> Word64
timeToCounter Word64
now Word64
t0 Word16
x = (Word64
now forall a. Num a => a -> a -> a
- Word64
t0) forall a. Integral a => a -> a -> a
`div` forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
x