{-# LANGUAGE CPP, OverloadedStrings, ScopedTypeVariables #-}

module Network.Gitit.Authentication.Github ( loginGithubUser
                                           , getGithubUser
                                           , GithubCallbackPars
                                           , GithubLoginError
                                           , ghUserMessage
                                           , ghDetails) where

import Network.Gitit.Types
import Network.Gitit.Server
import Network.Gitit.State
import Network.Gitit.Util
import Network.Gitit.Framework
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy as BSL
import qualified URI.ByteString as URI
import Network.HTTP.Conduit
#if MIN_VERSION_hoauth2(2,15,0)
import Network.OAuth2
#else
import Network.OAuth.OAuth2
#endif
import Control.Monad (liftM, mplus, mzero)
import Data.Maybe
import Data.Aeson
import Data.Text (Text, pack, unpack)
import Data.Text.Encoding (encodeUtf8)
import Control.Applicative
import Control.Monad ((>=>))
import Control.Monad.Trans (liftIO)
import Data.UUID (toString)
import Data.UUID.V4 (nextRandom)
import qualified Control.Exception as E
import Control.Monad.Except
import Prelude

loginGithubUser :: OAuth2 -> Params -> Handler
loginGithubUser :: OAuth2 -> Params -> Handler
loginGithubUser OAuth2
githubKey Params
params = do
  state <- IO [Char] -> ServerPartT (ReaderT WikiState IO) [Char]
forall a. IO a -> ServerPartT (ReaderT WikiState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> ServerPartT (ReaderT WikiState IO) [Char])
-> IO [Char] -> ServerPartT (ReaderT WikiState IO) [Char]
forall a b. (a -> b) -> a -> b
$ (UUID -> [Char]) -> IO UUID -> IO [Char]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UUID -> [Char]
toString IO UUID
nextRandom
  base' <- getWikiBase
  let destination = Params -> [Char]
pDestination Params
params [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
`orIfNull` ([Char]
base' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"/")
  key <- newSession $ sessionDataGithubStateUrl state destination
  cfg <- getConfig
  addCookie (MaxAge $ sessionTimeout cfg) (mkSessionCookie key)
  let usingOrg = Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Text -> Bool) -> Maybe Text -> Bool
forall a b. (a -> b) -> a -> b
$ GithubConfig -> Maybe Text
org (GithubConfig -> Maybe Text) -> GithubConfig -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Config -> GithubConfig
githubAuth Config
cfg
  let scopes = [Char]
"user:email" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ if Bool
usingOrg then [Char]
",read:org" else [Char]
""
  let url = [(ByteString, ByteString)] -> URIRef Absolute -> URIRef Absolute
forall a. [(ByteString, ByteString)] -> URIRef a -> URIRef a
appendQueryParams [(ByteString
"state", [Char] -> ByteString
BS.pack [Char]
state), (ByteString
"scope", [Char] -> ByteString
BS.pack [Char]
scopes)] (URIRef Absolute -> URIRef Absolute)
-> URIRef Absolute -> URIRef Absolute
forall a b. (a -> b) -> a -> b
$ OAuth2 -> URIRef Absolute
authorizationUrl OAuth2
githubKey
  seeOther (BS.unpack (URI.serializeURIRef' url)) $ toResponse ("redirecting to github" :: String)

data GithubLoginError = GithubLoginError { GithubLoginError -> [Char]
ghUserMessage :: String
                                         , GithubLoginError -> Maybe [Char]
ghDetails :: Maybe String
                                         }

getGithubUser :: GithubConfig            -- ^ Oauth2 configuration (client secret)
              -> GithubCallbackPars      -- ^ Authentication code gained after authorization
              -> String                  -- ^ Github state, we expect the state we sent in loginGithubUser
              -> GititServerPart (Either GithubLoginError User) -- ^ user email and name (password 'none')
getGithubUser :: GithubConfig
-> GithubCallbackPars
-> [Char]
-> GititServerPart (Either GithubLoginError User)
getGithubUser GithubConfig
ghConfig GithubCallbackPars
githubCallbackPars [Char]
githubState = IO (Either GithubLoginError User)
-> GititServerPart (Either GithubLoginError User)
forall a. IO a -> ServerPartT (ReaderT WikiState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either GithubLoginError User)
 -> GititServerPart (Either GithubLoginError User))
-> IO (Either GithubLoginError User)
-> GititServerPart (Either GithubLoginError User)
forall a b. (a -> b) -> a -> b
$
  ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings IO Manager
-> (Manager -> IO (Either GithubLoginError User))
-> IO (Either GithubLoginError User)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Manager -> IO (Either GithubLoginError User)
forall {m :: * -> *}.
MonadIO m =>
Manager -> m (Either GithubLoginError User)
getUserInternal
    where
    getUserInternal :: Manager -> m (Either GithubLoginError User)
getUserInternal Manager
mgr =
        IO (Either GithubLoginError User)
-> m (Either GithubLoginError User)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either GithubLoginError User)
 -> m (Either GithubLoginError User))
-> IO (Either GithubLoginError User)
-> m (Either GithubLoginError User)
forall a b. (a -> b) -> a -> b
$ ExceptT GithubLoginError IO User
-> IO (Either GithubLoginError User)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT GithubLoginError IO User
 -> IO (Either GithubLoginError User))
-> ExceptT GithubLoginError IO User
-> IO (Either GithubLoginError User)
forall a b. (a -> b) -> a -> b
$ do
            let (Just [Char]
state) = GithubCallbackPars -> Maybe [Char]
rState GithubCallbackPars
githubCallbackPars
            if [Char]
state [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
githubState
              then do
                let (Just [Char]
code) = GithubCallbackPars -> Maybe [Char]
rCode GithubCallbackPars
githubCallbackPars
                at <- (TokenResponseError -> GithubLoginError)
-> ExceptT TokenResponseError IO OAuth2Token
-> ExceptT GithubLoginError IO OAuth2Token
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT ([Char] -> TokenResponseError -> GithubLoginError
forall {a}. Show a => [Char] -> a -> GithubLoginError
oauthToGithubError [Char]
"No access token found yet")
                      (ExceptT TokenResponseError IO OAuth2Token
 -> ExceptT GithubLoginError IO OAuth2Token)
-> ExceptT TokenResponseError IO OAuth2Token
-> ExceptT GithubLoginError IO OAuth2Token
forall a b. (a -> b) -> a -> b
$ Manager
-> OAuth2
-> ExchangeToken
-> ExceptT TokenResponseError IO OAuth2Token
forall (m :: * -> *).
MonadIO m =>
Manager
-> OAuth2
-> ExchangeToken
-> ExceptT TokenResponseError m OAuth2Token
fetchAccessToken Manager
mgr (GithubConfig -> OAuth2
oAuth2 GithubConfig
ghConfig) (Text -> ExchangeToken
ExchangeToken (Text -> ExchangeToken) -> Text -> ExchangeToken
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
pack [Char]
code)
                liftIO >=> liftEither $ ifSuccess "User Authentication failed"
                           (userInfo mgr (accessToken at))
                           (\GithubUser
githubUser -> [Char]
-> IO (Either ByteString [GithubUserMail])
-> ([GithubUserMail] -> IO (Either GithubLoginError User))
-> IO (Either GithubLoginError User)
forall {a} {t} {b}.
[Char]
-> IO (Either a t)
-> (t -> IO (Either GithubLoginError b))
-> IO (Either GithubLoginError b)
ifSuccess
                            ([Char]
"No email for user " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
unpack (GithubUser -> Text
gLogin GithubUser
githubUser) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" returned by Github")
                            (Manager -> AccessToken -> IO (Either ByteString [GithubUserMail])
mailInfo Manager
mgr (OAuth2Token -> AccessToken
accessToken OAuth2Token
at))
                            (\[GithubUserMail]
githubUserMail -> do
                                       let gitLogin :: Text
gitLogin = GithubUser -> Text
gLogin GithubUser
githubUser
                                       user <- [Char] -> [Char] -> [Char] -> IO User
mkUser (Text -> [Char]
unpack Text
gitLogin)
                                                   (Text -> [Char]
unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ GithubUserMail -> Text
email (GithubUserMail -> Text) -> GithubUserMail -> Text
forall a b. (a -> b) -> a -> b
$ [GithubUserMail] -> GithubUserMail
forall a. HasCallStack => [a] -> a
head ((GithubUserMail -> Bool) -> [GithubUserMail] -> [GithubUserMail]
forall a. (a -> Bool) -> [a] -> [a]
filter GithubUserMail -> Bool
primary [GithubUserMail]
githubUserMail))
                                                   [Char]
"none"
                                       let mbOrg = GithubConfig -> Maybe Text
org GithubConfig
ghConfig
                                       case mbOrg of
                                             Maybe Text
Nothing -> Either GithubLoginError User -> IO (Either GithubLoginError User)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either GithubLoginError User -> IO (Either GithubLoginError User))
-> Either GithubLoginError User
-> IO (Either GithubLoginError User)
forall a b. (a -> b) -> a -> b
$ User -> Either GithubLoginError User
forall a b. b -> Either a b
Right User
user
                                             Just Text
githuborg -> [Char]
-> IO (Either ByteString ByteString)
-> (ByteString -> IO (Either GithubLoginError User))
-> IO (Either GithubLoginError User)
forall {a} {t} {b}.
[Char]
-> IO (Either a t)
-> (t -> IO (Either GithubLoginError b))
-> IO (Either GithubLoginError b)
ifSuccess
                                                      ([Char]
"Membership check failed: the user " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
unpack Text
gitLogin [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++  [Char]
" is required to be a member of the organization "  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
unpack Text
githuborg [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".")
                                                      (Text
-> Text
-> Manager
-> AccessToken
-> IO (Either ByteString ByteString)
orgInfo Text
gitLogin Text
githuborg Manager
mgr (OAuth2Token -> AccessToken
accessToken OAuth2Token
at))
                                                      (\ByteString
_ -> Either GithubLoginError User -> IO (Either GithubLoginError User)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either GithubLoginError User -> IO (Either GithubLoginError User))
-> Either GithubLoginError User
-> IO (Either GithubLoginError User)
forall a b. (a -> b) -> a -> b
$ User -> Either GithubLoginError User
forall a b. b -> Either a b
Right User
user)))
              else
                GithubLoginError -> ExceptT GithubLoginError IO User
forall a. GithubLoginError -> ExceptT GithubLoginError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GithubLoginError -> ExceptT GithubLoginError IO User)
-> GithubLoginError -> ExceptT GithubLoginError IO User
forall a b. (a -> b) -> a -> b
$
                       [Char] -> Maybe [Char] -> GithubLoginError
