{-# 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
import Network.OAuth.OAuth2
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.Trans (liftIO)
import Data.UUID (toString)
import Data.UUID.V4 (nextRandom)
import qualified Control.Exception as E
import Prelude

loginGithubUser :: OAuth2 -> Params -> Handler
loginGithubUser :: OAuth2 -> Params -> Handler
loginGithubUser OAuth2
githubKey Params
params = do
  String
state <- IO String -> ServerPartT (ReaderT WikiState IO) String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> ServerPartT (ReaderT WikiState IO) String)
-> IO String -> ServerPartT (ReaderT WikiState IO) String
forall a b. (a -> b) -> a -> b
$ (UUID -> String) -> IO UUID -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UUID -> String
toString IO UUID
nextRandom
  String
base' <- ServerPartT (ReaderT WikiState IO) String
forall (m :: * -> *). ServerMonad m => m String
getWikiBase
  let destination :: String
destination = Params -> String
pDestination Params
params String -> String -> String
forall a. [a] -> [a] -> [a]
`orIfNull` (String
base' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/")
  SessionKey
key <- SessionData -> ServerPartT (ReaderT WikiState IO) SessionKey
forall (m :: * -> *). MonadIO m => SessionData -> m SessionKey
newSession (SessionData -> ServerPartT (ReaderT WikiState IO) SessionKey)
-> SessionData -> ServerPartT (ReaderT WikiState IO) SessionKey
forall a b. (a -> b) -> a -> b
$ String -> String -> SessionData
sessionDataGithubStateUrl String
state String
destination
  Config
cfg <- GititServerPart Config
getConfig
  CookieLife -> Cookie -> ServerPartT (ReaderT WikiState IO) ()
forall (m :: * -> *).
(MonadIO m, FilterMonad Response m) =>
CookieLife -> Cookie -> m ()
addCookie (Int -> CookieLife
MaxAge (Int -> CookieLife) -> Int -> CookieLife
forall a b. (a -> b) -> a -> b
$ Config -> Int
sessionTimeout Config
cfg) (String -> String -> Cookie
mkCookie String
"sid" (SessionKey -> String
forall a. Show a => a -> String
show SessionKey
key))
  let usingOrg :: Bool
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 :: String
scopes = String
"user:email" String -> String -> String
forall a. [a] -> [a] -> [a]
++ if Bool
usingOrg then String
",read:org" else String
""
  let url :: URIRef Absolute
url = [(ByteString, ByteString)] -> URIRef Absolute -> URIRef Absolute
forall a. [(ByteString, ByteString)] -> URIRef a -> URIRef a
appendQueryParams [(ByteString
"state", String -> ByteString
BS.pack String
state), (ByteString
"scope", String -> ByteString
BS.pack String
scopes)] (URIRef Absolute -> URIRef Absolute)
-> URIRef Absolute -> URIRef Absolute
forall a b. (a -> b) -> a -> b
$ OAuth2 -> URIRef Absolute
authorizationUrl OAuth2
githubKey
  String -> Response -> Handler
forall (m :: * -> *) uri res.
(FilterMonad Response m, ToSURI uri) =>
uri -> res -> m res
seeOther (ByteString -> String
BS.unpack (URIRef Absolute -> ByteString
forall a. URIRef a -> ByteString
URI.serializeURIRef' URIRef Absolute
url)) (Response -> Handler) -> Response -> Handler
forall a b. (a -> b) -> a -> b
$ String -> Response
forall a. ToMessage a => a -> Response
toResponse (String
"redirecting to github" :: String)

data GithubLoginError = GithubLoginError { GithubLoginError -> String
ghUserMessage :: String
                                         , GithubLoginError -> Maybe String
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
-> String
-> GititServerPart (Either GithubLoginError User)
getGithubUser GithubConfig
ghConfig GithubCallbackPars
githubCallbackPars String
githubState = IO (Either GithubLoginError User)
-> GititServerPart (Either GithubLoginError User)
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 (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 (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
$ do
            let (Just String
state) = GithubCallbackPars -> Maybe String
rState GithubCallbackPars
githubCallbackPars
            if String
state String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
githubState
              then do
                let (Just String
code) = GithubCallbackPars -> Maybe String
rCode GithubCallbackPars
githubCallbackPars
                String
-> IO (Either (OAuth2Error Errors) OAuth2Token)
-> (OAuth2Token -> IO (Either GithubLoginError User))
-> IO (Either GithubLoginError User)
forall a t b.
String
-> IO (Either a t)
-> (t -> IO (Either GithubLoginError b))
-> IO (Either GithubLoginError b)
ifSuccess
                   String
"No access token found yet"
                   (Manager
-> OAuth2
-> ExchangeToken
-> IO (Either (OAuth2Error Errors) OAuth2Token)
fetchAccessToken Manager
mgr (GithubConfig -> OAuth2
oAuth2 GithubConfig
ghConfig) (Text -> ExchangeToken
ExchangeToken (Text -> ExchangeToken) -> Text -> ExchangeToken
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
code))
                   (\OAuth2Token
at -> String
-> IO (Either ByteString GithubUser)
-> (GithubUser -> IO (Either GithubLoginError User))
-> IO (Either GithubLoginError User)
forall a t b.
String
-> IO (Either a t)
-> (t -> IO (Either GithubLoginError b))
-> IO (Either GithubLoginError b)
ifSuccess
                           String
"User Authentication failed"
                           (Manager -> AccessToken -> IO (Either ByteString GithubUser)
userInfo Manager
mgr (OAuth2Token -> AccessToken
accessToken OAuth2Token
at))
                           (\GithubUser
githubUser -> String
-> IO (Either ByteString [GithubUserMail])
-> ([GithubUserMail] -> IO (Either GithubLoginError User))
-> IO (Either GithubLoginError User)
forall a t b.
String
-> IO (Either a t)
-> (t -> IO (Either GithubLoginError b))
-> IO (Either GithubLoginError b)
ifSuccess
                            (String
"No email for user " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
unpack (GithubUser -> Text
gLogin GithubUser
githubUser) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" 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
user <- String -> String -> String -> IO User
mkUser (Text -> String
unpack Text
gitLogin)
                                                   (Text -> String
unpack (Text -> String) -> Text -> String
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. [a] -> a
head ((GithubUserMail -> Bool) -> [GithubUserMail] -> [GithubUserMail]
forall a. (a -> Bool) -> [a] -> [a]
filter GithubUserMail -> Bool
primary [GithubUserMail]
githubUserMail))
                                                   String
"none"
                                       let mbOrg :: Maybe Text
mbOrg = GithubConfig -> Maybe Text
org GithubConfig
ghConfig
                                       case Maybe Text
mbOrg of
                                             Maybe Text
Nothing -> Either GithubLoginError User -> IO (Either GithubLoginError User)
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 -> String
-> IO (Either ByteString ByteString)
-> (ByteString -> IO (Either GithubLoginError User))
-> IO (Either GithubLoginError User)
forall a t b.
String
-> IO (Either a t)
-> (t -> IO (Either GithubLoginError b))
-> IO (Either GithubLoginError b)
ifSuccess
                                                      (String
"Membership check failed: the user " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
unpack Text
gitLogin String -> String -> String
forall a. [a] -> [a] -> [a]
++  String
" is required to be a member of the organization "  String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
unpack Text
githuborg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".")
                                                      (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 (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
                Either GithubLoginError User -> IO (Either GithubLoginError User)
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
$ GithubLoginError -> Either GithubLoginError User
forall a b. a -> Either a b
Left (GithubLoginError -> Either GithubLoginError User)
-> GithubLoginError -> Either GithubLoginError User
forall a b. (a -> b) -> a -> b
$
                       String -> Maybe String -> GithubLoginError
GithubLoginError (String
"The state sent to github is not the same as the state received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
state String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", but expected sent state: " String -> String -> String
forall a. [a] -> [a] -> [a]
++  String
githubState)
                                        Maybe String
forall a. Maybe a
Nothing
    ifSuccess :: String
-> IO (Either a t)
-> (t -> IO (Either GithubLoginError b))
-> IO (Either GithubLoginError b)
ifSuccess String
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 t
outcome <- IO (Either a t)
failableAction
                                                     t -> IO (Either GithubLoginError b)
successAction t
outcome)
                                                 (\SomeException
exception -> IO (Either GithubLoginError b) -> IO (Either GithubLoginError b)
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 (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
$
                                                                String -> Maybe String -> GithubLoginError
GithubLoginError String
errMsg
                                                                                 (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show (SomeException
exception :: E.SomeException)))

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

instance FromData GithubCallbackPars where
    fromData :: RqData GithubCallbackPars
fromData = do
         Maybe String
vCode <- (String -> Maybe String) -> RqData String -> RqData (Maybe String)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM String -> Maybe String
forall a. a -> Maybe a
Just (String -> RqData String
forall (m :: * -> *).
(Functor m, Monad m, HasRqData m) =>
String -> m String
look String
"code") RqData (Maybe String)
-> RqData (Maybe String) -> RqData (Maybe String)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe String -> RqData (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
         Maybe String
vState <- (String -> Maybe String) -> RqData String -> RqData (Maybe String)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM String -> Maybe String
forall a. a -> Maybe a
Just (String -> RqData String
forall (m :: * -> *).
(Functor m, Monad m, HasRqData m) =>
String -> m String
look String
"state") RqData (Maybe String)
-> RqData (Maybe String) -> RqData (Maybe String)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe String -> RqData (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
         GithubCallbackPars -> RqData GithubCallbackPars
forall (m :: * -> *) a. Monad m => a -> m a
return GithubCallbackPars :: Maybe String -> Maybe String -> GithubCallbackPars
GithubCallbackPars {rCode :: Maybe String
rCode = Maybe String
vCode, rState :: Maybe String
rState = Maybe String
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 = Manager
-> AccessToken
-> URIRef Absolute
-> IO (Either ByteString GithubUser)
forall b.
FromJSON b =>
Manager
-> AccessToken -> URIRef Absolute -> IO (Either ByteString b)
authGetJSON Manager
mgr AccessToken
token (URIRef Absolute -> IO (Either ByteString GithubUser))
-> URIRef Absolute -> IO (Either ByteString 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 = Manager
-> AccessToken
-> URIRef Absolute
-> IO (Either ByteString [GithubUserMail])
forall b.
FromJSON b =>
Manager
-> AccessToken -> URIRef Absolute -> IO (Either ByteString b)
authGetJSON Manager
mgr AccessToken
token (URIRef Absolute -> IO (Either ByteString [GithubUserMail]))
-> URIRef Absolute -> IO (Either ByteString [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
  Manager
-> AccessToken
-> URIRef Absolute
-> IO (Either ByteString 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 :: Scheme
-> Maybe Authority
-> ByteString
-> Query
-> Maybe ByteString
-> URIRef Absolute
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 -> String -> String
[GithubUser] -> String -> String
GithubUser -> String
(Int -> GithubUser -> String -> String)
-> (GithubUser -> String)
-> ([GithubUser] -> String -> String)
-> Show GithubUser
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [GithubUser] -> String -> String
$cshowList :: [GithubUser] -> String -> String
show :: GithubUser -> String
$cshow :: GithubUser -> String
showsPrec :: Int -> GithubUser -> String -> String
$cshowsPrec :: Int -> GithubUser -> String -> String
Show, GithubUser -> GithubUser -> Bool
(GithubUser -> GithubUser -> Bool)
-> (GithubUser -> GithubUser -> Bool) -> Eq GithubUser
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GithubUser -> GithubUser -> Bool
$c/= :: GithubUser -> GithubUser -> Bool
== :: GithubUser -> GithubUser -> Bool
$c== :: 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 -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"login"
    parseJSON Value
_ = Parser GithubUser
forall (m :: * -> *) a. MonadPlus m => m a
mzero

data GithubUserMail = GithubUserMail { GithubUserMail -> Text
email :: Text
                                     , GithubUserMail -> Bool
primary :: Bool
                             } deriving (Int -> GithubUserMail -> String -> String
[GithubUserMail] -> String -> String
GithubUserMail -> String
(Int -> GithubUserMail -> String -> String)
-> (GithubUserMail -> String)
-> ([GithubUserMail] -> String -> String)
-> Show GithubUserMail
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [GithubUserMail] -> String -> String
$cshowList :: [GithubUserMail] -> String -> String
show :: GithubUserMail -> String
$cshow :: GithubUserMail -> String
showsPrec :: Int -> GithubUserMail -> String -> String
$cshowsPrec :: Int -> GithubUserMail -> String -> String
Show, GithubUserMail -> GithubUserMail -> Bool
(GithubUserMail -> GithubUserMail -> Bool)
-> (GithubUserMail -> GithubUserMail -> Bool) -> Eq GithubUserMail
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GithubUserMail -> GithubUserMail -> Bool
$c/= :: GithubUserMail -> GithubUserMail -> Bool
== :: GithubUserMail -> GithubUserMail -> Bool
$c== :: 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 -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"email"
                           Parser (Bool -> GithubUserMail)
-> Parser Bool -> Parser GithubUserMail
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"primary"
    parseJSON Value
_ = Parser GithubUserMail
forall (m :: * -> *) a. MonadPlus m => m a
mzero