xing-api (empty) → 0.1.1
raw patch · 28 files changed
+1839/−0 lines, 28 filesdep +HTFdep +aesondep +authenticate-oauthsetup-changed
Dependencies added: HTF, aeson, authenticate-oauth, base, bytestring, containers, hamlet, http-conduit, http-types, lifted-base, monad-control, resourcet, shakespeare-i18n, text, time, transformers, warp, xing-api, yesod-core
Files
- LICENSE +24/−0
- Setup.hs +2/−0
- demos/cli-demo.hs +92/−0
- demos/minimal-demo.hs +28/−0
- demos/yesod-demo.hs +200/−0
- lib/Web/XING.hs +21/−0
- lib/Web/XING/API.hs +40/−0
- lib/Web/XING/API/Error.hs +61/−0
- lib/Web/XING/Auth.hs +76/−0
- lib/Web/XING/Calls/IdCard.hs +52/−0
- lib/Web/XING/Calls/User.hs +192/−0
- lib/Web/XING/Internal/AuthenticateOAuthPatch.hs +72/−0
- lib/Web/XING/Types.hs +54/−0
- lib/Web/XING/Types/Address.hs +40/−0
- lib/Web/XING/Types/Award.hs +22/−0
- lib/Web/XING/Types/BirthDate.hs +25/−0
- lib/Web/XING/Types/ProfessionalExperience.hs +41/−0
- lib/Web/XING/Types/User.hs +21/−0
- lib/Web/XING/Types/User/FullUser.hs +161/−0
- lib/Web/XING/Types/User/MinimalUser.hs +34/−0
- tests/Main.hs +14/−0
- tests/Types/AddressTest.hs +88/−0
- tests/Types/AwardTest.hs +47/−0
- tests/Types/BirthDateTest.hs +70/−0
- tests/Types/ProfessionalExperienceTest.hs +93/−0
- tests/Types/User/FullUserTest.hs +88/−0
- tests/Types/User/MinimalUserTest.hs +38/−0
- xing-api.cabal +143/−0
+ LICENSE view
@@ -0,0 +1,24 @@+Copyright (c) 2013, Jan Ahrens+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:+ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+ * Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+ * Neither the name of the <organization> nor the+ names of its contributors may be used to endorse or promote products+ derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT HOLDER> BE LIABLE FOR ANY+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ demos/cli-demo.hs view
@@ -0,0 +1,92 @@+-- This demo shows how to authenticate users using OAuth and how to+-- reuse the access tokens.+-- It used the OAuth out of band (OOB) mode and can be used as a starting+-- point to write an application that does not to have a web view.+--+-- Make sure to set the environment variables XING_CONSUMER_KEY and+-- XING_CONSUMER_SECRET before trying this demo.++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Main where++import System.IO (hFlush, stdout)+import Data.Maybe (fromJust, isJust)++import Control.Monad.Trans.Control (MonadBaseControl)+import Control.Monad.Trans.Resource (MonadResource)++import Data.Monoid (mappend)+import qualified Data.ByteString.Char8 as BS+import qualified Data.Text.IO as T++import Web.XING++import System.Environment (getEnv)+import qualified System.IO.Error+import qualified Control.Exception as E++readVerifier+ :: URL+ -> IO Verifier+readVerifier url = do+ putStrLn "Please confirm the authorization at"+ putStrLn $ " " `mappend` (BS.unpack url)+ putStr "Please enter the PIN: " >> hFlush stdout+ BS.getLine++showAccessToken+ :: (AccessToken, BS.ByteString)+ -> IO ()+showAccessToken (accessToken, uid) = do+ putStrLn $ ""+ putStrLn $ "Hello " `mappend` (BS.unpack uid) `mappend` "!"+ putStrLn $ "You should set the access token as environment variables:"+ putStrLn $ ""+ putStrLn $ " export XING_ACCESS_TOKEN_KEY=\"" `mappend` ((BS.unpack.token) accessToken) `mappend` "\""+ putStrLn $ " export XING_ACCESS_TOKEN_SECRET=\"" `mappend` ((BS.unpack.tokenSecret) accessToken) `mappend` "\""+ putStrLn $ ""++handshake+ :: (MonadResource m, MonadBaseControl IO m)+ => OAuth+ -> Manager+ -> m (AccessToken, BS.ByteString)+handshake oa manager = do+ (requestToken, url) <- getRequestToken oa manager+ verifier <- liftIO $ readVerifier url+ getAccessToken requestToken verifier oa manager++readAccessToken :: IO (Maybe Credential)+readAccessToken = do+ access_token_key <- getEnv "XING_ACCESS_TOKEN_KEY"+ access_token_secret <- getEnv "XING_ACCESS_TOKEN_SECRET"+ return $ Just $ newCredential (BS.pack access_token_key) (BS.pack access_token_secret)++main :: IO ()+main = do+ consumer_key <- getEnv "XING_CONSUMER_KEY"+ consumer_secret <- getEnv "XING_CONSUMER_SECRET"+ let xingConsumer = consumer (BS.pack consumer_key) (BS.pack consumer_secret)++ maybeAccessToken <- E.catch (readAccessToken) (\(_ :: System.IO.Error.IOError) -> return Nothing)++ putStrLn "XING API demo"+ user <- withManager $ \manager -> do+ accessToken <- if isJust maybeAccessToken+ then return $ fromJust maybeAccessToken+ else auth xingConsumer manager+ getIdCard xingConsumer manager accessToken+ T.putStrLn (displayName user)++auth+ :: (MonadResource m, MonadBaseControl IO m)+ => OAuth+ -> Manager+ -> m RequestToken+auth oa manager = do+ res@(accessToken, _) <- handshake oa manager+ liftIO $ showAccessToken res+ return accessToken
+ demos/minimal-demo.hs view
@@ -0,0 +1,28 @@+-- This is a minimal example that can fit in the README and shows how to+-- do the OAuth handshake and call a protected resource.+-- It's not the best example since it's not reusing access tokens.+-- Have a look at the cli-demo.hs file for a more complex example.++{-# LANGUAGE OverloadedStrings #-}++module Main where++import Web.XING+import qualified Data.ByteString.Char8 as BS++oauthConfig :: OAuth+oauthConfig = consumer "YOUR_CONSUMER_KEY" "YOUR_CONSUMER_SECRET"++main :: IO ()+main = withManager $ \manager -> do+ (accessToken, _) <- handshake manager+ idCard <- getIdCard oauthConfig manager accessToken+ liftIO $ putStrLn $ show idCard+ where+ handshake manager = do+ (requestToken, url) <- getRequestToken oauthConfig manager+ verifier <- liftIO $ do+ BS.putStrLn url+ BS.putStr "PIN: "+ BS.getLine+ getAccessToken requestToken verifier oauthConfig manager
+ demos/yesod-demo.hs view
@@ -0,0 +1,200 @@+-- This demo shows how to use Yesod with the XING API.+--+-- The OAuth handshake is implemented without using yesod-auth.+-- Have a look at the yesod-auth-xing package for a simpler+-- solution to authenticate users using the XING API.+--+-- Make sure to set the environment variables XING_CONSUMER_KEY and+-- XING_CONSUMER_SECRET before trying this demo.++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}++module Main where++-- TODO: Web.XING.Types.User.FullUser also exports languages. Find a better name.+import Yesod.Core hiding (languages)+import Network.Wai.Handler.Warp (run)+import Text.Hamlet (hamlet)+import Web.XING+import Network.HTTP.Conduit (newManager, def)+import Data.Maybe (fromJust, isJust, fromMaybe)+import qualified Data.Map as M+import Helper.YesodHelper ( bootstrapLayout, bootstrapCDN+ , writeTokenToSession, getTokenFromSession+ , deleteTokenFromSession )+import qualified Data.ByteString.Char8 as BS+import Data.Monoid (mappend)+import qualified Data.Text.Encoding as E+import Data.Time+import qualified Data.Text as T+import System.Environment (getEnv)++data HelloXING = HelloXING {+ httpManager :: Manager+ , oAuthConsumer :: OAuth+}++instance Yesod HelloXING where+ defaultLayout = bootstrapLayout++mkYesod "HelloXING" [parseRoutes|+ / HomeR GET+ /handshake HandshakeR POST+ /callback CallbackR GET+ /logout LogoutR POST+|]++postHandshakeR :: Handler RepHtml+postHandshakeR = do+ yesod <- getYesod+ let oa = oAuthConsumer yesod+ let manager = httpManager yesod++ (requestToken, url) <- getRequestToken oa manager+ writeTokenToSession "request" requestToken++ redirect $ E.decodeUtf8 url++getCallbackR :: Handler RepHtml+getCallbackR = do+ yesod <- getYesod+ let oa = oAuthConsumer yesod+ let manager = httpManager yesod++ maybeRequestToken <- getTokenFromSession "request"++ maybeVerifier <- lookupGetParam "oauth_verifier"+ let verifier = E.encodeUtf8 (fromMaybe "" maybeVerifier)++ if isJust maybeRequestToken+ then do+ (accessToken, _) <- getAccessToken (fromJust maybeRequestToken) verifier oa manager+ writeTokenToSession "access" accessToken+ else return ()++ redirect HomeR++postLogoutR :: Handler RepHtml+postLogoutR = do+ deleteTokenFromSession "access"+ deleteTokenFromSession "request"+ redirect HomeR++daysUntilBirthday+ :: Maybe BirthDate+ -> Day+ -> Integer+daysUntilBirthday (Just (DayOnly birthMonth birthDay)) today = calcDays birthMonth birthDay today+daysUntilBirthday (Just (FullDate _ birthMonth birthDay)) today = calcDays birthMonth birthDay today+daysUntilBirthday Nothing _ = 0++calcDays+ :: Int+ -> Int+ -> Day+ -> Integer+calcDays birthMonth birthDay today+ = if (birthDayThisYear >= 0)+ then birthDayThisYear+ else birthDayNextYear+ where+ (year, _, _) = toGregorian today+ birthDayThisYear = diffDays (fromGregorian (year ) birthMonth birthDay) today+ birthDayNextYear = diffDays (fromGregorian (year + 1) birthMonth birthDay) today++getHomeR :: Handler RepHtml+getHomeR = do+ maybeAccessToken <- getTokenFromSession "access"++ widget <- case maybeAccessToken of+ Just accessToken -> do+ yesod <- getYesod+ users <- getUsers (oAuthConsumer yesod) (httpManager yesod) accessToken ["me"]+ today <- liftIO $ getCurrentTime+ let firstUser = head $ unUserList users+ let birthDayInDays = daysUntilBirthday (birthDate firstUser) (utctDay today)+ return $ whoAmI firstUser birthDayInDays++ Nothing -> return pleaseLogIn++ defaultLayout $ do+ addStylesheetRemote $ bootstrapCDN `mappend` "/css/bootstrap-combined.min.css"+ [whamlet|+ <h1>Welcome to the XING API demo+ ^{widget}+ |]++pleaseLogIn :: Widget+pleaseLogIn =+ toWidget [hamlet|+ <img src="https://www.xing.com/img/n/nobody_m.png">+ <p>Hello unknown user. Please log-in.+ <form method=POST action=@{HandshakeR}>+ <input type=submit value="Login with XING">+ |]++whoAmI+ :: FullUser+ -> Integer+ -> Widget+whoAmI user birthDayInDays = do+ toWidget [hamlet|+ <img src=#{fromMaybe "" $ M.lookup "large" (photoUrls user)}>+ <p>+ <a href=#{permalink user}>#{displayName user}+ <p>+ Hey #{firstName user}! Welcome to this demo.<br>+++ <p>+ Your next birthday is in #{show birthDayInDays} days.++ <p>+ Did you know? In Germany you would be greeted with "Guten Tag + $if (gender user) == Male+ Herr+ $else+ Frau+ \ #{lastName user}".++ $if (length (M.keys (languages user)) > 1)+ <p>+ Impressive! You are speaking #{length (M.keys (languages user))} languages:+ \ #{T.intercalate ", " (M.keys (languages user))}.++ $maybe mail <- activeEmail user+ <p>Your active email address is <a href=mailto:#{mail}>#{mail}</a>.++ <p>Here is a list of your premium services+ <ul>+ $forall service <- premiumServices user+ <li>#{service}++ $if null $ badges user+ You have no badges.+ $else+ <p>Your badges:+ <ul>+ $forall badge <- badges user+ <li>#{badge}++ <form method=POST action=@{LogoutR}>+ <input type=submit value="Logout">+ |]++main :: IO ()+main = do+ manager <- newManager def+ let port = 3000+ consumer_key <- getEnv "XING_CONSUMER_KEY"+ consumer_secret <- getEnv "XING_CONSUMER_SECRET"+ let xingConsumer = consumer (BS.pack consumer_key) (BS.pack consumer_secret)+ let xingConsumer' = xingConsumer{+ oauthCallback = Just $ "http://localhost:" `mappend` (BS.pack.show) port `mappend` "/callback"+ }+ putStrLn $ "Starting on port " ++ show port+ run port =<< toWaiApp (HelloXING manager xingConsumer')
+ lib/Web/XING.hs view
@@ -0,0 +1,21 @@+module Web.XING+ (+ module Web.XING.Auth+ , module Web.XING.API+ , module Web.XING.Types+ -- * Calls+ , module Web.XING.Calls.IdCard+ , module Web.XING.Calls.User+ -- * Common used functions (re-exports)+ , liftIO+ , withManager+ ) where++import Web.XING.Auth+import Web.XING.API+import Web.XING.Types+import Web.XING.Calls.IdCard+import Web.XING.Calls.User++import Control.Monad.IO.Class (MonadIO (liftIO))+import Network.HTTP.Conduit (withManager)
+ lib/Web/XING/API.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Web.XING.API+ ( -- * API request interface+ apiRequest+ ) where++import Network.HTTP.Types (Method)+import Network.HTTP.Conduit+ (Response(..), Request(..), parseUrl, httpLbs)+import Data.Maybe (fromJust)+import Data.Monoid (mappend)+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy.Char8 as BSL+import Control.Monad.Trans.Control (MonadBaseControl)+import Control.Monad.Trans.Resource (MonadResource)+import Web.XING.Types+import Web.XING.API.Error+import qualified Control.Exception.Lifted as E+import Web.Authenticate.OAuth (signOAuth)++apiBaseUrl :: BS.ByteString+apiBaseUrl = "https://api.xing.com"++-- | Low level API request interface+apiRequest+ :: (MonadResource m, MonadBaseControl IO m)+ => OAuth -- ^ OAuth consumer+ -> Manager+ -> AccessToken+ -> Method -- ^ HTTP verb+ -> BS.ByteString -- ^ HTTP path+ -> m (Response BSL.ByteString)+apiRequest oa manager cr m uri = do+ let req = fromJust $ parseUrl $ BS.unpack (apiBaseUrl `mappend` uri)+ req' <- signOAuth oa cr req{method = m}+ E.catch (httpLbs req' manager)+ (handleStatusCodeException (m `mappend` " " `mappend` uri))
+ lib/Web/XING/API/Error.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE OverloadedStrings #-}++module Web.XING.API.Error+ (+ mapError+ , handleError+ , handleStatusCodeException+ ) where++import Web.XING.Types+import Network.HTTP.Types (ResponseHeaders)+import Data.Maybe (fromMaybe)+import qualified Data.ByteString.Lazy.Char8 as BSL+import qualified Data.ByteString.Char8 as BS+import Control.Applicative ((<$>), (<*>))+import Data.Aeson (decode, FromJSON(parseJSON), Value(Object) , (.:))+import Control.Exception (throw)+import Network.HTTP.Conduit (HttpException(StatusCodeException))++mapError+ :: XINGError+ -> APIError+mapError (XINGError "INVALID_OAUTH_SIGNATURE" _) = OAuthError "Invalid oauth signature. Check your consumer and access token secret."+mapError (XINGError "INVALID_OAUTH_CONSUMER" _) = OAuthError "Invalid oauth consumer key. Check your config."+mapError (XINGError "INSUFFICIENT_PRIVILEGES" _) = OAuthError "Required permission missing"+mapError (XINGError "INVALID_OAUTH_VERSION" _) = OAuthError "Invalid oauth version"+mapError (XINGError "INVALID_OAUTH_SIGNATURE_METHOD" _) = OAuthError "Invalid oauth version"+mapError (XINGError "REQUIRED_PARAMETER_MISSING" _) = OAuthError "Required parameter missing. Should never have happened."+mapError (XINGError "INVALID_REQUEST_TOKEN" _) = OAuthError "Invalid request token. Maybe the verifier was wrong?"+mapError (XINGError "INVALID_OAUTH_TOKEN" _) = TokenError "The oauth token was invalid. Maybe the user revoked it?"+mapError (XINGError "TIME_EXPIRED" _) = OAuthError "Time was too old. Make sure that your local clock is set correctly."+mapError (XINGError "RATE_LIMIT_EXCEEDED" _) = Throttled+mapError (XINGError "CALLBACK_URL_NOT_ALLOWED" _) = CallError "The callback URL was not allowed" -- TOOD API shows better error message+mapError _ = CallError "unknown"++data XINGError =+ XINGError BSL.ByteString BSL.ByteString+ deriving (Show, Eq)++instance FromJSON XINGError where+ parseJSON (Object response) =+ XINGError <$> (response .: "error_name")+ <*> (response .: "message")+ parseJSON _ = fail "no parse"++handleStatusCodeException+ :: BS.ByteString+ -> HttpException+ -> a+handleStatusCodeException call (StatusCodeException status headers) = throw $ handleError status headers call+handleStatusCodeException _ e = throw e++handleError+ :: Status+ -> ResponseHeaders+ -> BS.ByteString+ -> APIError+handleError _ headers _ =+ case decode $ BSL.fromChunks [fromMaybe "{}" (lookup "X-Response-Body-Start" headers)] of+ Just e -> mapError e+ Nothing -> CallError "unknown"
+ lib/Web/XING/Auth.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Web.XING.Auth+ ( -- * OAuth+ consumer+ , getRequestToken+ , Patch.authorizeUrl+ , getAccessToken+ , Patch.token+ , Patch.tokenSecret+ -- reexports of some Web.Authenticate.OAuth functions+ , newCredential -- | (re)create an OAuth token (for example access token)+ , oauthCallback -- | extract the OAuth callback from a consumer+ ) where++import Prelude+import qualified Control.Exception.Lifted as E+import qualified Data.ByteString as BS++import Web.Authenticate.OAuth hiding (getAccessToken)+import qualified Web.XING.Internal.AuthenticateOAuthPatch as Patch+import Control.Monad.Trans.Control (MonadBaseControl)+import Control.Monad.Trans.Resource (MonadResource)++import Data.Maybe (fromMaybe)++import Web.XING.Types+import Web.XING.API.Error++-- | Create an OAuth consumer+consumer+ :: BS.ByteString -- ^ consumer key+ -> BS.ByteString -- ^ consumer secret+ -> OAuth+consumer consumerKey consumerSecret = newOAuth+ { oauthRequestUri = "https://api.xing.com/v1/request_token"+ , oauthAccessTokenUri = "https://api.xing.com/v1/access_token"+ , oauthAuthorizeUri = "https://api.xing.com/v1/authorize"+ , oauthSignatureMethod = PLAINTEXT+ , oauthVersion = OAuth10a+ , oauthConsumerKey = consumerKey+ , oauthConsumerSecret = consumerSecret+ , oauthCallback = Just "oob"+ }++-- | Create a request token (/temporary credentials/)+getRequestToken+ :: (MonadResource m, MonadBaseControl IO m)+ => OAuth -- ^ OAuth consumer+ -> Manager+ -> m (RequestToken, URL) -- ^ request token and authorize URL+getRequestToken oa manager = E.catch+ tryToGetRequestToken+ (handleStatusCodeException "POST /v1/request_token")+ where+ tryToGetRequestToken = do+ cred <- Patch.getTemporaryCredential' id oa manager+ return (cred, Patch.authorizeUrl oa cred)++-- | Exchange request token for an access token (/token credentials/)+getAccessToken+ :: (MonadResource m, MonadBaseControl IO m)+ => RequestToken -- ^ request token obtained from 'getRequestToken'+ -> Verifier -- ^ verifier obtained by calling 'Patch.authorizeUrl'+ -> OAuth -- ^ OAuth consumer (see 'consumer')+ -> Manager+ -> m (Credential, BS.ByteString)+getAccessToken requestToken verifier oa manager = E.catch+ tryToExchangeRequestToken+ (handleStatusCodeException "POST /v1/access_token")+ where+ tryToExchangeRequestToken = do+ accessToken <- Patch.getAccessToken' id oa ((injectVerifier verifier) requestToken) manager+ return (accessToken, fromMaybe "" . lookup "user_id" . unCredential $ accessToken)
+ lib/Web/XING/Calls/IdCard.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}++module Web.XING.Calls.IdCard+ (+ getIdCard+ , demoIdCard+ , demoIdCard'+ ) where++import Web.XING.Types+import Web.XING.API++import qualified Data.ByteString.Lazy.Char8 as BSL+import Network.HTTP.Conduit (Response(..))+import Control.Monad.Trans.Control (MonadBaseControl)+import Control.Monad.Trans.Resource (MonadResource)+import Control.Exception (throw)+import Data.Aeson (encode, decode, Value(..), object, (.=))++-- | Get your id card <https://dev.xing.com/docs/get/users/me/id_card>+getIdCard+ :: (MonadResource m, MonadBaseControl IO m)+ => OAuth+ -> Manager+ -> AccessToken+ -> m MinimalUser+getIdCard oa manager cr = do+ Response _ _ _ body <- apiRequest oa manager cr "GET" "/v1/users/me/id_card"+ case decode body of+ Just a -> return a+ Nothing -> throw Mapping++-- https://dev.xing.com/docs/get/users/me/id_card+demoIdCard :: Value+demoIdCard = object [+ "id_card" .= object [+ "id" .= ("12345_abcdef" :: BSL.ByteString)+ , "display_name" .= ("Max Mustermann" :: BSL.ByteString)+ , "permalink" .= ("https://www.xing.com/profile/Max_Mustermann" :: BSL.ByteString)+ , "photo_urls" .= object [+ "large" .= ("http://www.xing.com/img/users/e/3/d/f94ef165a.123456,1.140x185.jpg" :: BSL.ByteString)+ , "mini_thumb" .= ("http://www.xing.com/img/users/e/3/d/f94ef165a.123456,1.18x24.jpg" :: BSL.ByteString)+ , "thumb" .= ("http://www.xing.com/img/users/e/3/d/f94ef165a.123456,1.30x40.jpg" :: BSL.ByteString)+ , "medium_thumb" .= ("http://www.xing.com/img/users/e/3/d/f94ef165a.123456,1.57x75.jpg" :: BSL.ByteString)+ , "maxi_thumb" .= ("http://www.xing.com/img/users/e/3/d/f94ef165a.123456,1.70x93.jpg" :: BSL.ByteString)+ ]+ ]+ ]++demoIdCard' :: BSL.ByteString+demoIdCard' = encode demoIdCard
+ lib/Web/XING/Calls/User.hs view
@@ -0,0 +1,192 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}++module Web.XING.Calls.User+ (+ demoUser, demoUser'+ , demoUsers, demoUsers'+ , getUsers+ ) where++import Web.XING.Types+import Web.XING.API+import Data.Aeson (encode, decode, Value(..), object, (.=))+import qualified Data.ByteString.Lazy.Char8 as BSL+import Network.HTTP.Conduit (Response(..))+import Control.Monad.Trans.Control (MonadBaseControl)+import Control.Monad.Trans.Resource (MonadResource)+import Data.Monoid (mappend)+import Control.Exception (throw)+import Data.Text.Encoding (encodeUtf8)+import Data.Text (intercalate)++-- | Get user details <https://dev.xing.com/docs/get/users/:id>+getUsers+ :: (MonadResource m, MonadBaseControl IO m)+ => OAuth+ -> Manager+ -> AccessToken+ -> [UserId]+ -> m UserList+getUsers oa manager cr uids = do+ Response _ _ _ body <- apiRequest oa manager cr "GET" ("/v1/users/" `mappend` (encodeUtf8 $ intercalate "," uids))+ case decode body of+ Just a -> return a+ Nothing -> throw Mapping++-- https://dev.xing.com/docs/get/users/:id+demoUsers :: Value+demoUsers = object [+ "users" .= [demoUser]+ ]++demoUsers' :: BSL.ByteString+demoUsers' = encode demoUsers++demoUser :: Value+demoUser = object [+ "id" .= ("12345_abcdef" :: BSL.ByteString)+ , "display_name" .= ("Max Mustermann" :: BSL.ByteString)+ , "permalink" .= ("https://www.xing.com/profile/Max_Mustermann" :: BSL.ByteString)+ , "first_name" .= ("Max" :: BSL.ByteString)+ , "last_name" .= ("Mustermann" :: BSL.ByteString)+ , "page_name" .= ("Max_Mustermann" :: BSL.ByteString)+ , "gender" .= ("m" :: BSL.ByteString)+ , "active_email" .= ("max.mustermann@xing.com" :: BSL.ByteString)+ , "time_zone" .= object [+ "name" .= ("Europe/Copenhagen" :: BSL.ByteString)+ , "utc_offset" .= (2.0 :: Float)+ ]+ , "premium_services" .= (["SEARCH", "PRIVATEMESSAGES"] :: [BSL.ByteString])+ , "badges" .= (["PREMIUM", "PRIVATEMESSAGES"] :: [BSL.ByteString])+ , "languages" .= object [+ "de" .= ("NATIVE" :: BSL.ByteString)+ , "en" .= ("FLUENT" :: BSL.ByteString)+ , "fr" .= Null+ , "zh" .= ("BASIC" :: BSL.ByteString)+ ]+ , "wants" .= (encodeUtf8 "einen neuen Job")+ , "haves" .= (encodeUtf8 "viele tolle Skills")+ , "interests" .= (encodeUtf8 "Flitzebogen schießen and so on")+ , "organisation_member" .= (encodeUtf8 "ACM, GI")+ , "private_address" .= object [+ "street" .= (encodeUtf8 "Privatstraße 1")+ , "zip_code" .= (encodeUtf8 "20357")+ , "city" .= (encodeUtf8 "Hamburg")+ , "province" .= (encodeUtf8 "Hamburg")+ , "country" .= (encodeUtf8 "DE")+ , "email" .= (encodeUtf8 "max@mustermann.de")+ , "phone" .= (encodeUtf8 "49|40|1234560")+ , "fax" .= (encodeUtf8 "||")+ , "mobile_phone" .= (encodeUtf8 "49|0155|1234567")+ ]+ , "business_address" .= object [+ "city" .= (encodeUtf8 "Hamburg")+ , "country" .= (encodeUtf8 "DE")+ , "zip_code" .= (encodeUtf8 "20357")+ , "street" .= (encodeUtf8 "Geschäftsstraße 1a")+ , "phone" .= (encodeUtf8 "49|40|1234569")+ , "fax" .= (encodeUtf8 "49|40|1234561")+ , "province" .= (encodeUtf8 "Hamburg")+ , "email" .= (encodeUtf8 "max.mustermann@xing.com")+ , "mobile_phone" .= (encodeUtf8 "49|160|66666661")+ ]+ , "web_profiles" .= object [+ "qype" .= (["http://qype.de/users/foo"] :: [BSL.ByteString])+ , "google_plus" .= (["http://plus.google.com/foo"] :: [BSL.ByteString])+ , "blog" .= (["http://blog.example.org"] :: [BSL.ByteString])+ , "homepage" .= (["http://example.org", "http://another-example.org"] :: [BSL.ByteString])+ ]+ , "instant_messaging_accounts" .= object [+ "skype" .= (encodeUtf8 "1122334455")+ , "googletalk" .= (encodeUtf8 "max.mustermann")+ ]+ , "professional_experience" .= object [+ "primary_company" .= object [+ "name" .= (encodeUtf8 "XING AG")+ , "title" .= (encodeUtf8 "Softwareentwickler")+ , "company_size" .= (encodeUtf8 "201-500")+ , "tag" .= Null+ , "url" .= (encodeUtf8 "http://www.xing.com")+ , "career_level" .= (encodeUtf8 "PROFESSIONAL_EXPERIENCED")+ , "begin_date" .= (encodeUtf8 "2010-01")+ , "description" .= Null+ , "end_date" .= Null+ , "industry" .= (encodeUtf8 "AEROSPACE")+ ]+ , "non_primary_companies" .= [+ object [+ "name" .= (encodeUtf8 "Ninja Ltd.")+ , "title" .= (encodeUtf8 "DevOps")+ , "company_size" .= Null+ , "tag" .= (encodeUtf8 "NINJA")+ , "url" .= (encodeUtf8 "http://www.ninja-ltd.co.uk")+ , "career_level" .= Null+ , "begin_date" .= (encodeUtf8 "2009-04")+ , "description" .= Null+ , "end_date" .= (encodeUtf8 "2010-07")+ , "industry" .= (encodeUtf8 "ALTERNATIVE_MEDICINE")+ ]+ , object [+ "name" .= Null+ , "title" .= (encodeUtf8 "Wiss. Mitarbeiter")+ , "company_size" .= Null+ , "tag" .= (encodeUtf8 "OFFIS")+ , "url" .= (encodeUtf8 "http://www.uni.de")+ , "career_level" .= Null+ , "begin_date" .= (encodeUtf8 "2007")+ , "description" .= Null+ , "end_date" .= (encodeUtf8 "2008")+ , "industry" .= (encodeUtf8 "APPAREL_AND_FASHION")+ ]+ , object [+ "name" .= Null+ , "title" .= (encodeUtf8 "TEST NINJA")+ , "company_size" .= (encodeUtf8 "201-500")+ , "tag" .= (encodeUtf8 "TESTCOMPANY")+ , "url" .= Null+ , "career_level" .= (encodeUtf8 "ENTRY_LEVEL")+ , "begin_date" .= (encodeUtf8 "1998-12")+ , "description" .= Null+ , "end_date" .= (encodeUtf8 "1999-05")+ , "industry" .= (encodeUtf8 "ARTS_AND_CRAFTS")+ ]+ ]+ , "awards" .= [+ object [+ "name" .= (encodeUtf8 "Awesome Dude Of The Year")+ , "date_awarded" .= (2007 :: Int)+ , "url" .= Null+ ]+ ]+ ]+ , "educational_background" .= object [+ "schools" .= [+ object [+ "name" .= (encodeUtf8 "Carl-von-Ossietzky Universtät Schellenburg")+ , "degree" .= (encodeUtf8 "MSc CE/CS")+ , "notes" .= Null+ , "subject" .= Null+ , "begin_date" .= (encodeUtf8 "1998-08")+ , "end_date" .= (encodeUtf8 "2005-02")+ ]+ ]+ , "qualifications" .= (["TOEFLS", "PADI AOWD"] :: [BSL.ByteString])+ ]+ , "photo_urls" .= object [+ "large" .= ("http://www.xing.com/img/users/e/3/d/f94ef165a.123456,1.140x185.jpg" :: BSL.ByteString)+ , "mini_thumb" .= ("http://www.xing.com/img/users/e/3/d/f94ef165a.123456,1.18x24.jpg" :: BSL.ByteString)+ , "thumb" .= ("http://www.xing.com/img/users/e/3/d/f94ef165a.123456,1.30x40.jpg" :: BSL.ByteString)+ , "medium_thumb" .= ("http://www.xing.com/img/users/e/3/d/f94ef165a.123456,1.57x75.jpg" :: BSL.ByteString)+ , "maxi_thumb" .= ("http://www.xing.com/img/users/e/3/d/f94ef165a.123456,1.70x93.jpg" :: BSL.ByteString)+ ]+ , "birth_date" .= object [+ "day" .= (12 :: Int)+ , "month" .= (8 :: Int)+ , "year" .= (1963 :: Int)+ ]+ ]++demoUser' :: BSL.ByteString+demoUser' = encode demoUser
+ lib/Web/XING/Internal/AuthenticateOAuthPatch.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}++module Web.XING.Internal.AuthenticateOAuthPatch+ ( -- * changed Web.Authenticate.OAuth functions+ getTemporaryCredential'+ , authorizeUrl+ , getAccessToken'+ -- * accessor functions for Credential (from Web.Authenticate.OAuth)+ , token+ , tokenSecret+ ) where++import Web.Authenticate.OAuth hiding (authorizeUrl, getAccessToken', getTemporaryCredential')+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy.Char8 as BSL+import Control.Monad.Trans.Resource (MonadResource, MonadBaseControl)+import Control.Monad.IO.Class (liftIO)+import Control.Exception (throwIO)+import Network.HTTP.Conduit (Manager, Request(method), httpLbs, responseStatus, responseBody, parseUrl)+import Network.HTTP.Types (status201, parseSimpleQuery)+import Data.Maybe (fromJust, fromMaybe)++-- | extract the token from the 'Credential'+token :: Credential -> BS.ByteString+token = fromMaybe "" . lookup "oauth_token" . unCredential++-- | extract the secret from the 'Credential'+tokenSecret :: Credential -> BS.ByteString+tokenSecret = fromMaybe "" . lookup "oauth_token_secret" . unCredential++toStrict :: BSL.ByteString -> BS.ByteString+toStrict = BS.concat . BSL.toChunks++-- we can't use OA.getTemporaryCredential', because the XING API returns 201 instead of 200+getTemporaryCredential' :: (MonadResource m, MonadBaseControl IO m)+ => (Request m -> Request m)+ -> OAuth+ -> Manager+ -> m Credential+getTemporaryCredential' hook oa manager = do+ let req = fromJust $ parseUrl $ oauthRequestUri oa+ crd = maybe id (insert "oauth_callback") (oauthCallback oa) $ emptyCredential+ req' <- signOAuth oa crd $ hook (req { method = "POST" })+ rsp <- httpLbs req' manager+ if responseStatus rsp == status201+ then do+ let dic = parseSimpleQuery . toStrict . responseBody $ rsp+ return $ Credential dic+ else liftIO . throwIO . OAuthException $ "Gaining OAuth Temporary Credential Failed: " ++ BSL.unpack (responseBody rsp)++-- | URL to obtain OAuth verifier+authorizeUrl :: OAuth -- ^ OAuth consumer+ -> Credential -- ^ request token 'Web.XING.getRequestToken'+ -> BS.ByteString -- ^ URL to send the user to+authorizeUrl consumer = BS.pack . (authorizeUrl' (\_ -> const []) consumer{oauthCallback=Nothing})++-- we can't use OA.getAccessToken, because the XING API returns 201 instead of 200+getAccessToken' :: (MonadResource m, MonadBaseControl IO m)+ => (Request m -> Request m)+ -> OAuth+ -> Credential+ -> Manager+ -> m Credential+getAccessToken' hook oa cr manager = do+ let req = hook (fromJust $ parseUrl $ oauthAccessTokenUri oa) { method = "POST" }+ rsp <- flip httpLbs manager =<< signOAuth oa (if oauthVersion oa == OAuth10 then delete "oauth_verifier" cr else cr) req+ if responseStatus rsp == status201+ then do+ let dic = parseSimpleQuery . toStrict . responseBody $ rsp+ return $ Credential dic+ else liftIO . throwIO . OAuthException $ "Gaining OAuth Token Credential Failed: " ++ BSL.unpack (responseBody rsp)
+ lib/Web/XING/Types.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-}++module Web.XING.Types+ (+ APIError(..)+ , RequestToken+ , Verifier+ , AccessToken+ , URL+ -- reexports+ , Manager+ , OAuth(..)+ , Credential(..)+ , Status+ -- * XING data types+ , module Web.XING.Types.Address+ , module Web.XING.Types.Award+ , module Web.XING.Types.BirthDate+ , module Web.XING.Types.ProfessionalExperience+ , module Web.XING.Types.User+ , module Web.XING.Types.User.FullUser+ , module Web.XING.Types.User.MinimalUser+ ) where++import Network.HTTP.Conduit (Manager)+import qualified Data.ByteString as BS+import Web.Authenticate.OAuth (OAuth(..), Credential(..))+import Network.HTTP.Types (Status)+import Control.Exception (Exception)+import Data.Typeable (Typeable)++import Web.XING.Types.BirthDate+import Web.XING.Types.User+import Web.XING.Types.Address+import Web.XING.Types.Award+import Web.XING.Types.ProfessionalExperience+import Web.XING.Types.User.MinimalUser+import Web.XING.Types.User.FullUser++data APIError+ = OAuthError String+ | TokenError String+ | CallError String+ | Throttled+ | Mapping+ deriving (Eq, Show, Typeable)++instance Exception APIError++type RequestToken = Credential+type AccessToken = Credential+type Verifier = BS.ByteString+type URL = BS.ByteString
+ lib/Web/XING/Types/Address.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-}++module Web.XING.Types.Address+ (+ Address(..)+ ) where++import Data.Aeson (Value(..), FromJSON(..), (.:))+import Control.Monad (mzero)+import Control.Applicative ((<*>), (<$>))+import Data.Text (Text)++-- the address model is pretty terrible - nothing is certain ..+data Address+ = Address {+ street :: Maybe Text+ , zipCode :: Maybe Text+ , city :: Maybe Text+ , province :: Maybe Text+ , country :: Maybe Text+ , email :: Maybe Text+ , phone :: Maybe Text+ , fax :: Maybe Text+ , mobilePhone :: Maybe Text+ }+ deriving (Show, Eq)++instance FromJSON Address where+ parseJSON (Object response) = do+ Address <$> (response .: "street")+ <*> (response .: "zip_code")+ <*> (response .: "city")+ <*> (response .: "province")+ <*> (response .: "country")+ <*> (response .: "email")+ <*> (response .: "phone")+ <*> (response .: "fax")+ <*> (response .: "mobile_phone")+ parseJSON _ = mzero
+ lib/Web/XING/Types/Award.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE OverloadedStrings #-}++module Web.XING.Types.Award+ (+ Award(..)+ ) where++import Data.Aeson (Value(..), FromJSON(..), (.:), (.:?))+import Control.Monad (mzero)+import Control.Applicative ((<*>), (<$>))+import Data.Text (Text)++data Award+ = Award Text Int (Maybe Text)+ deriving (Show, Eq)++instance FromJSON Award where+ parseJSON (Object response) = do+ Award <$> (response .: "name")+ <*> (response .: "date_awarded")+ <*> (response .:? "url")+ parseJSON _ = mzero
+ lib/Web/XING/Types/BirthDate.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-}++module Web.XING.Types.BirthDate+ (+ BirthDate(..)+ ) where++import Data.Aeson (Value(..), FromJSON(..), (.:), (.:?))+import Control.Monad (mzero)++data BirthDate+ = FullDate Integer Int Int+ | DayOnly Int Int+ deriving (Eq, Show)++instance FromJSON BirthDate where+ parseJSON (Object response) = do+ maybeYear <- response .:? "year"+ month <- response .: "month"+ day <- response .: "day"+ case maybeYear of+ Just year -> return $ FullDate year month day+ _ -> return $ DayOnly day month+ parseJSON _ = mzero
+ lib/Web/XING/Types/ProfessionalExperience.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-}++module Web.XING.Types.ProfessionalExperience+ (+ ProfessionalExperience(..)+ ) where++import Data.Aeson (Value(..), FromJSON(..), (.:))+import Control.Monad (mzero)+import Control.Applicative ((<*>), (<$>))+import Data.Text (Text)++data ProfessionalExperience+ = ProfessionalExperience {+ pe_title :: Maybe Text+ , pe_beginDate :: Maybe Text+ , pe_endDate :: Maybe Text+ , pe_careerLevel :: Maybe Text+ , pe_description :: Maybe Text+ , pe_name :: Maybe Text+ , pe_tag :: Maybe Text+ , pe_companySize :: Maybe Text+ , pe_url :: Maybe Text+ , pe_industry :: Text+ }+ deriving (Show, Eq)++instance FromJSON ProfessionalExperience where+ parseJSON (Object response) = do+ ProfessionalExperience <$> (response .: "title")+ <*> (response .: "begin_date")+ <*> (response .: "end_date")+ <*> (response .: "career_level")+ <*> (response .: "description")+ <*> (response .: "name")+ <*> (response .: "tag")+ <*> (response .: "company_size")+ <*> (response .: "url")+ <*> (response .: "industry")+ parseJSON _ = mzero
+ lib/Web/XING/Types/User.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-}++module Web.XING.Types.User+ (+ User(..)+ , UserId+ , PhotoUrls+ ) where++import Data.Text (Text)+import Data.Map (Map)++type UserId = Text+type PhotoUrls = Map Text Text++class User a where+ userId :: a -> UserId+ displayName :: a -> Text+ permalink :: a -> Text+ photoUrls :: a -> PhotoUrls
+ lib/Web/XING/Types/User/FullUser.hs view
@@ -0,0 +1,161 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}++module Web.XING.Types.User.FullUser+ (+ FullUser+ , UserList(..)+ , Gender(..)+ , Language, Skill+ --+ , birthDate, gender, firstName, lastName+ , activeEmail, premiumServices, badges, languages+ , wants, haves, interests, organisations, pageName+ , privateAddress, businessAddress+ ) where++import Web.XING.Types.User+import Web.XING.Types.BirthDate+import Web.XING.Types.Address++import Data.Aeson (Value(..), FromJSON(..), (.:), (.:?))+import Data.Aeson.Types (parseMaybe)+import Control.Monad (mzero)+import Data.Text (Text)+import Data.Time.LocalTime (TimeZone(..))+import Data.Map (Map)+import Control.Applicative ((<$>), (<*>))++type Language = Text+type Skill = Text++data Gender+ = Male+ | Female+ deriving (Eq, Show)++instance FromJSON Gender where+ parseJSON (String "m") = return Male+ parseJSON (String "f") = return Female+ parseJSON _ = mzero++newtype UserList = UserList { unUserList :: [FullUser] }+ deriving (Show)++-- TODO: it would be nice, if instead of using the UserList hack, we could use:+-- instance FromJSON [FullUser] where+instance FromJSON UserList where+ parseJSON (Object response) = do+ users <- parseJSON =<< (response .: "users")+ return $ UserList users+ parseJSON _ = mzero++data FullUser+ = FullUser {+ _userId :: UserId+ , _displayName :: Text+ , _permalink :: Text+ , _firstName :: Text+ , _lastName :: Text+ , _pageName :: Text+ , _gender :: Gender+ , _activeEmail :: Maybe Text+ , _timeZone :: TimeZone+ , _premiumServices :: [Text]+ , _badges :: [Text]+ , _languages :: Map Language (Maybe Skill)+ , _wants :: Maybe Text+ , _haves :: Maybe Text+ , _interests :: Maybe Text+ , _organisations :: Maybe Text+ , _privateAddress :: Address+ , _businessAddress :: Address+ , _photoUrls :: PhotoUrls+ , _birthDate :: Maybe BirthDate+ }+ deriving (Show, Eq)++instance User FullUser where+ userId = _userId+ displayName = _displayName+ permalink = _permalink+ photoUrls = _photoUrls++instance FromJSON FullUser where+ parseJSON (Object response) = do+ FullUser <$> (response .: "id")+ <*> (response .: "display_name")+ <*> (response .: "permalink")+ <*> (response .: "first_name")+ <*> (response .: "last_name")+ <*> (response .: "page_name")+ <*> (parseJSON =<< response .: "gender")+ <*> (response .:? "active_email")+ <*> (response .: "time_zone" >>= \zone -> do+ TimeZone <$> (return . (60 *) =<< zone .: "utc_offset")+ <*> return False+ <*> (zone .: "name"))+ <*> (response .: "premium_services")+ <*> (response .: "badges")+ <*> (response .: "languages")+ <*> (response .: "wants")+ <*> (response .: "haves")+ <*> (response .: "interests")+ <*> (response .: "organisation_member")+ <*> (response .: "private_address")+ <*> (response .: "business_address")+ <*> (response .: "photo_urls")+ <*> (return . (parseMaybe parseJSON) =<< response .: "birth_date")+ parseJSON _ = mzero++birthDate+ :: FullUser+ -> Maybe BirthDate+birthDate = _birthDate++gender+ :: FullUser+ -> Gender+gender = _gender++firstName, lastName+ :: FullUser+ -> Text+firstName = _firstName+lastName = _lastName++activeEmail+ :: FullUser+ -> Maybe Text+activeEmail = _activeEmail++premiumServices, badges+ :: FullUser+ -> [Text]+premiumServices = _premiumServices+badges = _badges++languages+ :: FullUser+ -> Map Language (Maybe Skill)+languages = _languages++wants, haves, interests, organisations+ :: FullUser+ -> Maybe Text+wants = _wants+haves = _haves+interests = _interests+organisations = _organisations++pageName+ :: FullUser+ -> Text+pageName = _pageName++privateAddress, businessAddress+ :: FullUser+ -> Address+privateAddress = _privateAddress+businessAddress = _businessAddress
+ lib/Web/XING/Types/User/MinimalUser.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE OverloadedStrings #-}++module Web.XING.Types.User.MinimalUser+ (+ MinimalUser(..)+ ) where++import Web.XING.Types.User+import Data.Aeson (Value(..), FromJSON(..), (.:))+import Control.Applicative ((<$>), (<*>))+import Data.Text (Text)++data MinimalUser+ = MinimalUser+ UserId+ Text+ Text+ PhotoUrls+ deriving (Show, Eq)++instance User MinimalUser where+ userId (MinimalUser uid _ _ _ ) = uid+ displayName (MinimalUser _ name _ _) = name+ permalink (MinimalUser _ _ link _) = link+ photoUrls (MinimalUser _ _ _ urls) = urls++instance FromJSON MinimalUser where+ parseJSON (Object response) = do+ container <- response .: "id_card"+ MinimalUser <$> (container .: "id")+ <*> (container .: "display_name")+ <*> (container .: "permalink")+ <*> (container .: "photo_urls")+ parseJSON _ = fail "no parse"
+ tests/Main.hs view
@@ -0,0 +1,14 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}+module Main where++import Test.Framework++import {-@ HTF_TESTS @-} Types.AddressTest+import {-@ HTF_TESTS @-} Types.AwardTest+import {-@ HTF_TESTS @-} Types.BirthDateTest hiding (main)+import {-@ HTF_TESTS @-} Types.ProfessionalExperienceTest hiding (main)+import {-@ HTF_TESTS @-} Types.User.FullUserTest hiding (main)+import {-@ HTF_TESTS @-} Types.User.MinimalUserTest hiding (main)++main :: IO ()+main = htfMain htf_importedTests
+ tests/Types/AddressTest.hs view
@@ -0,0 +1,88 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}+{-# LANGUAGE OverloadedStrings #-}++module Types.AddressTest where++import Test.Framework+import Web.XING+import Data.Maybe+import Data.Aeson+import qualified Data.ByteString.Lazy as BSL+import Data.Text.Lazy.Encoding (encodeUtf8)++-- valid fields++test_noContent :: IO ()+test_noContent+ = assertValidAddress+ " { \+ \ \"street\": \"\", \+ \ \"zip_code\": \"\", \+ \ \"city\": \"\", \+ \ \"province\": \"\", \+ \ \"country\": \"\", \+ \ \"email\": \"\", \+ \ \"phone\": \"\", \+ \ \"fax\": \"\", \+ \ \"mobile_phone\": \"\" \+ \ } "++test_nullValuesAreValid :: IO ()+test_nullValuesAreValid+ = assertValidAddress+ " { \+ \ \"street\": null, \+ \ \"zip_code\": null, \+ \ \"city\": null, \+ \ \"province\": null, \+ \ \"country\": null, \+ \ \"email\": null, \+ \ \"phone\": null, \+ \ \"fax\": null, \+ \ \"mobile_phone\": null \+ \ } "++test_fullAddress :: IO ()+test_fullAddress+ = assertValidAddress . encodeUtf8 $+ " { \+ \ \"street\": \"Privatstraße 1\", \+ \ \"zip_code\": \"20357\", \+ \ \"city\": \"Hamburg\", \+ \ \"province\": \"Hamburg\", \+ \ \"country\": \"DE\", \+ \ \"email\": \"max@mustermann.de\", \+ \ \"phone\": \"49|40|1234560\", \+ \ \"fax\": \"||\", \+ \ \"mobile_phone\": \"49|0155|1234567\" \+ \ } "++-- invalid fields++test_emptyHashNotValid :: IO ()+test_emptyHashNotValid+ = assertInvalidAddress+ "{}"++test_someFieldsMissing :: IO ()+test_someFieldsMissing+ = assertInvalidAddress+ " { \+ \ \"street\": \"\", \+ \ \"zip_code\": \"\", \+ \ \"city\": \"\", \+ \ \"province\": \"\", \+ \ \"country\": \"\", \+ \ \"email\": \"\" \+ \ } "++parseAddress+ :: BSL.ByteString+ -> Maybe Address+parseAddress = decode++assertValidAddress, assertInvalidAddress+ :: BSL.ByteString+ -> IO ()+assertValidAddress = assertBool . isJust . parseAddress+assertInvalidAddress = assertBool . isNothing . parseAddress
+ tests/Types/AwardTest.hs view
@@ -0,0 +1,47 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}+{-# LANGUAGE OverloadedStrings #-}++module Types.AwardTest where++import Test.Framework+import Web.XING+import Data.Maybe+import Data.Aeson+import qualified Data.ByteString.Lazy as BSL++-- valid fields++noContentAward :: BSL.ByteString+noContentAward+ = " { \+ \ \"name\": \"\", \+ \ \"date_awarded\": 2007, \+ \ \"url\": null \+ \ } "++test_noContent :: IO ()+test_noContent+ = assertValidAward noContentAward++test_noContentMappedCorrect :: IO ()+test_noContentMappedCorrect+ = assertEqual (Award "" 2007 Nothing) (fromJust.parseAward $ noContentAward)++test_fullAwardMappedCorrect :: IO ()+test_fullAwardMappedCorrect+ = assertEqual (Award "Spacewalker" 1998 (Just "http://nasa.gov")) ((fromJust.parseAward)+ " { \+ \ \"name\": \"Spacewalker\", \+ \ \"url\": \"http://nasa.gov\", \+ \ \"date_awarded\": 1998 \+ \ } ")++parseAward+ :: BSL.ByteString+ -> Maybe Award+parseAward = decode++assertValidAward+ :: BSL.ByteString+ -> IO ()+assertValidAward = assertBool . isJust . parseAward
+ tests/Types/BirthDateTest.hs view
@@ -0,0 +1,70 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}+{-# LANGUAGE OverloadedStrings #-}++module Types.BirthDateTest where++import Test.Framework+import Web.XING+import Data.Maybe+import Data.Aeson+import qualified Data.ByteString.Lazy as BSL++-- Valid BirthDate++test_fullBirthDateCorrectMapped :: IO ()+test_fullBirthDateCorrectMapped+ = assertEqual (FullDate 1963 8 12) (fromJust $ parseBirthDate fullBirthDate)+ where+ fullBirthDate =+ " { \+ \ \"day\": 12, \+ \ \"month\": 8, \+ \ \"year\": 1963 \+ \ } "++test_dayOnlyCorrectMapped :: IO ()+test_dayOnlyCorrectMapped+ = assertEqual (DayOnly 12 8) (fromJust $ parseBirthDate dayOnly)+ where+ dayOnly =+ " { \+ \ \"day\": 12, \+ \ \"month\": 8, \+ \ \"year\": null \+ \ } "++-- Invalid BirthDate++test_emptyHash :: IO ()+test_emptyHash+ = assertInvalidBirthDate "{}"++test_nullValuesAreNotAValidBirthDate :: IO ()+test_nullValuesAreNotAValidBirthDate+ = assertInvalidBirthDate+ " { \+ \ \"day\": null, \+ \ \"month\": null, \+ \ \"year\": null \+ \ } "++test_incompleteHash :: IO ()+test_incompleteHash+ = assertInvalidBirthDate+ " { \+ \ \"day\": 12, \+ \ \"year\": 1963 \+ \ } "++parseBirthDate+ :: BSL.ByteString+ -> Maybe BirthDate+parseBirthDate = decode++assertInvalidBirthDate+ :: BSL.ByteString+ -> IO ()+assertInvalidBirthDate = assertBool . isNothing . parseBirthDate++main :: IO ()+main = htfMain htf_thisModulesTests
+ tests/Types/ProfessionalExperienceTest.hs view
@@ -0,0 +1,93 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}+{-# LANGUAGE OverloadedStrings #-}++module Types.ProfessionalExperienceTest where++import Test.Framework+import Web.XING+import Data.Maybe+import Data.Aeson+import qualified Data.ByteString.Lazy as BSL++-- valid fields++test_noContentValid :: IO ()+test_noContentValid+ = assertValidProfessionalExperience+ " { \+ \ \"title\": null, \+ \ \"begin_date\": null, \+ \ \"end_date\": null, \+ \ \"career_level\": null, \+ \ \"description\": null, \+ \ \"name\": null, \+ \ \"tag\": null, \+ \ \"company_size\": null, \+ \ \"url\": null, \+ \ \"industry\": \"OTHERS\" \+ \ } "++fullProfessionalExperience :: BSL.ByteString+fullProfessionalExperience =+ " { \+ \ \"title\": \"Softwareentwickler\", \+ \ \"begin_date\": \"2010-01\", \+ \ \"end_date\": \"2012-12\", \+ \ \"career_level\": \"PROFESSIONAL_EXPERIENCED\", \+ \ \"description\": \"awesome description\", \+ \ \"name\": \"XING AG\", \+ \ \"tag\": \"XINGAG\", \+ \ \"company_size\": \"201-500\", \+ \ \"url\": \"https://www.xing.com\", \+ \ \"industry\": \"OTHERS\" \+ \ } "++test_fullProfessionalExperienceValid :: IO ()+test_fullProfessionalExperienceValid+ = assertValidProfessionalExperience fullProfessionalExperience++test_contentMappedCorrect :: IO ()+test_contentMappedCorrect+ = assertEqual (ProfessionalExperience+ (Just "Softwareentwickler")+ (Just "2010-01")+ (Just "2012-12")+ (Just "PROFESSIONAL_EXPERIENCED")+ (Just "awesome description")+ (Just "XING AG")+ (Just "XINGAG")+ (Just "201-500")+ (Just "https://www.xing.com")+ "OTHERS") (fromJust $ parseProfessionalExperience fullProfessionalExperience)++-- invalid fields++test_emptyHashNotValid :: IO ()+test_emptyHashNotValid+ = assertInvalidProfessionalExperience+ "{}"++test_someFieldsMissing :: IO ()+test_someFieldsMissing+ = assertInvalidProfessionalExperience+ " { \+ \ \"name\": null, \+ \ \"tag\": null, \+ \ \"company_size\": null, \+ \ \"url\": null, \+ \ \"industry\": \"OTHERS\" \+ \ } "++parseProfessionalExperience+ :: BSL.ByteString+ -> Maybe ProfessionalExperience+parseProfessionalExperience = decode++assertValidProfessionalExperience, assertInvalidProfessionalExperience+ :: BSL.ByteString+ -> IO ()+assertValidProfessionalExperience = assertBool . isJust . parseProfessionalExperience+assertInvalidProfessionalExperience = assertBool . isNothing . parseProfessionalExperience++main :: IO ()+main = htfMain htf_thisModulesTests
+ tests/Types/User/FullUserTest.hs view
@@ -0,0 +1,88 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}+{-# LANGUAGE OverloadedStrings #-}++module Types.User.FullUserTest where++import Test.Framework+import Web.XING+import Data.Maybe+import Data.Aeson+import qualified Data.ByteString.Lazy as BSL++test_noContentValid :: IO ()+test_noContentValid+ = (assertBool . isJust . parseFullUser) fullUserWithoutContent++-- https://dev.xing.com/docs/user_profile+fullUserWithoutContent :: BSL.ByteString+fullUserWithoutContent =+ " { \+ \ \"id\": \"\", \+ \ \"display_name\": \"\", \+ \ \"permalink\": \"\", \+ \ \"first_name\": \"\", \+ \ \"last_name\": \"\", \+ \ \"page_name\": \"\", \+ \ \"gender\": \"m\", \+ \ \"active_email\": null, \+ \ \"time_zone\": { \+ \ \"utc_offset\": 2.0, \+ \ \"name\": \"Europe/Berlin\" \+ \ }, \+ \ \"premium_services\": [], \+ \ \"badges\": [], \+ \ \"languages\": {}, \+ \ \"wants\": \"\", \+ \ \"haves\": null, \+ \ \"interests\": null, \+ \ \"organisation_member\": null, \+ \ \"private_address\": { \+ \ \"street\": \"\", \+ \ \"zip_code\": \"\", \+ \ \"city\": \"\", \+ \ \"province\": \"\", \+ \ \"country\": \"\", \+ \ \"email\": \"\", \+ \ \"phone\": \"\", \+ \ \"fax\": \"\", \+ \ \"mobile_phone\": \"\" \+ \ }, \+ \ \"business_address\": { \+ \ \"street\": \"\", \+ \ \"zip_code\": \"\", \+ \ \"city\": \"\", \+ \ \"province\": \"\", \+ \ \"country\": \"\", \+ \ \"email\": \"\", \+ \ \"phone\": \"\", \+ \ \"fax\": \"\", \+ \ \"mobile_phone\": \"\" \+ \ }, \+ \ \"professional_experience\": { \+ \ \"primary_company\": { \+ \ \"title\": null, \+ \ \"begin_date\": null, \+ \ \"end_date\": null, \+ \ \"career_level\": null, \+ \ \"description\": null, \+ \ \+ \ \"name\": null, \+ \ \"tag\": null, \+ \ \"company_size\": null, \+ \ \"url\": null, \+ \ \"industry\": \"OTHERS\" \+ \ }, \+ \ \"non_primary_companies\": [], \+ \ \"awards\": [] \+ \ }, \+ \ \"photo_urls\": {}, \+ \ \"birth_date\": {} \+ \ } "++parseFullUser+ :: BSL.ByteString+ -> Maybe FullUser+parseFullUser = decode++main :: IO ()+main = htfMain htf_thisModulesTests
+ tests/Types/User/MinimalUserTest.hs view
@@ -0,0 +1,38 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}+{-# LANGUAGE OverloadedStrings #-}++module Types.User.MinimalUserTest where++import Test.Framework+import Web.XING+import Data.Maybe+import Data.Map+import Data.Aeson+import qualified Data.ByteString.Lazy as BSL++test_noContentValid :: IO ()+test_noContentValid+ = (assertBool . isJust . parseMinimalUser) minimalUserWithoutContent++test_minimalUserCorrectMapped :: IO ()+test_minimalUserCorrectMapped+ = assertEqual (MinimalUser "" "" "" empty) (fromJust $ parseMinimalUser minimalUserWithoutContent)++minimalUserWithoutContent :: BSL.ByteString+minimalUserWithoutContent =+ " { \+ \ \"id_card\": { \+ \ \"id\": \"\", \+ \ \"display_name\": \"\", \+ \ \"permalink\": \"\", \+ \ \"photo_urls\": {} \+ \ } \+ \ } "++parseMinimalUser+ :: BSL.ByteString+ -> Maybe MinimalUser+parseMinimalUser = decode++main :: IO ()+main = htfMain htf_thisModulesTests
+ xing-api.cabal view
@@ -0,0 +1,143 @@+name: xing-api+version: 0.1.1+synopsis: Wrapper for the XING API, v1.+description: This package is currently under development and not considered stable.+ The versioning follows <http://semver.org> and the first stable version will be release as 1.0.0.+ .+ This package includes a couple of demo programs.+ By default these demos won't be built and you'll only install the library.+ You have to set the /demos/ flag if you want to install them.+ To use these demos, you also have to obtain an API consumer key from+ <https://dev.xing.com/applications> (a /test key/ will suffice).+ .+ >cabal install -f demos xing-api+license: BSD3+license-file: LICENSE+category: Web+copyright: Copyright 2013 Jan Ahrens+author: Jan Ahrens+maintainer: Jan Ahrens+cabal-version: >=1.10+homepage: http://github.com/JanAhrens/xing-api-haskell+bug-reports: http://github.com/JanAhrens/xing-api-haskell/issues+build-type: Simple++flag demos+ default: False+ description: Build demo programs++flag minimal-demo+ default: False+ description: Build the minimal demo from the README. It's not runnable unless you modify the source.++source-repository head+ type: git+ location: http://github.com/JanAhrens/xing-api-haskell.git++library+ exposed-modules: Web.XING++ build-depends: base == 4.5.*+ , containers == 0.4.*+ , time == 1.4.*+ , text == 0.11.*+ , authenticate-oauth == 1.4.*+ , http-types == 0.8.*+ , http-conduit == 1.8.*+ , resourcet == 0.4.*+ , transformers == 0.2.*+ , text == 0.11.*+ , bytestring == 0.9.*+ , aeson == 0.6.*+ , lifted-base == 0.2.*+ , monad-control == 0.3.*++ other-modules: Web.XING.API+ , Web.XING.API.Error+ , Web.XING.Calls.IdCard+ , Web.XING.Calls.User+ , Web.XING.Internal.AuthenticateOAuthPatch+ , Web.XING.Types+ , Web.XING.Types.User+ , Web.XING.Types.User.MinimalUser+ , Web.XING.Types.User.FullUser+ , Web.XING.Types.Address+ , Web.XING.Types.Award+ , Web.XING.Types.BirthDate+ , Web.XING.Types.ProfessionalExperience+ , Web.XING.Auth++ hs-source-dirs: lib+ ghc-options: -Wall+ default-language: Haskell2010++Test-Suite TestMain+ type: exitcode-stdio-1.0+ build-depends: base == 4.5.*+ , HTF == 0.10.*+ , text == 0.11.*+ , bytestring == 0.9.*+ , aeson == 0.6.*+ , containers == 0.4.*+ , time == 1.4.*+ , xing-api+ other-modules: Types.AddressTest+ , Types.AwardTest+ , Types.BirthDateTest+ , Types.ProfessionalExperienceTest+ , Types.User.FullUserTest+ , Types.User.MinimalUserTest+ hs-source-dirs: tests+ main-is: Main.hs+ ghc-options: -Wall+ default-language: Haskell2010++executable xing-api-cli-demo+ if flag(demos)+ buildable: True+ build-depends: base == 4.*+ , bytestring == 0.9.*+ , monad-control == 0.3.*+ , resourcet == 0.4.*+ , text == 0.11.*+ , xing-api+ else+ buildable: False+ hs-source-dirs: demos+ main-is: cli-demo.hs+ GHC-options: -Wall+ Default-language: Haskell2010++executable xing-api-yesod-demo+ hs-source-dirs: demos+ if flag(demos)+ buildable: True+ build-depends: base == 4.*+ , bytestring == 0.9.*+ , containers == 0.4.*+ , hamlet == 1.1.*+ , http-conduit == 1.8.*+ , shakespeare-i18n == 1.0.*+ , text == 0.11.*+ , time == 1.4.*+ , warp == 1.3.*+ , xing-api+ , yesod-core == 1.1.*+ else+ buildable: False+ main-is: yesod-demo.hs+ GHC-options: -Wall+ Default-language: Haskell2010++executable xing-api-minimal-demo+ hs-source-dirs: demos+ if flag(minimal-demo)+ buildable: True+ build-depends: base == 4.*+ , bytestring == 0.9.*+ , xing-api+ else+ buildable: False+ main-is: minimal-demo.hs+ GHC-options: -Wall+ Default-language: Haskell2010