GithubLoginError ([Char]
"The state sent to github is not the same as the state received: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
state [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", but expected sent state: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++  [Char]
githubState)
                                        Maybe [Char]
forall a. Maybe a
Nothing
    ifSuccess :: [Char]
-> IO (Either a t)
-> (t -> IO (Either GithubLoginError b))
-> IO (Either GithubLoginError b)
ifSuccess [Char]
errMsg IO (Either a t)
failableAction t -> IO (Either GithubLoginError b)
successAction  = IO (Either GithubLoginError b)
-> (SomeException -> IO (Either GithubLoginError b))
-> IO (Either GithubLoginError b)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch
                                                 (do Right outcome <- IO (Either a t)
failableAction
                                                     successAction outcome)
                                                 (\SomeException
exception -> IO (Either GithubLoginError b) -> IO (Either GithubLoginError b)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either GithubLoginError b) -> IO (Either GithubLoginError b))
-> IO (Either GithubLoginError b) -> IO (Either GithubLoginError b)
forall a b. (a -> b) -> a -> b
$ Either GithubLoginError b -> IO (Either GithubLoginError b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either GithubLoginError b -> IO (Either GithubLoginError b))
-> Either GithubLoginError b -> IO (Either GithubLoginError b)
forall a b. (a -> b) -> a -> b
$ GithubLoginError -> Either GithubLoginError b
forall a b. a -> Either a b
Left (GithubLoginError -> Either GithubLoginError b)
-> GithubLoginError -> Either GithubLoginError b
forall a b. (a -> b) -> a -> b
$
                                                                [Char] -> Maybe [Char] -> GithubLoginError
