module Network.WindowsLive.Login
(
getLoginUrl
, getLogoutUrl
, baseUrl
, secureUrl
, processToken
, User(..)
)
where
import Control.Monad ( liftM, ap, unless )
import Control.Monad.Error ( MonadError )
import Data.Char ( isDigit )
import Data.Maybe ( fromJust )
import Data.Time.Clock.POSIX ( POSIXTime )
import Network.URI ( URI, parseURI, parseRelativeReference )
import Network.WindowsLive.App ( App, appId, decode )
import qualified Data.URLEncoded as URLEnc
import Data.URLEncoded ( (%=), (%=?), (%?), (%&) )
baseUrl :: URI
Just baseUrl = parseURI "http://login.live.com/"
secureUrl :: URI
Just secureUrl = parseURI "https://login.live.com/"
appIdQ :: App -> URLEnc.URLEncoded
appIdQ = ("appid" %=) . appId
relUri :: String -> URI
relUri = fromJust . parseRelativeReference
getLoginUrl :: App
-> Maybe String
-> Maybe String
-> URI
getLoginUrl app ctx mkt =
relUri "wlogin.srf" %? appIdQ app %& "alg" %= "wsignin1.0"
%& "appctx" %=? ctx %& "mkt" %=? mkt
getLogoutUrl :: App -> Maybe String
-> URI
getLogoutUrl app mkt = relUri "logout.srf" %? appIdQ app %& "mkt" %=? mkt
data User = User { userID :: String
, userTimestamp :: POSIXTime
} deriving Show
processToken :: MonadError e m => App -> String -> m User
processToken app encryptedToken = do
q <- decode app encryptedToken
let qval k = URLEnc.lookup1 k q
qAppID <- qval "appid"
unless (appId app == qAppID) $
fail $ "Expected AppID " ++ show (appId app)
++ " but got " ++ show qAppID
User `liftM` qval "uid" `ap` (parseTimestamp =<< qval "ts")
parseTimestamp :: MonadError e m => String -> m POSIXTime
parseTimestamp ts = do
unless (all isDigit ts && not (null ts)) $
fail $ "Bad timestamp value: " ++ show ts
return $ fromInteger $ read ts