Haskell で HOTP および TOTP を計算する

Google Authenticator 等で利用されている HOTP (HMAC-Based One-Time Password) や TOTP (Time-Based One-Time Password) を Haskell で計算する方法を書きます。

"HMAC-Based" は「カウンタベース」、"Time-Based" は「時間ベース」や「タイムベース」と訳されます。

参考「[RFC 4226 - HOTP: An HMAC-Based One-Time Password Algorithm 日本語訳](https://tex2e.github.io/rfc-translater/html/rfc4226.html)」
参考「[RFC 6238 - TOTP: Time-Based One-Time Password Algorithm 日本語訳](https://tex2e.github.io/rfc-translater/html/rfc6238.html)」

# 1. 鍵を生成する

後述しますが、本記事では HOTP も TOTP も `HMAC-SHA-1` ハッシュ値を用いるため、鍵の長さは 20 バイトにします。

HOTP や TOTP の仕様として決められているわけではないですが、多くの場合、鍵を Base32 エンコードしてやり取りします。

インストールが必要なパッケージ:

- `cryptonite`
- `memory`

```haskell
import Data.ByteArray.Encoding (Base(Base32), convertToBase)
import Data.ByteString (ByteString)

import qualified Crypto.Random.Types as CRT
import qualified Data.ByteString.Char8 as BSC

main :: IO ()
main = do

    -- 鍵を生成
    seed :: ByteString <- CRT.getRandomBytes 20

    print seed

    let seedString = BSC.unpack . convertToBase Base32 $ seed
    putStrLn seedString
```

```text:実行結果の例
"\221\RS&%\168\218\DEL\163\184k\128\158\217 \200h\143S\131F"
3UPCMJNI3J72HODLQCPNSIGINCHVHA2G
```

鍵は乱数で生成しますが、暗号強度の弱い `random` パッケージでなく暗号強度の強い `cryptonite` パッケージを用います。

参考「[cryptonite: Cryptography Primitives sink](https://hackage.haskell.org/package/cryptonite-0.30)」
参考「[getRandomBytes - Crypto.Random.Types](https://hackage.haskell.org/package/cryptonite-0.30/docs/Crypto-Random-Types.html#v:getRandomBytes)」

鍵をやり取りするために鍵を Base32 エンコードした文字列を得ます。

ここでは `memory` パッケージを用いて Base32 エンコードします。

参考「[memory: memory and related abstraction stuff](https://hackage.haskell.org/package/memory-0.18.0)」
参考「[Data.ByteArray.Encoding](https://hackage.haskell.org/package/memory-0.18.0/docs/Data-ByteArray-Encoding.html)」

# 2. HOTP を計算する

HOTP (HMAC-Based One-Time Password) は名前の通り HMAC を利用します。

「鍵」と「カウンタ」と呼ばれる値から HMAC ハッシュ値を求めます。

仕様上はダイジェスト関数に `SHA-256` や `SHA-512` を用いることができますが、多くの場合 `SHA-1` が使われるため、ここでは `HMAC-SHA-1` ハッシュ値を使用します。

`HMAC-SHA-1` の場合は鍵の長さを 20 バイトにします。

カウンタの初期値は自由ですが、0 または 1 に設定される場合が多いようです (Google Authenticator で鍵を手動入力した場合は 1 に設定されるようです) 。

ここでは HOTP の桁数は良く使われている 6 とします。

インストールが必要なパッケージ:

- `cryptonite`

```haskell
import Crypto.Hash (SHA1(..))

import qualified Crypto.OTP as OTP
import qualified Data.ByteString.Char8 as BSC

-- 
showOTP :: Int -> OTP.OTP -> String
showOTP digits otp = otpStringPadded
  where
    otpString = show otp
    otpStringPadded = replicate (digits - length otpString) '0' ++ otpString
```

Haskell では `cryptonite` パッケージを用いて HOTP を計算できます。

参考「[cryptonite: Cryptography Primitives sink](https://hackage.haskell.org/package/cryptonite-0.30)」
参考「[hotp - Crypto.OTP](https://hackage.haskell.org/package/cryptonite-0.30/docs/Crypto-OTP.html#v:hotp)」

```haskell:例
-- 
main :: IO ()
main = do

    -- HOTP を計算する
    let seed = BSC.pack "\221\RS&%\168\218\DEL\163\184k\128\158\217 \200h\143S\131F"

    let counter = 1

    let hotp = showOTP 6 $ OTP.hotp SHA1 OTP.OTP6 seed counter
    putStrLn hotp
```

```text:例の実行結果
836609
```

※ HOTP を実用的に使うは別途「ブルートフォース攻撃対策」や「カウンタ再同期」の機能を実装する必要があります。
※カウンタ再同期は `cryptonite` パッケージ `Crypto.OTP` モジュールの `resynchronize` 関数によって行えます。 

参考「[7. Security Requirements - RFC 4226 - HOTP: An HMAC-Based One-Time Password Algorithm 日本語訳](https://tex2e.github.io/rfc-translater/html/rfc4226.html#7--Security-Requirements)」

参考「[resynchronize - Crypto.OTP](https://hackage.haskell.org/package/cryptonite-0.30/docs/Crypto-OTP.html#v:resynchronize)」

# 3. TOTP を計算する

TOTP は、秒単位の UNIX 時間から「ステップ数」と呼ばれる値を計算し、その値をカウンタの値として HOTP を計算します。

「時間ステップ」は多くの場合 30 秒とされるため、ここでも 30 秒とします。

インストールが必要なパッケージ:

- `cryptonite`

```haskell
import Crypto.Hash (SHA1(..))
import Foreign.C.Types (CTime(..))
import System.Posix.Time (epochTime)

import qualified Crypto.OTP as OTP
import qualified Data.ByteString.Char8 as BSC

-- 
showOTP :: Int -> OTP.OTP -> String
showOTP digits otp = otpStringPadded
  where
    otpString = show otp
    otpStringPadded = replicate (digits - length otpString) '0' ++ otpString

-- 
timeStep :: Num a => a
timeStep = 30

-- 
getOTPTime :: IO OTP.OTPTime
getOTPTime = fromIntegral . (\(CTime t) -> t) <$> epochTime
```

Haskell では `epochTime` を用いて秒単位の UNIX 時間を取得できます。

参考「[epochTime - System.Posix.Time](https://hackage.haskell.org/package/unix-2.8.2.1/docs/System-Posix-Time.html#v:epochTime)」

`cryptonite` パッケージを用いて HOTP を計算できます。

参考「[cryptonite: Cryptography Primitives sink](https://hackage.haskell.org/package/cryptonite-0.30)」
参考「[totp - Crypto.OTP](https://hackage.haskell.org/package/cryptonite-0.30/docs/Crypto-OTP.html#v:totp)」

```haskell:例
-- 
main :: IO ()
main = do

    -- TOTP を計算する
    let seed = BSC.pack "\221\RS&%\168\218\DEL\163\184k\128\158\217 \200h\143S\131F"

    totpParams <- either error pure $ OTP.mkTOTPParams SHA1 0 timeStep OTP.OTP6 OTP.NoSkew

    otpTime <- getOTPTime

    let totp = showOTP 6 $ OTP.totp totpParams seed otpTime
    putStrLn totp

    print $ OTP.totpVerify totpParams seed otpTime $ read totp
```

```text:例の実行結果の例
524240
True
```

# 4. Google Authenticator で HOTP または TOTP を利用する

Google Authenticator の「セットアップキーを入力 (Enter a setup key)」から、前述の `seedString` の値を入力し、「カウンタベース (Counter based)」または「時間ベース (Time based)」を選択することで、Google Authenticator 上にコードが表示されるようになります。

HOTP の場合、カウンタが同期されていれば前述のコードの `hotp` の値と一致します。

TOTP の場合、時刻がしっかり同期されていれば前述のコードの `totp` の値と一致します。

※ HOTP または TOTP 用の QR コードの生成方法は後述。

# 5. TOTP で時間のズレを許容する

本記事では深く触れませんが、前回や次回の TOTP を許容することで多少の時間のズレがあってもコードを受け入れることができます。

```haskell:例
-- 
main :: IO ()
main = do

    -- TOTP を計算する
    let seed = BSC.pack "\221\RS&%\168\218\DEL\163\184k\128\158\217 \200h\143S\131F"

    totpParams <- either error pure $ OTP.mkTOTPParams SHA1 0 timeStep OTP.OTP6 OTP.OneStep

    otpTime <- getOTPTime

    let totpPrev = showOTP 6 $ OTP.totp totpParams seed $ otpTime - timeStep
    putStrLn totpPrev

    let totp = showOTP 6 $ OTP.totp totpParams seed otpTime
    putStrLn totp

    let totpNext = showOTP 6 $ OTP.totp totpParams seed $ otpTime + timeStep
    putStrLn totpNext

    print $ OTP.totpVerify totpParams seed otpTime $ read totpPrev
    print $ OTP.totpVerify totpParams seed otpTime $ read totp
    print $ OTP.totpVerify totpParams seed otpTime $ read totpNext
```

```text:例の実行結果の例
262912
147845
014180
True
True
True
```

前回や次回の TOTP を許容は、`cryptonite` パッケージ `Crypto.OTP` モジュールの `TOTPParams` で `ClockSkew` の値を指定します。

参考「[mkTOTPParams - Crypto.OTP](https://hackage.haskell.org/package/cryptonite-0.30/docs/Crypto-OTP.html#v:mkTOTPParams)」
参考「[ClockSkew - Crypto.OTP](https://hackage.haskell.org/package/cryptonite-0.30/docs/Crypto-OTP.html#t:ClockSkew)」

# 6. HOTP または TOTP 用の QR コードを生成する

鍵等をやり取りするために「otpauth URI」が用いられます。

otpauth URI を QR コードにすることで Google Authenticator 等で読み込めるようになります。

TOTP の場合は以下のようにして otpauth URI を生成できます。

インストールが必要なパッケージ:

- `network-uri`

```haskell:例
import Network.URI (escapeURIString, isUnescapedInURIComponent)

-- 
timeStep :: Num a => a
timeStep = 30

-- 
encodeURIComponent :: String -> String
encodeURIComponent = escapeURIString isUnescapedInURIComponent

-- 
main :: IO ()
main = do

    -- 
    let seedString = "3UPCMJNI3J72HODLQCPNSIGINCHVHA2G"

    -- otpauth URI を生成する
    let issuer = encodeURIComponent "Test Issuer"
    let accountname = encodeURIComponent "Test Account Name"

    let otpType = "totp"
    let label = concat [issuer, ":", accountname]
    let period = show (timeStep :: Word)
    let parameters = concat
            ["secret=", seedString, "&issuer=", issuer, "&algorithm=SHA1&digits=6&period=", period]

    let otpauthURI = concat ["otpauth://", otpType, "/", label, "?", parameters]

    putStrLn otpauthURI
```

```text:例の実行結果
otpauth://totp/Test%20Issuer:Test%20Account%20Name?secret=3UPCMJNI3J72HODLQCPNSIGINCHVHA2G&issuer=Test%20Issuer&algorithm=SHA1&digits=6&period=30
```

参考「[Key Uri Format · google/google-authenticator Wiki · GitHub](https://github.com/google/google-authenticator/wiki/Key-Uri-Format)」

# 7. おまけ: HOTP および TOTP の計算処理を自作する

## 7.1. HOTP を計算する

「カウンタ」はビッグエンディアン形式で長さは 8 バイトとします。

インストールが必要なパッケージ:

- `cryptonite`
- `memory`

```haskell
import Crypto.Hash (SHA1)
import Crypto.MAC.HMAC (hmac, HMAC)
import Data.Bits (Bits, (.&.), (.<<.), (.|.))
import Data.ByteArray (ByteArrayAccess)
import Data.Foldable (foldl')
import Data.Word (Word32)

import qualified Data.ByteArray as BA
import qualified Data.ByteString.Char8 as BSC

-- | ByteArray をビッグエンディアン形式で数値に変換する
fromByteArrayBE :: (ByteArrayAccess a, Num b, Bits b) => a -> b
fromByteArrayBE = foldl' (\x byte -> x .<<. 8 .|. fromIntegral byte) 0 . BA.unpack

-- | 動的切り捨てする
dynamicTruncate :: ByteArrayAccess a => a -> Word32
dynamicTruncate digest = binaryMasked
  where

    -- 下位 4 ビットを offset とする
    -- BA.length digest == 20
    offset = fromIntegral $ BA.index digest 19 .&. 0xf

    -- offset から 4 バイトの数値を得る
    binary = fromByteArrayBE $ BA.view digest offset 4

    -- 符号有無の混乱を防ぐために最上位ビットを除外する
    binaryMasked = binary .&. 0x7fffffff

{- | HOTP を計算する

カウンタはビッグエンディアンで 8 バイト
-}
generateHOTP :: (ByteArrayAccess a, ByteArrayAccess b) => a -> b -> String
generateHOTP seed counter = otpStringPadded
  where

    digestHMAC :: HMAC SHA1 = hmac seed counter

    otp = dynamicTruncate digestHMAC `rem` 1000000

    otpString = show otp

    otpStringPadded = replicate (6 - length otpString) '0' ++ otpString
```

Haskell では `cryptonite` パッケージを用いて `HMAC-SHA-1` ハッシュ値を計算できます。

参考「[cryptonite: Cryptography Primitives sink](https://hackage.haskell.org/package/cryptonite-0.30)」
参考「[Crypto.MAC.HMAC](https://hackage.haskell.org/package/cryptonite-0.30/docs/Crypto-MAC-HMAC.html)」

`HMAC-SHA-1` ハッシュ値の長さは 20 バイトですが、HOTP の長さをそこまで長くしないため、RFC 4226 で定義されている「動的切り捨て (dynamic truncation)」を行って 4 バイトの長さの値を得ます (下位 4 ビットをオフセットとみなし、そのオフセットから長さ 4 バイトを切り出す) 。

また、32 ビットの値の符号有無により後の計算結果が異なることを防ぐため、最上位ビットを除外して 31 ビットの値にします。

HOTP の桁数を 6 にするため、$10^6 = 1000000$ で割った余りを求めます。

参考「[5.3. Generating an HOTP Value - RFC 4226 - HOTP: An HMAC-Based One-Time Password Algorithm 日本語訳](https://tex2e.github.io/rfc-translater/html/rfc4226.html#5-3--Generating-an-HOTP-Value)」

```haskell:例
-- 
main :: IO ()
main = do

    -- HOTP を計算する
    let seed = BSC.pack "\221\RS&%\168\218\DEL\163\184k\128\158\217 \200h\143S\131F"

    let counter = BSC.pack "\0\0\0\0\0\0\0\1"

    let hotp = generateHOTP seed counter
    putStrLn hotp
```

```text:例の実行結果
836609
```

※ HOTP を実用的に使うは別途「ブルートフォース攻撃対策」や「カウンタ再同期」の機能を実装する必要があります。

参考「[7. Security Requirements - RFC 4226 - HOTP: An HMAC-Based One-Time Password Algorithm 日本語訳](https://tex2e.github.io/rfc-translater/html/rfc4226.html#7--Security-Requirements)」

## 7.2. TOTP を計算する

「ステップ数」は UNIX 時間を「時間ステップ」と呼ばれる時間で割った商です。

インストールが必要なパッケージ:

- `memory`

```haskell
import Data.ByteArray (ByteArrayAccess)
import Data.Int (Int64)
import Foreign.C.Types (CTime(..))
import System.Posix.Time (epochTime)

import qualified Data.ByteString.Builder as BSB
import qualified Data.ByteString.Char8 as BSC

-- 
getCurrentSteps :: IO Int64
getCurrentSteps = do

    CTime epochTimeInt64 <- epochTime

    pure $ epochTimeInt64 `div` timeStep

-- | TOTP を計算する
generateTOTP :: ByteArrayAccess a => a -> Int64 -> String
generateTOTP seed steps = otpString
  where

    stepsByteString = BSC.toStrict . BSB.toLazyByteString . BSB.int64BE $ steps

    otpString = generateHOTP seed stepsByteString
```

Haskell では `epochTime` を用いて秒単位の UNIX 時間を取得できます。

参考「[epochTime - System.Posix.Time](https://hackage.haskell.org/package/unix-2.8.2.1/docs/System-Posix-Time.html#v:epochTime)」

前述の通り HOTP のカウンタは 8 バイトの長さで扱うため、ステップ数を 8 バイトにします。

```haskell:例
-- 
main :: IO ()
main = do

    -- TOTP を計算する
    let seed = BSC.pack "\221\RS&%\168\218\DEL\163\184k\128\158\217 \200h\143S\131F"

    totp <- generateTOTP seed <$> getCurrentSteps
    putStrLn totp
```

```text:例の実行結果の例
524240
```

## 7.3. TOTP で時間のズレを許容する

```haskell:例
-- 
main :: IO ()
main = do

    -- TOTP を計算する
    let seed = BSC.pack "\221\RS&%\168\218\DEL\163\184k\128\158\217 \200h\143S\131F"

    steps <- getCurrentSteps

    let totpPrev = generateTOTP seed $ steps - 1
    putStrLn totpPrev

    let totp = generateTOTP seed steps
    putStrLn totp

    let totpNext = generateTOTP seed $ steps + 1
    putStrLn totpNext
```

```text:例の実行結果の例
262912
147845
014180
```

---

※QRコードは株式会社デンソーウェーブの登録商標です。