Last active
December 21, 2022 11:09
-
-
Save eungju/10379065 to your computer and use it in GitHub Desktop.
Google Authenticator in Haskell
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/env runghc | |
import qualified Codec.Binary.Base32 as Base32 | |
import Codec.Utils (i2osp, fromTwosComp) | |
import qualified Control.Arrow as Arrow | |
import Data.Bits | |
import Data.Char | |
import Data.Functor | |
import Data.HMAC | |
import Data.List.Split | |
import Data.Maybe | |
import Data.Time.Clock.POSIX | |
import Data.Word | |
import Network.URI | |
import System.Directory | |
import System.FilePath | |
import Text.Printf | |
parseParameter :: String -> (String, String) | |
parseParameter = Arrow.second (dropWhile (== '=')) . break (== '=') | |
parseQuery :: String -> [(String, String)] | |
parseQuery = map parseParameter . split (dropDelims $ oneOf "&") . dropWhile (== '?') | |
data Account = Account { username :: String, secret :: String | |
--, period :: Int, digits :: Int, algorithm :: String | |
} deriving (Eq, Show, Read) | |
parseAccount :: URI -> Maybe Account | |
parseAccount uri = Account (dropWhile (== '/') $ uriPath uri) | |
<$> map toUpper <$> lookup "secret" (parseQuery (uriQuery uri)) | |
bi2 :: (a -> b -> c) -> (a -> b -> d) -> (a, b) -> (c, d) | |
bi2 f g (x, y) = (f x y, g x y) | |
generatePassword :: Account -> POSIXTime -> (String, Int) | |
generatePassword account t = (pad code (6 :: Int), timeout) | |
where | |
key = fromJust $ Base32.decode $ secret account :: [Word8] | |
timeout = 30 - (round t `mod` 30) :: Int | |
message = i2osp 8 (round t `div` 30 :: Word64) :: [Word8] | |
hash = hmac_sha1 key message :: [Word8] | |
offset = fromIntegral $ last hash .&. 0x0F :: Int | |
truncatedHash = fromTwosComp $ take 4 $ drop offset hash :: Word32 | |
code = truncatedHash .&. 0x7FFFFFFF :: Word32 | |
pad i n = printf (printf "%%0%dd" n) (rem i (10 ^ n)) :: String | |
main :: IO () | |
main = do | |
t <- getPOSIXTime | |
dataPath <- (`combine` ".otp") <$> getHomeDirectory | |
lines <$> readFile dataPath >>= | |
mapM_ (\line -> case parseURI line >>= parseAccount of | |
Just account -> do | |
let (password, timeout) = generatePassword account t | |
printf "%-31s %s %02ds\n" (username account) password timeout | |
Nothing -> return ()) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment