    {-# LANGUAGE OverloadedStrings #-}

    {-# OPTIONS_HADDOCK -ignore-exports #-}

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

    module Network.OAuth.OAuth2.Internal where

    import           Control.Monad        (mzero)
    import           Data.Aeson
    import qualified Data.ByteString      as BS
    import qualified Data.ByteString.Lazy as BSL
    import           Data.Maybe
    import           Data.Text.Encoding
    import           Network.HTTP.Types   (renderSimpleQuery)

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

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

    -- | The gained Access Token. Use @Data.Aeson.decode@ to decode string to @AccessToken@.
    --   The @refresheToken@ is special at some case.
    --   e.g. https://developers.google.com/accounts/docs/OAuth2
    --
    data AccessToken = AccessToken {
          accessToken  :: BS.ByteString
        , refreshToken :: Maybe BS.ByteString
        , expiresIn    :: Maybe Int
        , tokenType    :: Maybe BS.ByteString
        } deriving (Show)

    -- | Parse JSON data into {AccessToken}
    --
    instance FromJSON AccessToken where
        parseJSON (Object o) = AccessToken <$> at <*> rt <*> ei <*> tt where
            at = fmap encodeUtf8 $ o .: "access_token"
            rt = fmap (fmap encodeUtf8) $ o .:? "refresh_token"
            ei = o .:? "expires_in"
            tt = fmap (fmap encodeUtf8) $ o .:? "token_type"
        parseJSON _ = mzero

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

    -- | Is either 'Left' containing an error or 'Right' containg a result
    --
    type OAuth2Result a = Either BSL.ByteString a

    -- | type synonym of query parameters
    type QueryParams = [(BS.ByteString, BS.ByteString)]

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

    -- | type synonym of a URI
    type URI = BS.ByteString

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

    -- | Prepare the authorization URL.
    --   Redirect to this URL asking for user interactive authentication.
    --
    authorizationUrl :: OAuth2 -> URI
    authorizationUrl oa = oauthOAuthorizeEndpoint oa `appendQueryParam` queryStr
      where queryStr = transform' [ ("client_id", Just $ oauthClientId oa)
                                  , ("response_type", Just "code")
                                  , ("redirect_uri", oauthCallback oa)]

    -- | Prepare URL and the request body query for fetching access token.
    --
    accessTokenUrl :: OAuth2
                      -> BS.ByteString       -- ^ 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")

    accessTokenUrl' ::  OAuth2
                        -> BS.ByteString          -- ^ access code gained via authorization URL
                        -> Maybe BS.ByteString    -- ^ Grant Type
                        -> (URI, PostBody)        -- ^ access token request URL plus the request body.
    accessTokenUrl' oa code gt = (uri, body)
      where uri  = oauthAccessTokenEndpoint oa
            body = transform' [ ("client_id", Just $ oauthClientId oa)
                              , ("client_secret", Just $ oauthClientSecret oa)
                              , ("code", Just code)
                              , ("redirect_uri", oauthCallback oa)
                              , ("grant_type", gt) ]

    -- | Using a Refresh Token.
    --   obtain a new access token by sending a refresh token to the Authorization server.
    --
    refreshAccessTokenUrl :: OAuth2
                             -> BS.ByteString    -- ^ refresh token gained via authorization URL
                             -> (URI, PostBody)  -- ^ refresh token request URL plus the request body.
    refreshAccessTokenUrl oa rtoken = (uri, body)
      where uri = oauthAccessTokenEndpoint oa
            body = transform' [ ("client_id", Just $ oauthClientId oa)
                              , ("client_secret", Just $ oauthClientSecret oa)
                              , ("grant_type", Just "refresh_token")
                              , ("refresh_token", Just rtoken) ]

    --------------------------------------------------
    -- * UTILs
    --------------------------------------------------

    -- | Append query parameters with '?'
    appendQueryParam :: URI -> QueryParams -> URI
    appendQueryParam uri q = if "?" `BS.isInfixOf` uri
                             then uri `BS.append` "&" `BS.append` renderSimpleQuery False q
                             else uri `BS.append` renderSimpleQuery True q

    -- | Append query parameters with '&'.
    -- appendQueryParam' :: URI -> QueryParams -> URI
    -- appendQueryParam' uri q = uri `BS.append` "&" `BS.append` renderSimpleQuery False q

    -- | For GET method API.
    appendAccessToken :: URI               -- ^ Base URI
                         -> AccessToken    -- ^ Authorized Access Token
                         -> URI            -- ^ Combined Result
    appendAccessToken uri t = appendQueryParam uri (accessTokenToParam t)

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

    -- | lift value in the Maybe and abonda Nothing
    transform' :: [(a, Maybe b)] -> [(a, b)]
    transform' = map (\(a, Just b) -> (a, b)) . filter (isJust . snd)