TOTP in Red: One-time password generation library compatible with Google Authenticator

totp.red

Red [
  Title: "TOTP library compatible with Google Authenticator"
  Author: "@plugnburn"
  notes {
    Implements Google Authenticator-compatible TOTP algorithm.
    Usage:
    totp-b32 KEY ; generate a one-time password for string! key in Base32
    totp-bin KEY ; generate a one-time password for binary! key
    totp-genkey ; generate a random key and return it in the Base32 format
    totp-genkey/pass PASSWORD ; generate a key from a password and return it in the Base32 format

    Original Base32 library implementation: Graham Chiu, Boleslav Březovský
  }
]

totp-base32: func [st /decode] [
  accepted: "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567"
  base2: [16 8 4 2 1]
  rejoin either not decode [
    b2: enbase/base st 2
    collect [
      while [not empty? b2][
        five: take/part b2 5
        offset: 0
        repeat i 5 [
          if #"1" = take five [
            offset: offset + base2/:i
          ]
        ]
        keep pick accepted offset + 1
      ]
    ]
  ][
    str: copy st
    result: rejoin collect [
      while [not empty? st][
        keep rejoin collect [
          index: -1 + index? find accepted form take st 
          repeat i 5 [
            keep either positive? index AND base2/:i ["1"]["0"]
          ]
        ]
      ]
    ]
    collect [
      while [not empty? result][
        attempt [
          keep debase/base take/part result 8 2
        ]
      ]
    ]
  ]
]

totp-bin: func [K /local C H O I] [
  C: reverse #{0000000000000000} xor reverse to-binary to-integer (to-integer now) / 30
  H: checksum/with C 'SHA1 K
  O: mod to-integer H/20 16
  I: to-string 1000000 + mod ((to-integer copy/part skip H O 4) and to-integer #7FFFFFFF) 1000000
  copy/part at I 2 6
]

totp-b32: func [K] [totp-bin totp-base32/decode K]

totp-genkey: func [/pass pwd] [
  totp-base32 either not pass [
    random/seed now
    checksum/with random/secure "abcdefghijklmnopqrstuv0123456789ABCDEFGHIJKLMNOPQRTSUVWXYZ" 'SHA1 to-binary to-integer now
  ] [
    checksum pwd 'SHA1
  ]
]