GithubLoginError [Char]
errMsg
                                                                                 ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ SomeException -> [Char]
forall a. Show a => a -> [Char]
show (SomeException
exception :: E.SomeException)))
    oauthToGithubError :: [Char] -> a -> GithubLoginError
oauthToGithubError [Char]
errMsg a
e = [Char] -> Maybe [Char] -> GithubLoginError
GithubLoginError [Char]
errMsg ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ a -> [Char]
forall a. Show a => a -> [Char]
show a
e)

data GithubCallbackPars = GithubCallbackPars { GithubCallbackPars -> Maybe [Char]
rCode :: Maybe String
                                             , GithubCallbackPars -> Maybe [Char]
rState :: Maybe String }
                          deriving Int -> GithubCallbackPars -> [Char] -> [Char]
[GithubCallbackPars] -> [Char] -> [Char]
GithubCallbackPars -> [Char]
(Int -> GithubCallbackPars -> [Char] -> [Char])
-> (GithubCallbackPars -> [Char])
-> ([GithubCallbackPars] -> [Char] -> [Char])
-> Show GithubCallbackPars
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> GithubCallbackPars -> [Char] -> [Char]
showsPrec :: Int -> GithubCallbackPars -> [Char] -> [Char]
$cshow :: GithubCallbackPars -> [Char]
show :: GithubCallbackPars -> [Char]
$cshowList :: [GithubCallbackPars] -> [Char] -> [Char]
showList :: [GithubCallbackPars] -> [Char] -> [Char]
Show

instance FromData GithubCallbackPars where
    fromData :: RqData GithubCallbackPars
fromData = do
         vCode <- ([Char] -> Maybe [Char]) -> RqData [Char] -> RqData (Maybe [Char])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> RqData [Char]
forall (m :: * -> *).
(Functor m, Monad m, HasRqData m) =>
[Char] -> m [Char]
look [Char]
"code") RqData (Maybe [Char])
-> RqData (Maybe [Char]) -> RqData (Maybe [Char])
forall a. RqData a -> RqData a -> RqData a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe [Char] -> RqData (Maybe [Char])
forall a. a -> RqData a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing
         vState <- liftM Just (look "state") `mplus` return Nothing
         return GithubCallbackPars {rCode = vCode, rState = vState}

#if MIN_VERSION_hoauth2(1, 9, 0)
userInfo :: Manager -> AccessToken -> IO (Either BSL.ByteString GithubUser)
#else
userInfo :: Manager -> AccessToken -> IO (OAuth2Result OA.Errors GithubUser)
#endif
userInfo :: Manager -> AccessToken -> IO (Either ByteString GithubUser)
userInfo Manager
mgr AccessToken
token = ExceptT ByteString IO GithubUser
-> IO (Either ByteString GithubUser)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ByteString IO GithubUser
 -> IO (Either ByteString GithubUser))
-> ExceptT ByteString IO GithubUser
-> IO (Either ByteString GithubUser)
forall a b. (a -> b) -> a -> b
$ Manager
-> AccessToken
-> URIRef Absolute
-> ExceptT ByteString IO GithubUser
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Manager -> AccessToken -> URIRef Absolute -> ExceptT ByteString m a
authGetJSON Manager
mgr AccessToken
token (URIRef Absolute -> ExceptT ByteString IO GithubUser)
-> URIRef Absolute -> ExceptT ByteString IO GithubUser
forall a b. (a -> b) -> a -> b
$ ByteString -> URIRef Absolute
githubUri ByteString
"/user"

