    {-# 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 ((>=>))
    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