windowslive 0.1.0 → 0.1.1
raw patch · 6 files changed
+26/−97 lines, 6 filesdep +urlencoded
Dependencies added: urlencoded
Files
- src/Network/WindowsLive/ConsentToken.hs +8/−7
- src/Network/WindowsLive/Login.hs +7/−7
- src/Network/WindowsLive/Query.hs +0/−71
- src/Network/WindowsLive/Token.hs +4/−4
- test/Test.hs +4/−4
- windowslive.cabal +3/−4
src/Network/WindowsLive/ConsentToken.hs view
@@ -24,8 +24,8 @@ import Data.List ( intersperse ) import Data.Monoid ( mconcat ) import Data.Time.Clock.POSIX ( POSIXTime )-import Network.WindowsLive.Query ( (%=), (%=?) )-import qualified Network.WindowsLive.Query as Query+import Data.URLEncoded ( (%=), (%=?) )+import qualified Data.URLEncoded as URLEnc import Network.WindowsLive.Token import Network.URI ( parseURI, URI, parseRelativeReference, unEscapeString ) import Text.Parsec ( parse, many1, char, eof, satisfy, sepBy1 )@@ -80,14 +80,14 @@ getConsentUrl :: App -> POSIXTime -> ConsentQuery -> URI getConsentUrl app ts cq = let Just pth = parseRelativeReference "Delegation.aspx"- q = mconcat [ "app" %= Query.toQueryString (appVerifier app ts)+ q = mconcat [ "app" %= URLEnc.export (appVerifier app ts) , "ru" %= (show $ qReturn cq) , "pl" %= (show $ qPolicy cq) , "appctx" %=? qContext cq , "mkt" %=? qMarket cq , "ps" %= offerStr (qOffers cq) "" ]- in Query.addToURI q pth+ in URLEnc.addToURI q pth offerStr :: [OfferType] -> ShowS offerStr = foldr (.) id . intersperse (';':) . map shows@@ -128,11 +128,12 @@ -- does not check to see if the token has expired. processConsentToken :: MonadError e m => App -> String -> m ConsentToken processConsentToken app ct = do- encodedToken <- Query.parse (unEscapeString ct) >>= Query.lookup1 "eact"+ encodedToken <- URLEnc.importString (unEscapeString ct)+ >>= URLEnc.lookup1 "eact" decoded <- decodeToken app encodedToken validateToken app decoded- tok <- Query.parse decoded- let arg n = Query.lookup1 n tok+ tok <- URLEnc.importString decoded+ let arg n = URLEnc.lookup1 n tok ofrs = parseOffers =<< arg "offer" expr = do expStr <- arg "exp" when (null expStr) $ fail "Empty expiration!"
src/Network/WindowsLive/Login.hs view
@@ -21,8 +21,8 @@ import Network.URI ( URI, parseURI, parseRelativeReference ) import Data.Monoid ( mconcat ) -import qualified Network.WindowsLive.Query as Query-import Network.WindowsLive.Query ( (%=), (%=?) )+import qualified Data.URLEncoded as URLEnc+import Data.URLEncoded ( (%=), (%=?) ) baseUrl :: URI Just baseUrl = parseURI "http://login.live.com/"@@ -30,7 +30,7 @@ secureUrl :: URI Just secureUrl = parseURI "https://login.live.com/" -appIdQ :: App -> Query.Query+appIdQ :: App -> URLEnc.URLEncoded appIdQ = ("appid" %=) . appId -- |Generate a /relative/ authentication start URL@@ -46,7 +46,7 @@ , "appctx" %=? ctx , "mkt" %=? mkt ]- in Query.addToURI loginQuery u+ in URLEnc.addToURI loginQuery u -- |Generate a /relative/ sign out URL getLogoutUrl :: App -> Maybe String -- ^The locale in which to display@@ -55,7 +55,7 @@ getLogoutUrl app mkt = let Just u = parseRelativeReference "logout.srf" logoutQuery = mconcat [ appIdQ app, "mkt" %=? mkt ]- in Query.addToURI logoutQuery u+ in URLEnc.addToURI logoutQuery u data User = User { userID :: String , userTimestamp :: POSIXTime@@ -67,8 +67,8 @@ processToken app encryptedToken = do tok <- decodeToken app encryptedToken validateToken app tok- q <- Query.parse tok- let qval k = Query.lookup1 k q+ q <- URLEnc.importString tok+ let qval k = URLEnc.lookup1 k q qAppID <- qval "appid" unless (appId app == qAppID) $
− src/Network/WindowsLive/Query.hs
@@ -1,71 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-module Network.WindowsLive.Query- ( parse- , fromList- , empty- , null- , keys- , Query- , lookup1- , (%=)- , (%=?)- , addToURI- , toQueryString- )-where--import qualified Prelude-import Prelude hiding ( null )-import Data.List.Split ( splitOn )-import Control.Monad ( liftM )-import Control.Arrow ( (>>>) )-import Control.Monad.Error ( MonadError )-import Network.URI ( unEscapeString, escapeURIString, isUnreserved, URI(uriQuery) )-import Data.Monoid ( Monoid )-import Data.List ( intercalate )--newtype Query = Query { pairs :: [(String, String)] }- deriving (Monoid, Show)--null :: Query -> Bool-null = Prelude.null . pairs--empty :: Query-empty = Query []--fromList :: [(String, String)] -> Query-fromList = Query--keys :: Query -> [String]-keys = map fst . pairs--(%=) :: String -> String -> Query-k %= v = Query [(k, v)]--(%=?) :: String -> Maybe String -> Query-k %=? v = maybe empty (k %=) v--addToURI :: Query -> URI -> URI-addToURI q u =- let initialChar = if Prelude.null (uriQuery u) then '?' else '&'- in u { uriQuery = uriQuery u ++ (initialChar:toQueryString q) }--toQueryString :: Query -> String-toQueryString q =- let esc = escapeURIString isUnreserved- encodePair (k, v) = esc k ++ "=" ++ esc v- in intercalate "&" $ map encodePair $ pairs q--parse :: MonadError e m => String -> m Query-parse = splitOn "&" >>> mapM parsePair >>> liftM Query- where parsePair p =- case break (== '=') p of- (_, []) -> fail $ "Missing value in query string: " ++ show p- (k, '=':v) -> return ( unEscapeString k- , unEscapeString v- )- unknown -> error $ "impossible: " ++ show unknown--lookup1 :: MonadError e m => String -> Query -> m String-lookup1 k = pairs >>> Prelude.lookup k >>> maybe missing return- where missing = fail $ "Missing query arg: " ++ show k
src/Network/WindowsLive/Token.hs view
@@ -30,8 +30,8 @@ import Data.Monoid ( mconcat, mappend ) import Data.Time.Clock.POSIX ( POSIXTime ) import Network.URI ( unEscapeString )-import Network.WindowsLive.Query ( (%=) )-import qualified Network.WindowsLive.Query as Query+import Data.URLEncoded ( (%=) )+import qualified Data.URLEncoded as URLEnc import qualified Text.Parsec as Parsec import Text.PrettyPrint.HughesPJ ( text, (<+>), char ) @@ -135,11 +135,11 @@ -- |Generate an application verifier to prove to the server that we -- know the secret and application ID-appVerifier :: App -> POSIXTime -> Query.Query+appVerifier :: App -> POSIXTime -> URLEnc.URLEncoded appVerifier app ts = let q = mconcat [ "appid" %= appId app , "ts" %= show (round ts :: Integer) ]- token = Query.toQueryString q+ token = URLEnc.export q sig = Base64.encode $ signToken (secret app) token in q `mappend` ("sig" %= sig)
test/Test.hs view
@@ -3,7 +3,7 @@ import Control.Monad.Error ( MonadError ) import qualified Network.WindowsLive.Token as Live-import qualified Network.WindowsLive.Query as Query+import qualified Data.URLEncoded as URLEnc import Network.WindowsLive.Login ( processToken, getLoginUrl, baseUrl ) import Network.WindowsLive.ConsentToken ( processConsentToken ) import Network.URI ( relativeTo, uriQuery )@@ -83,12 +83,12 @@ Just u -> return u q <- case uriQuery uri of- '?':qs -> Query.parse qs- "" -> Query.parse ""+ '?':qs -> URLEnc.importString qs+ "" -> URLEnc.importString "" unexpected -> fail $ "No ? at start of query string: " ++ show unexpected - let assertQ (k, v) = assertEqual k v =<< Query.lookup1 k q+ let assertQ (k, v) = assertEqual k v =<< URLEnc.lookup1 k q mapM_ assertQ [ ("appid", Live.appId app) , ("mkt", mkt) , ("appctx", ctx)
windowslive.cabal view
@@ -1,6 +1,6 @@ Name: windowslive Cabal-Version: >= 1.6-Version: 0.1.0+Version: 0.1.1 Synopsis: Implements Windows Live Web Authentication and Delegated Authentication @@ -30,14 +30,13 @@ split == 0.1.*, time == 1.1.*, parsec >= 3.0.0 && < 3.1,- HUnit == 1.2.*+ HUnit == 1.2.*,+ urlencoded HS-Source-Dirs: src Exposed-Modules: Network.WindowsLive.Token, Network.WindowsLive.Login, Network.WindowsLive.ConsentToken- Other-Modules:- Network.WindowsLive.Query -- This executable is not installed by the (custom) Setup program. It is -- used by the test hook (cabal test)