module Network.WindowsLive.Login
(
getLoginUrl
, getLogoutUrl
, baseUrl
, secureUrl
, processToken
, User(..)
)
where
import Data.Char ( isDigit )
import Control.Monad ( liftM, ap, unless )
import Control.Monad.Error ( MonadError )
import Data.Time.Clock.POSIX ( POSIXTime )
import Network.WindowsLive.Token
import Network.URI ( URI, parseURI, parseRelativeReference )
import Data.Monoid ( mconcat )
import qualified Network.WindowsLive.Query as Query
import Network.WindowsLive.Query ( (%=), (%=?) )
baseUrl :: URI
Just baseUrl = parseURI "http://login.live.com/"
secureUrl :: URI
Just secureUrl = parseURI "https://login.live.com/"
appIdQ :: App -> Query.Query
appIdQ = ("appid" %=) . appId
getLoginUrl :: App
-> Maybe String
-> Maybe String
-> URI
getLoginUrl app ctx mkt =
let Just u = parseRelativeReference "wlogin.srf"
loginQuery = mconcat [ appIdQ app
, "alg" %= "wsignin1.0"
, "appctx" %=? ctx
, "mkt" %=? mkt
]
in Query.addToURI loginQuery u
getLogoutUrl :: App -> Maybe String
-> URI
getLogoutUrl app mkt =
let Just u = parseRelativeReference "logout.srf"
logoutQuery = mconcat [ appIdQ app, "mkt" %=? mkt ]
in Query.addToURI logoutQuery u
data User = User { userID :: String
, userTimestamp :: POSIXTime
} deriving Show
processToken :: MonadError e m => App -> String -> m User
processToken app encryptedToken = do
tok <- decodeToken app encryptedToken
validateToken app tok
q <- Query.parse tok
let qval k = Query.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