module Snap.AtlassianConnect.HostRequest (
hostRequest
, hostGetRequest
, hostPostRequest
, hostPutRequest
, StdMethod(..)
, ProductErrorResponse(..)
, addHeader
, setPostParams
, setQueryParams
, setBody
, setBodyLazy
, setJson
) where
import qualified Control.Monad.IO.Class as MI
import Control.Monad.State (get)
import Data.Aeson
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy as BL
import Data.Connect.Descriptor as CD
import qualified Data.Map as M
import Data.Monoid
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Time.Clock.POSIX as P
import Data.Time.Units (Minute)
import Data.TimeUnitUTC
import GHC.Generics
import Network.Api.Support
import Network.HTTP.Client
import Network.HTTP.Types
import Network.URI
import qualified Snap.AtlassianConnect.Data as AC
import qualified Snap.AtlassianConnect.Instances as AC
import qualified Snap.AtlassianConnect.QueryStringHash as QSH
import qualified Snap.AtlassianConnect.Tenant as AC
import qualified Snap.Snaplet as SS
import qualified Web.JWT as JWT
type HttpResponseCode = Int
data ProductErrorResponse = ProductErrorResponse
{ perCode :: HttpResponseCode
, perMessage :: T.Text
} deriving (Show, Generic)
hostGetRequest :: FromJSON a => AC.Tenant -> B.ByteString -> [(B.ByteString, Maybe B.ByteString)] -> Endo Request -> SS.Handler b AC.Connect (Either ProductErrorResponse a)
hostGetRequest = hostRequest GET
hostPostRequest :: FromJSON a => AC.Tenant -> B.ByteString -> [(B.ByteString, Maybe B.ByteString)] -> Endo Request -> SS.Handler b AC.Connect (Either ProductErrorResponse a)
hostPostRequest = hostRequest POST
hostPutRequest :: FromJSON a => AC.Tenant -> B.ByteString -> [(B.ByteString, Maybe B.ByteString)] -> Endo Request -> SS.Handler b AC.Connect (Either ProductErrorResponse a)
hostPutRequest = hostRequest PUT
hostRequest :: FromJSON a => StdMethod -> AC.Tenant -> B.ByteString -> [(B.ByteString, Maybe B.ByteString)] -> Endo Request -> SS.Handler b AC.Connect (Either ProductErrorResponse a)
hostRequest standardHttpMethod tenant productRelativeUrl queryParams requestModifications = do
currentTime <- MI.liftIO P.getPOSIXTime
pluginKey' <- fmap (CD.pluginKey . AC.connectPlugin) get
case generateJWTToken pluginKey' currentTime (AC.sharedSecret tenant) standardHttpMethod productBaseUrl url of
Nothing -> return . Left $ ProductErrorResponse 500 "Failed to generate a JWT token to make the request. The request was never made: server error."
(Just signature) -> MI.liftIO $ runRequest defaultManagerSettings standardHttpMethod url
( addHeader ("Accept","application/json")
<> addHeader ("Authorization", jwtPrefix `B.append` T.encodeUtf8 signature)
<> requestModifications
)
(basicResponder responder)
where
jwtPrefix :: B.ByteString
jwtPrefix = BC.pack "JWT "
url = T.decodeUtf8 $ BC.pack productBaseUrlString `B.append` productRelativeUrl `B.append` renderQuery True queryParams
productBaseUrlString = show productBaseUrl
productBaseUrl = AC.getURI . AC.baseUrl $ tenant
generateJWTToken :: CD.PluginKey -> P.POSIXTime -> T.Text -> StdMethod -> URI -> T.Text -> Maybe T.Text
generateJWTToken pluginKey' fromTime sharedSecret' method' ourURL requestURL = do
queryStringHash <- QSH.createQueryStringHash method' ourURL requestURL
return $ JWT.encodeSigned JWT.HS256 (JWT.secret sharedSecret') (createClaims pluginKey' fromTime queryStringHash)
createClaims :: CD.PluginKey -> P.POSIXTime -> T.Text -> JWT.JWTClaimsSet
createClaims (CD.PluginKey pluginKey) fromTime queryStringHash = JWT.JWTClaimsSet
{ JWT.iss = JWT.stringOrURI pluginKey
, JWT.iat = JWT.intDate fromTime
, JWT.exp = JWT.intDate expiryTime
, JWT.sub = Nothing
, JWT.aud = Nothing
, JWT.nbf = Nothing
, JWT.jti = Nothing
, JWT.unregisteredClaims = M.fromList [("qsh", String queryStringHash)]
}
where
expiryTime :: P.POSIXTime
expiryTime = fromTime + timeUnitToDiffTime expiryPeriod
expiryPeriod :: Minute
expiryPeriod = 1
responder :: FromJSON a => Int -> BL.ByteString -> Either ProductErrorResponse a
responder responseCode body
| 200 <= responseCode && responseCode < 300 =
case eitherDecode body of
Right jsonResponse -> Right 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)
setPostParams :: [(B.ByteString, B.ByteString)] -> Endo Request
setPostParams = setUrlEncodedBody