    {-# 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