authenticate-1.3.5.2/OpenId2/0000755000000000000000000000000014500472340013763 5ustar0000000000000000authenticate-1.3.5.2/Web/0000755000000000000000000000000014500472340013240 5ustar0000000000000000authenticate-1.3.5.2/Web/Authenticate/0000755000000000000000000000000014500472340015656 5ustar0000000000000000authenticate-1.3.5.2/Web/Authenticate/OpenId/0000755000000000000000000000000014500472340017034 5ustar0000000000000000authenticate-1.3.5.2/Web/Authenticate/Rpxnow.hs0000644000000000000000000000704714500472340017517 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveDataTypeable #-} --------------------------------------------------------- -- -- Module : Web.Authenticate.Rpxnow -- Copyright : Michael Snoyman -- License : BSD3 -- -- Maintainer : Michael Snoyman -- Stability : Unstable -- Portability : portable -- -- Facilitates authentication with "http://rpxnow.com/". -- --------------------------------------------------------- module Web.Authenticate.Rpxnow ( Identifier (..) , authenticate , AuthenticateException (..) ) where import Data.Aeson #if MIN_VERSION_aeson(2,2,0) import Data.Aeson.Parser (json) #endif import Network.HTTP.Conduit import Control.Monad.IO.Class import Data.Maybe import Control.Monad import qualified Data.ByteString.Char8 as S import qualified Data.ByteString.Lazy.Char8 as L import Web.Authenticate.Internal import Data.Data (Data) import Data.Typeable (Typeable) import Data.Attoparsec.Lazy (parse) import qualified Data.Attoparsec.Lazy as AT import Data.Text (Text) import qualified Data.Aeson.Types #if MIN_VERSION_aeson(2,0,0) import qualified Data.Aeson.KeyMap as Map import qualified Data.Aeson.Key as Key #else import qualified Data.HashMap.Lazy as Map #endif import Control.Applicative ((<$>), (<*>)) import Control.Exception (throwIO) -- | Information received from Rpxnow after a valid login. data Identifier = Identifier { identifier :: Text , extraData :: [(Text, Text)] } deriving (Eq, Ord, Read, Show, Data, Typeable) -- | Attempt to log a user in. authenticate :: MonadIO m => String -- ^ API key given by RPXNOW. -> String -- ^ Token passed by client. -> Manager -> m Identifier authenticate apiKey token manager = do let body = L.fromChunks [ "apiKey=" , S.pack apiKey , "&token=" , S.pack token ] req' <- liftIO $ parseUrlThrow "https://rpxnow.com" let req = req' { method = "POST" , path = "api/v2/auth_info" , requestHeaders = [ ("Content-Type", "application/x-www-form-urlencoded") ] , requestBody = RequestBodyLBS body } res <- httpLbs req manager let b = responseBody res o <- unResult $ parse json b --m <- fromMapping o let mstat = flip Data.Aeson.Types.parse o $ \v -> case v of Object m -> m .: "stat" _ -> mzero case mstat of Success "ok" -> return () Success stat -> liftIO $ throwIO $ RpxnowException $ "Rpxnow login not accepted: " ++ stat ++ "\n" ++ L.unpack b _ -> liftIO $ throwIO $ RpxnowException "Now stat value found on Rpxnow response" case Data.Aeson.Types.parse parseProfile o of Success x -> return x Error e -> liftIO $ throwIO $ RpxnowException $ "Unable to parse Rpxnow response: " ++ e unResult :: MonadIO m => AT.Result a -> m a unResult = either (liftIO . throwIO . RpxnowException) return . AT.eitherResult parseProfile :: Value -> Data.Aeson.Types.Parser Identifier parseProfile (Object m) = do profile <- m .: "profile" Identifier <$> (profile .: "identifier") <*> return (mapMaybe go (Map.toList profile)) where go ("identifier", _) = Nothing go (k, String v) = Just ( #if MIN_VERSION_aeson(2,0,0) Key.toText #endif k, v) go _ = Nothing parseProfile _ = mzero authenticate-1.3.5.2/Web/Authenticate/OpenId.hs0000644000000000000000000001406714500472340017400 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} module Web.Authenticate.OpenId ( -- * Functions getForwardUrl , authenticate , authenticateClaimed -- * Types , AuthenticateException (..) , Identifier (..) -- ** Response , OpenIdResponse , oirOpLocal , oirParams , oirClaimed ) where import Control.Monad.IO.Class import OpenId2.Normalization (normalize) import OpenId2.Discovery (discover, Discovery (..)) import OpenId2.Types import Control.Monad (unless) import qualified Data.Text as T import Data.Text.Lazy.Encoding (decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) import Data.Text.Lazy (toStrict) import Network.HTTP.Conduit ( parseUrlThrow, urlEncodedBody, responseBody, httpLbs , Manager ) import Control.Arrow ((***), second) import Data.List (unfoldr) import Data.Maybe (fromMaybe) import Data.Text (Text, pack, unpack) import Data.Text.Encoding (encodeUtf8, decodeUtf8) import Blaze.ByteString.Builder (toByteString) import Network.HTTP.Types (renderQueryText) import Control.Exception (throwIO) getForwardUrl :: MonadIO m => Text -- ^ The openid the user provided. -> Text -- ^ The URL for this application\'s complete page. -> Maybe Text -- ^ Optional realm -> [(Text, Text)] -- ^ Additional parameters to send to the OpenID provider. These can be useful for using extensions. -> Manager -> m Text -- ^ URL to send the user to. getForwardUrl openid' complete mrealm params manager = do let realm = fromMaybe complete mrealm claimed <- normalize $ T.strip openid' disc <- discover claimed manager let helper s q = return $ T.concat [ s , if "?" `T.isInfixOf` s then "&" else "?" , decodeUtf8 (toByteString $ renderQueryText False $ map (second Just) q) ] case disc of Discovery1 server mdelegate -> helper server $ ("openid.mode", "checkid_setup") : ("openid.identity", maybe (identifier claimed) id mdelegate) : ("openid.return_to", complete) : ("openid.realm", realm) : ("openid.trust_root", complete) : params Discovery2 (Provider p) (Identifier i) itype -> do let (claimed', identity') = case itype of ClaimedIdent -> (identifier claimed, i) OPIdent -> let x = "http://specs.openid.net/auth/2.0/identifier_select" in (x, x) helper p $ ("openid.ns", "http://specs.openid.net/auth/2.0") : ("openid.mode", "checkid_setup") : ("openid.claimed_id", claimed') : ("openid.identity", identity') : ("openid.return_to", complete) : ("openid.realm", realm) : params authenticate :: MonadIO m => [(Text, Text)] -> Manager -> m (Identifier, [(Text, Text)]) authenticate ps m = do x <- authenticateClaimed ps m return (oirOpLocal x, oirParams x) {-# DEPRECATED authenticate "Use authenticateClaimed" #-} data OpenIdResponse = OpenIdResponse { oirOpLocal :: Identifier , oirParams :: [(Text, Text)] , oirClaimed :: Maybe Identifier } authenticateClaimed :: MonadIO m => [(Text, Text)] -> Manager -> m OpenIdResponse authenticateClaimed params manager = do unless (lookup "openid.mode" params == Just "id_res") $ liftIO $ throwIO $ case lookup "openid.mode" params of Nothing -> AuthenticationException "openid.mode was not found in the params." (Just m) | m == "error" -> case lookup "openid.error" params of Nothing -> AuthenticationException "An error occurred, but no error message was provided." (Just e) -> AuthenticationException $ unpack e | otherwise -> AuthenticationException $ "mode is " ++ unpack m ++ " but we were expecting id_res." ident <- case lookup "openid.identity" params of Just i -> return i Nothing -> liftIO $ throwIO $ AuthenticationException "Missing identity" discOP <- normalize ident >>= flip discover manager let endpoint d = case d of Discovery1 p _ -> p Discovery2 (Provider p) _ _ -> p let params' = map (encodeUtf8 *** encodeUtf8) $ ("openid.mode", "check_authentication") : filter (\(k, _) -> k /= "openid.mode") params req' <- liftIO $ parseUrlThrow $ unpack $ endpoint discOP let req = urlEncodedBody params' req' rsp <- httpLbs req manager let rps = parseDirectResponse $ toStrict $ decodeUtf8With lenientDecode $ responseBody rsp claimed <- case lookup "openid.claimed_id" params of Nothing -> return Nothing Just claimed' -> do -- need to validate that this provider can speak for the given -- claimed identifier claimedN <- normalize claimed' discC <- discover claimedN manager return $ if endpoint discOP == endpoint discC then Just claimedN else Nothing case lookup "is_valid" rps of Just "true" -> return OpenIdResponse { oirOpLocal = Identifier ident , oirParams = rps , oirClaimed = claimed } _ -> liftIO $ throwIO $ AuthenticationException "OpenID provider did not validate" -- | Turn a response body into a list of parameters. parseDirectResponse :: Text -> [(Text, Text)] parseDirectResponse = map (pack *** pack) . unfoldr step . unpack where step [] = Nothing step str = case split (== '\n') str of (ps,rest) -> Just (split (== ':') ps,rest) split :: (a -> Bool) -> [a] -> ([a],[a]) split p as = case break p as of (xs,_:ys) -> (xs,ys) pair -> pair authenticate-1.3.5.2/Web/Authenticate/BrowserId.hs0000644000000000000000000000316714500472340020121 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE CPP #-} module Web.Authenticate.BrowserId ( browserIdJs , checkAssertion ) where import Data.Text (Text) import Network.HTTP.Conduit (parseUrlThrow, responseBody, httpLbs, Manager, method, urlEncodedBody) #if MIN_VERSION_aeson(2,2,0) import Data.Aeson (Value (Object, String)) import Data.Aeson.Parser (json) #else import Data.Aeson (json, Value (Object, String)) #endif import Data.Attoparsec.Lazy (parse, maybeResult) #if MIN_VERSION_aeson(2,0,0) import qualified Data.Aeson.KeyMap as Map #else import qualified Data.HashMap.Lazy as Map #endif import Data.Text.Encoding (encodeUtf8) import Control.Monad.IO.Class (MonadIO, liftIO) -- | Location of the Javascript file hosted by browserid.org browserIdJs :: Text browserIdJs = "https://login.persona.org/include.js" checkAssertion :: MonadIO m => Text -- ^ audience -> Text -- ^ assertion -> Manager -> m (Maybe Text) checkAssertion audience assertion manager = do req' <- liftIO $ parseUrlThrow "https://verifier.login.persona.org/verify" let req = urlEncodedBody [ ("audience", encodeUtf8 audience) , ("assertion", encodeUtf8 assertion) ] req' { method = "POST" } res <- httpLbs req manager let lbs = responseBody res return $ maybeResult (parse json lbs) >>= getEmail where getEmail (Object o) = case (Map.lookup "status" o, Map.lookup "email" o) of (Just (String "okay"), Just (String e)) -> Just e _ -> Nothing getEmail _ = Nothing authenticate-1.3.5.2/Web/Authenticate/OpenId/Providers.hs0000644000000000000000000000217514500472340021352 0ustar0000000000000000-- | OpenIDs for a number of common OPs. When a function takes a 'String' -- parameter, that 'String' is the username. module Web.Authenticate.OpenId.Providers ( google , yahoo , livejournal , myspace , wordpress , blogger , verisign , typepad , myopenid , claimid ) where google :: String google = "https://www.google.com/accounts/o8/id" {-# DEPRECATED google "Google no longer provides OpenID support" #-} yahoo :: String yahoo = "http://me.yahoo.com/" livejournal :: String -> String livejournal u = concat ["http://", u, ".livejournal.com/"] myspace :: String -> String myspace = (++) "http://www.myspace.com/" wordpress :: String -> String wordpress u = concat ["http://", u, ".wordpress.com/"] blogger :: String -> String blogger u = concat ["http://", u, ".blogger.com/"] verisign :: String -> String verisign u = concat ["http://", u, ".pip.verisignlabs.com/"] typepad :: String -> String typepad u = concat ["http://", u, ".typepad.com/"] myopenid :: String -> String myopenid u = concat ["http://", u, ".myopenid.com/"] claimid :: String -> String claimid = (++) "http://claimid.com/" authenticate-1.3.5.2/Web/Authenticate/Internal.hs0000644000000000000000000000064114500472340017767 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} module Web.Authenticate.Internal ( AuthenticateException (..) ) where import Data.Typeable (Typeable) import Control.Exception (Exception) data AuthenticateException = RpxnowException String | NormalizationException String | DiscoveryException String | AuthenticationException String deriving (Show, Typeable) instance Exception AuthenticateException authenticate-1.3.5.2/OpenId2/Discovery.hs0000644000000000000000000001373314500472340016275 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} -------------------------------------------------------------------------------- -- | -- Module : Network.OpenID.Discovery -- Copyright : (c) Trevor Elliott, 2008 -- License : BSD3 -- -- Maintainer : Trevor Elliott -- Stability : -- Portability : -- module OpenId2.Discovery ( -- * Discovery discover , Discovery (..) ) where -- Friends import OpenId2.Types import OpenId2.XRDS -- Libraries import Data.Char import Data.Maybe import Network.HTTP.Conduit import qualified Data.ByteString.Char8 as S8 import Control.Arrow (first) import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad (mplus, liftM, guard) import qualified Data.CaseInsensitive as CI import Data.Text (Text, unpack) import Data.Text.Lazy (toStrict) import qualified Data.Text as T import Data.Text.Lazy.Encoding (decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) import Control.Applicative ((<$>), (<*>)) import Network.HTTP.Types (status200) import Control.Exception (throwIO) import Text.HTML.DOM import Text.XML.Cursor import Text.XML (Node (..), Element (..)) import qualified Data.Map as Map data Discovery = Discovery1 Text (Maybe Text) | Discovery2 Provider Identifier IdentType deriving Show -- | Attempt to resolve an OpenID endpoint, and user identifier. discover :: MonadIO m => Identifier -> Manager -> m Discovery discover ident@(Identifier i) manager = do res1 <- discoverYADIS ident Nothing 10 manager case res1 of Just (x, y, z) -> return $ Discovery2 x y z Nothing -> do res2 <- discoverHTML ident manager case res2 of Just x -> return x Nothing -> liftIO $ throwIO $ DiscoveryException $ unpack i -- YADIS-Based Discovery ------------------------------------------------------- -- | Attempt a YADIS based discovery, given a valid identifier. The result is -- an OpenID endpoint, and the actual identifier for the user. discoverYADIS :: MonadIO m => Identifier -> Maybe String -> Int -- ^ remaining redirects -> Manager -> m (Maybe (Provider, Identifier, IdentType)) discoverYADIS _ _ 0 _ = #if MIN_VERSION_http_conduit(2, 2, 0) error "discoverYADIS: Too many redirects" #else liftIO $ throwIO $ TooManyRedirects #if MIN_VERSION_http_conduit(1,6,0) [] #endif #endif discoverYADIS ident mb_loc redirects manager = do let uri = fromMaybe (unpack $ identifier ident) mb_loc #if MIN_VERSION_http_conduit(2, 2, 0) req <- liftIO $ parseRequest uri #else req <- liftIO $ parseUrl uri #endif res <- httpLbs req #if !MIN_VERSION_http_conduit(2, 2, 0) #if MIN_VERSION_http_conduit(1, 9, 0) { checkStatus = \_ _ _ -> Nothing #else { checkStatus = \_ _ -> Nothing #endif } #endif manager let mloc = fmap S8.unpack $ lookup "x-xrds-location" $ map (first $ map toLower . S8.unpack . CI.original) $ responseHeaders res let mloc' = if mloc == mb_loc then Nothing else mloc if responseStatus res == status200 then case mloc' of Just loc -> discoverYADIS ident (Just loc) (redirects - 1) manager Nothing -> do let mdoc = parseXRDS $ responseBody res case mdoc of Just doc -> return $ parseYADIS ident doc Nothing -> return Nothing else return Nothing -- | Parse out an OpenID endpoint, and actual identifier from a YADIS xml -- document. parseYADIS :: Identifier -> XRDS -> Maybe (Provider, Identifier, IdentType) parseYADIS ident = listToMaybe . mapMaybe isOpenId . concat where isOpenId svc = do let tys = serviceTypes svc localId = maybe ident Identifier $ listToMaybe $ serviceLocalIDs svc f (x,y) | x `elem` tys = Just y | otherwise = Nothing (lid, itype) <- listToMaybe $ mapMaybe f [ ("http://specs.openid.net/auth/2.0/server", (ident, OPIdent)) -- claimed identifiers , ("http://specs.openid.net/auth/2.0/signon", (localId, ClaimedIdent)) , ("http://openid.net/signon/1.0" , (localId, ClaimedIdent)) , ("http://openid.net/signon/1.1" , (localId, ClaimedIdent)) ] uri <- listToMaybe $ serviceURIs svc return (Provider uri, lid, itype) -- HTML-Based Discovery -------------------------------------------------------- -- | Attempt to discover an OpenID endpoint, from an HTML document. The result -- will be an endpoint on success, and the actual identifier of the user. discoverHTML :: MonadIO m => Identifier -> Manager -> m (Maybe Discovery) discoverHTML ident'@(Identifier ident) manager = do req <- liftIO $ parseUrlThrow $ unpack ident lbs <- liftM responseBody $ httpLbs req manager return $ parseHTML ident' . toStrict . decodeUtf8With lenientDecode $ lbs -- | Parse out an OpenID endpoint and an actual identifier from an HTML -- document. parseHTML :: Identifier -> Text -> Maybe Discovery parseHTML ident text0 = do let doc = parseSTChunks [text0] cursor = fromDocument doc links = map node $ cursor $// element "link" ls = do NodeElement (Element "link" as _) <- links Just rel <- pure $ Map.lookup "rel" as Just href <- pure $ Map.lookup "href" as guard $ "openid" `T.isPrefixOf` rel pure (rel, href) resolve ls where resolve1 ls = do server <- lookup "openid.server" ls let delegate = lookup "openid.delegate" ls return $ Discovery1 server delegate resolve2 ls = do prov <- lookup "openid2.provider" ls let lid = maybe ident Identifier $ lookup "openid2.local_id" ls -- Based on OpenID 2.0 spec, section 7.3.3, HTML discovery can only -- result in a claimed identifier. return $ Discovery2 (Provider prov) lid ClaimedIdent resolve ls = resolve2 ls `mplus` resolve1 ls authenticate-1.3.5.2/OpenId2/Normalization.hs0000644000000000000000000000414414500472340017150 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} -------------------------------------------------------------------------------- -- | -- Module : Network.OpenID.Normalization -- Copyright : (c) Trevor Elliott, 2008 -- License : BSD3 -- -- Maintainer : Trevor Elliott -- Stability : -- Portability : -- module OpenId2.Normalization ( normalize ) where -- Friends import OpenId2.Types -- Libraries import Control.Applicative import Control.Monad import Data.List import Network.URI ( uriToString, normalizeCase, normalizeEscape , normalizePathSegments, parseURI, uriPath, uriScheme, uriFragment ) import Data.Text (Text, pack, unpack) import Control.Monad.IO.Class import Control.Exception (throwIO) normalize :: MonadIO m => Text -> m Identifier normalize ident = case normalizeIdentifier $ Identifier ident of Just i -> return i Nothing -> liftIO $ throwIO $ NormalizationException $ unpack ident -- | Normalize an identifier, discarding XRIs. normalizeIdentifier :: Identifier -> Maybe Identifier normalizeIdentifier = normalizeIdentifier' (const Nothing) -- | Normalize the user supplied identifier, using a supplied function to -- normalize an XRI. normalizeIdentifier' :: (String -> Maybe String) -> Identifier -> Maybe Identifier normalizeIdentifier' xri (Identifier str') | null str = Nothing | "xri://" `isPrefixOf` str = (Identifier . pack) `fmap` xri str | head str `elem` "=@+$!" = (Identifier . pack) `fmap` xri str | otherwise = fmt `fmap` (url >>= norm) where str = unpack str' url = parseURI str <|> parseURI ("http://" ++ str) norm uri = validScheme >> return u where scheme' = uriScheme uri validScheme = guard (scheme' == "http:" || scheme' == "https:") u = uri { uriFragment = "", uriPath = path' } path' | null (uriPath uri) = "/" | otherwise = uriPath uri fmt u = Identifier $ pack $ normalizePathSegments $ normalizeEscape $ normalizeCase $ uriToString (const "") u [] authenticate-1.3.5.2/OpenId2/Types.hs0000644000000000000000000000160414500472340015424 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} -------------------------------------------------------------------------------- -- | -- Module : Network.OpenID.Types -- Copyright : (c) Trevor Elliott, 2008 -- License : BSD3 -- -- Maintainer : Trevor Elliott -- Stability : -- Portability : -- module OpenId2.Types ( Provider (..) , Identifier (..) , IdentType (..) , AuthenticateException (..) ) where -- Libraries import Data.Data (Data) import Data.Typeable (Typeable) import Web.Authenticate.Internal import Data.Text (Text) -- | An OpenID provider. newtype Provider = Provider { providerURI :: Text } deriving (Eq,Show) -- | A valid OpenID identifier. newtype Identifier = Identifier { identifier :: Text } deriving (Eq, Ord, Show, Read, Data, Typeable) data IdentType = OPIdent | ClaimedIdent deriving (Eq, Ord, Show, Read, Data, Typeable) authenticate-1.3.5.2/OpenId2/XRDS.hs0000644000000000000000000000422614500472340015103 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -------------------------------------------------------------------------------- -- | -- Module : Text.XRDS -- Copyright : (c) Trevor Elliott, 2008 -- License : BSD3 -- -- Maintainer : Trevor Elliott -- Stability : -- Portability : -- module OpenId2.XRDS ( -- * Types XRDS , Service(..) -- * Parsing , parseXRDS ) where -- Libraries import Control.Monad ((>=>)) import Data.Maybe (listToMaybe) import Text.XML (parseLBS, def) import Text.XML.Cursor (fromDocument, element, content, ($/), (&|), Cursor, (&/), attribute) import qualified Data.ByteString.Lazy as L import Data.Text (Text) import qualified Data.Text.Read -- Types ----------------------------------------------------------------------- type XRDS = [XRD] type XRD = [Service] data Service = Service { serviceTypes :: [Text] , serviceMediaTypes :: [Text] , serviceURIs :: [Text] , serviceLocalIDs :: [Text] , servicePriority :: Maybe Int } deriving Show parseXRDS :: L.ByteString -> Maybe XRDS parseXRDS str = either (const Nothing) (Just . parseXRDS' . fromDocument) (parseLBS def str) parseXRDS' :: Cursor -> [[Service]] parseXRDS' = element "{xri://$xrds}XRDS" &/ element "{xri://$xrd*($v*2.0)}XRD" &| parseXRD parseXRD :: Cursor -> [Service] parseXRD c = c $/ element "{xri://$xrd*($v*2.0)}Service" >=> parseService parseService :: Cursor -> [Service] parseService c = if null types then [] else [Service { serviceTypes = types , serviceMediaTypes = mtypes , serviceURIs = uris , serviceLocalIDs = localids , servicePriority = listToMaybe (attribute "priority" c) >>= readMaybe }] where types = c $/ element "{xri://$xrd*($v*2.0)}Type" &/ content mtypes = c $/ element "{xri://$xrd*($v*2.0)}MediaType" &/ content uris = c $/ element "{xri://$xrd*($v*2.0)}URI" &/ content localids = c $/ element "{xri://$xrd*($v*2.0)}LocalID" &/ content readMaybe t = case Data.Text.Read.signed Data.Text.Read.decimal t of Right (i, "") -> Just i _ -> Nothing authenticate-1.3.5.2/README.md0000644000000000000000000000030014500472340013773 0ustar0000000000000000## authenticate Focus is on third-party authentication methods, such as OpenID and BrowserID. Note: Facebook support is now provided by [the fb package](http://www.stackage.org/package/fb). authenticate-1.3.5.2/ChangeLog.md0000644000000000000000000000105514500472430014675 0ustar0000000000000000# authenticate changelog ## 1.3.5.2 * Support for aeson-2.2 [#61](https://github.com/yesodweb/authenticate/pull/61) ## 1.3.5.1 * Support for aeson-2.0 [#56](https://github.com/yesodweb/authenticate/pull/56) ## 1.3.5 * Drop tagstream-conduit dep (for GHC 8.8 support) ## 1.3.4 * Relaxed a bunch of type signatures ## 1.3.3.2 * Support for http-conduit-2.2.0 [#47](https://github.com/yesodweb/authenticate/issues/47) ## 1.3.3.1 * License update [#46](https://github.com/yesodweb/authenticate/issues/46) ## 1.3.3 Deprecated Google OpenID support authenticate-1.3.5.2/LICENSE0000644000000000000000000000207514500472340013534 0ustar0000000000000000Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/ Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. authenticate-1.3.5.2/Setup.lhs0000755000000000000000000000016214500472340014335 0ustar0000000000000000#!/usr/bin/env runhaskell > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain authenticate-1.3.5.2/authenticate.cabal0000644000000000000000000000423314500472405016171 0ustar0000000000000000name: authenticate version: 1.3.5.2 license: MIT license-file: LICENSE author: Michael Snoyman, Hiromi Ishii, Arash Rouhani maintainer: Michael Snoyman synopsis: Authentication methods for Haskell web applications. description: API docs and the README are available at . category: Web stability: Stable cabal-version: >= 1.10 build-type: Simple homepage: http://github.com/yesodweb/authenticate extra-source-files: README.md ChangeLog.md flag network-uri description: Get Network.URI from the network-uri package default: True library default-language: Haskell2010 build-depends: base >= 4.10 && < 5 , aeson >= 0.5 , attoparsec-aeson >= 2.1 , http-conduit >= 1.5 , transformers >= 0.1 , bytestring >= 0.9 , case-insensitive >= 0.2 , text , http-types >= 0.6 , xml-conduit >= 1.0 , blaze-builder , attoparsec , containers , unordered-containers , conduit >= 0.5 , html-conduit >= 1.3 , resourcet exposed-modules: Web.Authenticate.Rpxnow, Web.Authenticate.OpenId, Web.Authenticate.BrowserId, Web.Authenticate.OpenId.Providers other-modules: Web.Authenticate.Internal, OpenId2.Discovery, OpenId2.Normalization, OpenId2.Types, OpenId2.XRDS ghc-options: -Wall if flag(network-uri) build-depends: network-uri >= 2.6 else build-depends: network < 2.6 source-repository head type: git location: git://github.com/yesodweb/authenticate.git