module OTP ( otpNew
           , otpCheck
           , otpCheckGeneral ) where

import System.Random
import MD5
import System.Directory
import System.Time

--- customize one time password "db" (folder of little text files)
otpFolder = "/home/protected/webdata/otps"
expires seconds = TimeDiff { tdSec = seconds, tdMin = 0, tdYear = 0, tdMonth = 0, tdDay = 0, tdHour = 0, tdPicosec = 0 }
----------------

createDirectoryIfMissing d = do
   b <- doesDirectoryExist d
   if b
      then return ()
      else createDirectory d

tryExpire :: FilePath -> IO ()
tryExpire name = do
   let fp = otpFolder ++ "/" ++ name
   caltimestr <- readFile fp
   let caltime = (read caltimestr) :: CalendarTime
   let expiretime = toClockTime caltime
   now <- getClockTime
   if now > expiretime
     then removeFile fp
     else return ()

checkForExpiration :: IO ()
checkForExpiration = do
   OTP.createDirectoryIfMissing otpFolder
   fs <- getDirectoryContents otpFolder
   let files = filter (\x->x/="." && x/="..") fs
   mapM_ tryExpire files

otpRand :: IO String
otpRand = do
   r <- randomIO
   let s = show (r::Int)
   let m = md5 s
   return m

-- | Exported functions

otpCheck :: String -> IO Bool
otpCheck s = otpCheckGeneral s id

otpNew :: Int -> IO String
otpNew seconds = otpNewGeneral seconds id

otpCheckGeneral :: String -> (String->String) -> IO Bool
otpCheckGeneral s fun = do
   checkForExpiration
   fs <- getDirectoryContents otpFolder
   let files = filter (\x->x/="." && x/="..") fs
   return $ s `elem` (map fun files)

otpNewGeneral :: Int -> (String->String) -> IO String
otpNewGeneral seconds fun = do
   checkForExpiration
   fs <- getDirectoryContents otpFolder
   let files = filter (\x->x/="." && x/="..") fs
   ct <- getClockTime
   let ct' = expires seconds `addToClockTime` ct
   let calt = toUTCTime ct'
   let timestr = show calt
   rand <- otpRand
   let r = fun rand
   if r `elem` files
     then otpNewGeneral seconds fun -- already taken (unlikely) -- try again!
     else do let f = otpFolder ++ "/" ++ r
             writeFile f timestr
             return r