#if MIN_VERSION_hoauth2(1, 9, 0)
mailInfo :: Manager -> AccessToken -> IO (Either BSL.ByteString [GithubUserMail])
#else
mailInfo :: Manager -> AccessToken -> IO (OAuth2Result OA.Errors [GithubUserMail])
#endif
mailInfo :: Manager -> AccessToken -> IO (Either ByteString [GithubUserMail])
mailInfo Manager
mgr AccessToken
token = ExceptT ByteString IO [GithubUserMail]
-> IO (Either ByteString [GithubUserMail])
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ByteString IO [GithubUserMail]
 -> IO (Either ByteString [GithubUserMail]))
-> ExceptT ByteString IO [GithubUserMail]
-> IO (Either ByteString [GithubUserMail])
forall a b. (a -> b) -> a -> b
$ Manager
-> AccessToken
-> URIRef Absolute
-> ExceptT ByteString IO [GithubUserMail]
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Manager -> AccessToken -> URIRef Absolute -> ExceptT ByteString m a
authGetJSON Manager
mgr AccessToken
token (URIRef Absolute -> ExceptT ByteString IO [GithubUserMail])
-> URIRef Absolute -> ExceptT ByteString IO [GithubUserMail]
forall a b. (a -> b) -> a -> b
$ ByteString -> URIRef Absolute
githubUri ByteString
"/user/emails"

#if MIN_VERSION_hoauth2(1, 9, 0)
orgInfo  :: Text -> Text -> Manager -> AccessToken -> IO (Either BSL.ByteString BSL.ByteString)
#else
orgInfo  :: Text -> Text -> Manager -> AccessToken -> IO (OAuth2Result OA.Errors BSL.ByteString)
#endif
orgInfo :: Text
-> Text
-> Manager
-> AccessToken
-> IO (Either ByteString ByteString)
orgInfo Text
gitLogin Text
githubOrg Manager
mgr AccessToken
token = do
  let url :: URIRef Absolute
url = ByteString -> URIRef Absolute
githubUri (ByteString -> URIRef Absolute) -> ByteString -> URIRef Absolute
forall a b. (a -> b) -> a -> b
$ ByteString
"/orgs/" ByteString -> ByteString -> ByteString
`BS.append` Text -> ByteString
encodeUtf8 Text
githubOrg ByteString -> ByteString -> ByteString
`BS.append` ByteString
"/members/" ByteString -> ByteString -> ByteString
`BS.append` Text -> ByteString
encodeUtf8 Text
gitLogin
  ExceptT ByteString IO ByteString
-> IO (Either ByteString ByteString)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ByteString IO ByteString
 -> IO (Either ByteString ByteString))
-> ExceptT ByteString IO ByteString
-> IO (Either ByteString ByteString)
forall a b. (a -> b) -> a -> b
$ Manager
-> AccessToken
-> URIRef Absolute
-> ExceptT ByteString IO ByteString
forall (m :: * -> *).
MonadIO m =>
Manager
-> AccessToken
-> URIRef Absolute
-> ExceptT ByteString m ByteString
authGetBS Manager
mgr AccessToken
token URIRef Absolute
url

type UriPath = BS.ByteString

githubUri :: UriPath -> URI.URI
githubUri :: ByteString -> URIRef Absolute
githubUri ByteString
p = URI.URI { uriScheme :: Scheme
URI.uriScheme    = ByteString -> Scheme
URI.Scheme ByteString
"https"
                      , uriAuthority :: Maybe Authority
URI.uriAuthority = Authority -> Maybe Authority
forall a. a -> Maybe a
Just (Authority -> Maybe Authority) -> Authority -> Maybe Authority
forall a b. (a -> b) -> a -> b
$ Maybe UserInfo -> Host -> Maybe Port -> Authority
URI.Authority Maybe UserInfo
forall a. Maybe a
Nothing (ByteString -> Host
URI.Host ByteString
"api.github.com") Maybe Port
forall a. Maybe a
Nothing
                      , uriPath :: ByteString
URI.uriPath      = ByteString
p
                      , uriQuery :: Query
URI.uriQuery     = [(ByteString, ByteString)] -> Query
URI.Query []
                      , uriFragment :: Maybe ByteString
URI.uriFragment  = Maybe ByteString
forall a. Maybe a
Nothing }

