NetworkCommon.hs

{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}

module Snap.AtlassianConnect.NetworkCommon 
    ( HttpResponseCode
    , ProductErrorResponse(..)
    , AccessTokenResponse(..)
    , AccessToken(..)
    , AccessTokenType(..)
    , responder
    ) where

import           Data.Aeson
import qualified Data.ByteString.Lazy                  as BL
import           Data.Maybe                            (fromMaybe)
import qualified Data.Text                             as T
import qualified Data.Text.Encoding                    as T
import           Data.Time.Units
import           GHC.Generics
import           Text.Read                             (readMaybe)

type HttpResponseCode = Int

-- | If you fail to properly communicate with the Host application then you will get a product error response back.
data ProductErrorResponse = ProductErrorResponse
   { perCode    :: HttpResponseCode -- ^ The HTTP error code.
   , perMessage :: T.Text           -- ^ The error message.
   } deriving (Show, Generic)

-- | This represents the response that an OAuth Access token request should expect to recieve from auth.atlassian.io.
data AccessTokenResponse = AccessTokenResponse
    { atrAccessToken :: AccessToken -- ^ The access token that can be used in subsequent HTTP requests.
    , atrExpiresIn :: Second -- ^ The duration until this access token expires and can no longer be used.
    , atrTokenType :: AccessTokenType -- ^ The type of token that was returned from auth.atlassian.io.
    }

instance FromJSON AccessTokenResponse where
    parseJSON = withObject "AccessTokenResponse" $ \v -> AccessTokenResponse 
        <$> (AccessToken <$> v .: "access_token")
        <*> (fromInteger <$> v .: "expires_in")
        <*> ((fromMaybe UnknownAccessTokenType . readMaybe) <$> v .: "token_type")

-- | An access token that can be used in subsequent requests.
data AccessToken = AccessToken T.Text

-- | The type of access token that was returned from the token generation service.
data AccessTokenType
    = Bearer -- ^ An OAuth 2 bearer token.
    | UnknownAccessTokenType -- ^ A token type that could not be parsed.
    deriving (Eq, Enum, Read)

responder :: FromJSON a => Int -> BL.ByteString -> Either ProductErrorResponse (Maybe a)
responder responseCode body
   | responseCode == 204 = Right Nothing
   | 200 <= responseCode && responseCode < 300 =
      case eitherDecode body of
         Right jsonResponse -> Right . Just $ jsonResponse
         Left err -> Left $ ProductErrorResponse responseCode (T.pack $ "Could not parse the json response: " ++ show err)
   | otherwise = Left $ ProductErrorResponse responseCode (T.decodeUtf8 . BL.toStrict $ body)