    {-# LANGUAGE DeriveGeneric              #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE OverloadedStrings          #-}
    {-# LANGUAGE TupleSections              #-}

    {-# OPTIONS_HADDOCK -ignore-exports #-}

    -- | A simple OAuth2 Haskell binding.  (This is supposed to be
    -- independent of the http client used.)

    module Network.OAuth.OAuth2.Internal where

    import           Prelude              hiding (error)
    import           Control.Arrow        (second)
    import           Control.Applicative
    import           Control.Monad.Catch
    import           Data.Aeson
    import           Data.Aeson.Types
    import qualified Data.ByteString      as BS
    import qualified Data.ByteString.Lazy as BSL
    import           Data.Maybe
    import           Data.Monoid
    import           Data.Text            (Text, pack)
    import           Data.Text.Encoding
    import           GHC.Generics
    import           URI.ByteString
    import           URI.ByteString.Aeson ()
    import           Lens.Micro
    import           Lens.Micro.Extras
    import           Network.HTTP.Conduit as C
    import qualified Network.HTTP.Types   as H

    --------------------------------------------------
    -- * Data Types
    --------------------------------------------------

    -- | Query Parameter Representation
    data OAuth2 = OAuth2 {
          oauthClientId            :: Text
        , oauthClientSecret        :: Text
        , oauthOAuthorizeEndpoint  :: URI
        , oauthAccessTokenEndpoint :: URI
        , oauthCallback            :: Maybe URI
        } deriving (Show, Eq)

    newtype AccessToken = AccessToken { atoken :: Text } deriving (Show, FromJSON, ToJSON)
    newtype RefreshToken = RefreshToken { rtoken :: Text } deriving (Show, FromJSON, ToJSON)
    newtype IdToken = IdToken { idtoken :: Text } deriving (Show, FromJSON, ToJSON)
    newtype ExchangeToken = ExchangeToken { extoken :: Text } deriving (Show, FromJSON, ToJSON)

    -- | The gained Access Token. Use @Data.Aeson.decode@ to
    -- decode string to @AccessToken@.  The @refreshToken@ is
    -- special in some cases,
    -- e.g. <https://developers.google.com/accounts/docs/OAuth2>
    data OAuth2Token = OAuth2Token {
          accessToken  :: AccessToken
        , refreshToken :: Maybe RefreshToken
        , expiresIn    :: Maybe Int
        , tokenType    :: Maybe Text
        , idToken      :: Maybe IdToken
        } deriving (Show, Generic)

    -- | Parse JSON data into 'OAuth2Token'
    instance FromJSON OAuth2Token where
        parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelTo2 '_' }
    instance ToJSON OAuth2Token where
        toEncoding = genericToEncoding defaultOptions { fieldLabelModifier = camelTo2 '_' }

    data OAuth2Error a =
      OAuth2Error
        { error :: Either Text a
        , errorDescription :: Maybe Text
        , errorUri :: Maybe (URIRef Absolute) }
      deriving (Show, Eq, Generic)

    instance FromJSON err => FromJSON (OAuth2Error err) where
      parseJSON (Object a) =
        do
          err <- (a .: "error") >>= (\str -> Right <$> parseJSON str <|> Left <$> parseJSON str)
          desc <- a .:? "error_description"
          uri <- a .:? "error_uri"
          return $ OAuth2Error err desc uri
      parseJSON _ = fail "Expected an object"

    instance ToJSON err => ToJSON (OAuth2Error err) where
      toEncoding = genericToEncoding defaultOptions { constructorTagModifier = camelTo2 '_', allNullaryToStringTag = True }

    parseOAuth2Error :: FromJSON err => BSL.ByteString -> OAuth2Error err
    parseOAuth2Error string =
      either (\err -> OAuth2Error (Left "Decode error") (Just $ pack $ "Error: " <> err <> "\n Original Response:\n" <> show (decodeUtf8 $ BSL.toStrict string)) Nothing) id (eitherDecode string)

    --------------------------------------------------
    -- * Types Synonym
    --------------------------------------------------

    -- | Is either 'Left' containing an error or 'Right' containg a result
    type OAuth2Result err a = Either (OAuth2Error err) a

    -- | type synonym of post body content
    type PostBody = [(BS.ByteString, BS.ByteString)]

    type QueryParams = [(BS.ByteString, BS.ByteString)]

    --------------------------------------------------
    -- * URLs
    --------------------------------------------------

    -- | Prepare the authorization URL.  Redirect to this URL
    -- asking for user interactive authentication.
    authorizationUrl :: OAuth2 -> URI
    authorizationUrl oa = over (queryL . queryPairsL) (++ queryParts) (oauthOAuthorizeEndpoint oa)
      where queryParts = catMaybes [ Just ("client_id", encodeUtf8 $ oauthClientId oa)
                                   , Just ("response_type", "code")
                                   , fmap (("redirect_uri",) . serializeURIRef') (oauthCallback oa) ]

    -- | Prepare the URL and the request body query for fetching an access token.
    accessTokenUrl :: OAuth2
                      -> ExchangeToken    -- ^ access code gained via authorization URL
                      -> (URI, PostBody)  -- ^ access token request URL plus the request body.
    accessTokenUrl oa code = accessTokenUrl' oa code (Just "authorization_code")

    -- | Prepare the URL and the request body query for fetching an access token, with
    -- optional grant type.
    accessTokenUrl' ::  OAuth2
                        -> ExchangeToken   -- ^ access code gained via authorization URL
                        -> Maybe Text      -- ^ Grant Type
                        -> (URI, PostBody) -- ^ access token request URL plus the request body.
    accessTokenUrl' oa code gt = (uri, body)
      where uri  = oauthAccessTokenEndpoint oa
            body = catMaybes [ Just ("code", encodeUtf8 $ extoken code)
                             , (("redirect_uri",) . serializeURIRef') <$> oauthCallback oa
                             , fmap (("grant_type",) . encodeUtf8) gt
                             ]

    -- | Using a Refresh Token.  Obtain a new access token by
    -- sending a refresh token to the Authorization server.
    refreshAccessTokenUrl :: OAuth2
                             -> RefreshToken     -- ^ refresh token gained via authorization URL
                             -> (URI, PostBody)  -- ^ refresh token request URL plus the request body.
    refreshAccessTokenUrl oa token = (uri, body)
      where uri = oauthAccessTokenEndpoint oa
            body = [ ("grant_type", "refresh_token")
                   , ("refresh_token", encodeUtf8 $ rtoken token)
                   ]

    -- | For `GET` method API.
    appendAccessToken :: URIRef a             -- ^ Base URI
                         -> AccessToken       -- ^ Authorized Access Token
                         -> URIRef a          -- ^ Combined Result
    appendAccessToken uri t = over (queryL . queryPairsL) (\query -> query ++ accessTokenToParam t) uri

    -- | Create 'QueryParams' with given access token value.
    accessTokenToParam :: AccessToken -> [(BS.ByteString, BS.ByteString)]
    accessTokenToParam t = [("access_token", encodeUtf8 $ atoken t)]

    appendQueryParams :: [(BS.ByteString, BS.ByteString)] -> URIRef a -> URIRef a
    appendQueryParams params =
      over (queryL . queryPairsL) (params ++ )

    uriToRequest :: MonadThrow m => URI -> m Request
    uriToRequest uri = do
      ssl <- case view (uriSchemeL . schemeBSL) uri of
        "http" -> return False
        "https" -> return True
        s -> throwM $ InvalidUrlException (show uri) ("Invalid scheme: " ++ show s)
      let
        query = fmap (second Just) (view (queryL . queryPairsL) uri)
        hostL = authorityL . _Just . authorityHostL . hostBSL
        portL = authorityL . _Just . authorityPortL . _Just . portNumberL
        defaultPort = (if ssl then 443 else 80) :: Int

        req = setQueryString query $ defaultRequest {
            secure = ssl,
            path = view pathL uri
          }
        req2 = (over hostLens . maybe id const . preview hostL) uri req
        req3 = (over portLens . maybe (const defaultPort) const . preview portL) uri req2
      return req3

    requestToUri :: Request -> URI
    requestToUri req =
      URI
        (Scheme (if secure req
               then "https"
               else "http"))
        (Just (Authority Nothing (Host $ host req) (Just $ Port $ port req)))
        (path req)
        (Query $ H.parseSimpleQuery $ queryString req)
        Nothing

    hostLens :: Lens' Request BS.ByteString
    hostLens f req = f (C.host req) <&> \h' -> req { C.host = h' }
    {-# INLINE hostLens #-}

    portLens :: Lens' Request Int
    portLens f req = f (C.port req) <&> \p' -> req { C.port = p' }
    {-# INLINE portLens #-}