module Snap.AtlassianConnect.HostRequest (
hostRequest
, hostGetRequest
, hostPostRequest
, hostPostRequestExtended
, hostPutRequest
, hostPutRequestExtended
, StdMethod(..)
, AC.ProductErrorResponse(..)
, addHeader
, setPostParams
, setQueryParams
, setBody
, setBodyLazy
, setJson
) where
import Control.Applicative
import Control.Applicative
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 Data.List (isPrefixOf)
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.Client.TLS (tlsManagerSettings)
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.NetworkCommon as AC
import qualified Snap.AtlassianConnect.Tenant as AC
import qualified Snap.Snaplet as SS
import qualified Web.JWT as JWT
hostGetRequest :: FromJSON a => AC.Tenant -> Maybe AC.AccessToken -> B.ByteString -> [(B.ByteString, Maybe B.ByteString)] -> Endo Request -> SS.Handler b AC.Connect (Either AC.ProductErrorResponse a)
hostGetRequest = hostRequestWithContent GET
hostPostRequest :: FromJSON a => AC.Tenant -> Maybe AC.AccessToken -> B.ByteString -> [(B.ByteString, Maybe B.ByteString)] -> Endo Request -> SS.Handler b AC.Connect (Either AC.ProductErrorResponse a)
hostPostRequest = hostRequestWithContent POST
hostPostRequestExtended :: FromJSON a => AC.Tenant -> Maybe AC.AccessToken -> B.ByteString -> [(B.ByteString, Maybe B.ByteString)] -> Endo Request -> SS.Handler b AC.Connect (Either AC.ProductErrorResponse (Maybe a))
hostPostRequestExtended = hostRequest POST
hostPutRequest :: FromJSON a => AC.Tenant -> Maybe AC.AccessToken -> B.ByteString -> [(B.ByteString, Maybe B.ByteString)] -> Endo Request -> SS.Handler b AC.Connect (Either AC.ProductErrorResponse a)
hostPutRequest = hostRequestWithContent PUT
hostPutRequestExtended :: FromJSON a => AC.Tenant -> Maybe AC.AccessToken -> B.ByteString -> [(B.ByteString, Maybe B.ByteString)] -> Endo Request -> SS.Handler b AC.Connect (Either AC.ProductErrorResponse (Maybe a))
hostPutRequestExtended = hostRequest PUT
hostRequestWithContent :: FromJSON a => StdMethod -> AC.Tenant -> Maybe AC.AccessToken -> B.ByteString -> [(B.ByteString, Maybe B.ByteString)] -> Endo Request -> SS.Handler b AC.Connect (Either AC.ProductErrorResponse a)
hostRequestWithContent httpMethod tenant accessToken productRelativeUrl queryParams modifications = errorNoContent <$> hostRequest httpMethod tenant accessToken productRelativeUrl queryParams modifications
errorNoContent :: Either AC.ProductErrorResponse (Maybe a) -> Either AC.ProductErrorResponse a
errorNoContent (Left x) = Left x
errorNoContent (Right Nothing) = Left (AC.ProductErrorResponse 204 "We expected to get content back from this resource but instead we recieved no content.")
errorNoContent (Right (Just x)) = Right x
hostRequest :: FromJSON a => StdMethod -> AC.Tenant -> Maybe AC.AccessToken -> B.ByteString -> [(B.ByteString, Maybe B.ByteString)] -> Endo Request -> SS.Handler b AC.Connect (Either AC.ProductErrorResponse (Maybe a))
hostRequest standardHttpMethod tenant Nothing 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 $ AC.ProductErrorResponse 500 "Failed to generate a JWT token to make the request. The request was never made: server error."
(Just signature) -> MI.liftIO $ runRequest tlsManagerSettings standardHttpMethod url
( addHeader ("Accept", "application/json")
<> addHeader ("Authorization", jwtPrefix `B.append` T.encodeUtf8 signature)
<> requestModifications
)
(basicResponder AC.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
hostRequest standardHttpMethod tenant (Just (AC.AccessToken accessToken)) productRelativeUrl queryParams requestModifications = do
MI.liftIO $ putStrLn $ "Using bearer token: " ++ show accessToken
MI.liftIO $ runRequest tlsManagerSettings standardHttpMethod url
( addHeader ("Accept", "application/json")
<> addHeader ("Authorization", bearerPrefix `B.append` T.encodeUtf8 accessToken)
<> requestModifications
)
(basicResponder AC.responder)
where
bearerPrefix :: B.ByteString
bearerPrefix = BC.pack "Bearer "
url = T.decodeUtf8 $ BC.pack productBaseUrlString `B.append` productRelativeUrl `B.append` renderQuery True queryParams
productBaseUrlString = show . 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.numericDate fromTime
, JWT.exp = JWT.numericDate 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
setPostParams :: [(B.ByteString, B.ByteString)] -> Endo Request
setPostParams = setUrlEncodedBody