data GithubUser = GithubUser { GithubUser -> Text
gLogin :: Text
                             } deriving (Int -> GithubUser -> [Char] -> [Char]
[GithubUser] -> [Char] -> [Char]
GithubUser -> [Char]
(Int -> GithubUser -> [Char] -> [Char])
-> (GithubUser -> [Char])
-> ([GithubUser] -> [Char] -> [Char])
-> Show GithubUser
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> GithubUser -> [Char] -> [Char]
showsPrec :: Int -> GithubUser -> [Char] -> [Char]
$cshow :: GithubUser -> [Char]
show :: GithubUser -> [Char]
$cshowList :: [GithubUser] -> [Char] -> [Char]
showList :: [GithubUser] -> [Char] -> [Char]
Show, GithubUser -> GithubUser -> Bool
(GithubUser -> GithubUser -> Bool)
-> (GithubUser -> GithubUser -> Bool) -> Eq GithubUser
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GithubUser -> GithubUser -> Bool
== :: GithubUser -> GithubUser -> Bool
$c/= :: GithubUser -> GithubUser -> Bool
/= :: GithubUser -> GithubUser -> Bool
Eq)

instance FromJSON GithubUser where
    parseJSON :: Value -> Parser GithubUser
parseJSON (Object Object
o) = Text -> GithubUser
GithubUser
                           (Text -> GithubUser) -> Parser Text -> Parser GithubUser
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"login"
    parseJSON Value
_ = Parser GithubUser
forall a. Parser a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

data GithubUserMail = GithubUserMail { GithubUserMail -> Text
email :: Text
                                     , GithubUserMail -> Bool
primary :: Bool
                             } deriving (Int -> GithubUserMail -> [Char] -> [Char]
[GithubUserMail] -> [Char] -> [Char]
GithubUserMail -> [Char]
(Int -> GithubUserMail -> [Char] -> [Char])
-> (GithubUserMail -> [Char])
-> ([GithubUserMail] -> [Char] -> [Char])
-> Show GithubUserMail
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> GithubUserMail -> [Char] -> [Char]
showsPrec :: Int -> GithubUserMail -> [Char] -> [Char]
$cshow :: GithubUserMail -> [Char]
show :: GithubUserMail -> [Char]
$cshowList :: [GithubUserMail] -> [Char] -> [Char]
showList :: [GithubUserMail] -> [Char] -> [Char]
Show, GithubUserMail -> GithubUserMail -> Bool
(GithubUserMail -> GithubUserMail -> Bool)
-> (GithubUserMail -> GithubUserMail -> Bool) -> Eq GithubUserMail
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GithubUserMail -> GithubUserMail -> Bool
== :: GithubUserMail -> GithubUserMail -> Bool
$c/= :: GithubUserMail -> GithubUserMail -> Bool
/= :: GithubUserMail -> GithubUserMail -> Bool
Eq)

instance FromJSON GithubUserMail where
    parseJSON :: Value -> Parser GithubUserMail
parseJSON (Object Object
o) = Text -> Bool -> GithubUserMail
GithubUserMail
                           (Text -> Bool -> GithubUserMail)
-> Parser Text -> Parser (Bool -> GithubUserMail)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"email"
                           Parser (Bool -> GithubUserMail)
-> Parser Bool -> Parser GithubUserMail
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"primary"
    parseJSON Value
_ = Parser GithubUserMail
forall a. Parser a
forall (m :: * -> *) a. MonadPlus m => m a
mzero