atlassian-connect-core 0.4.0.0 → 0.5.0.0
raw patch · 3 files changed
+36/−39 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- atlassian-connect-core.cabal +1/−1
- src/Snap/AtlassianConnect/HostRequest.hs +4/−4
- src/Snap/AtlassianConnect/QueryStringHash.hs +31/−34
atlassian-connect-core.cabal view
@@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.4.0.0+version: 0.5.0.0 -- A short (one-line) description of the package. synopsis: Atlassian Connect snaplet for the Snap Framework and helper code.
src/Snap/AtlassianConnect/HostRequest.hs view
@@ -100,8 +100,8 @@ 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+ 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")@@ -118,9 +118,9 @@ 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+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)+ 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
src/Snap/AtlassianConnect/QueryStringHash.hs view
@@ -1,23 +1,24 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE CPP #-} module Snap.AtlassianConnect.QueryStringHash ( createQueryStringHash , module Network.HTTP.Types ) where -import qualified Data.Text as T-import qualified Data.Text.Encoding as TE-import qualified Data.ByteString.Char8 as B+import Control.Applicative+import Control.Monad (guard) import qualified Crypto.Hash as SHA-import Network.HTTP.Types-import Network.URI+import qualified Data.ByteString.Char8 as B import Data.Function-import Data.Ord+import Data.List+import Data.List.Split import Data.Maybe import Data.Monoid-import Data.List.Split-import Control.Applicative-import Data.List+import Data.Ord+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import Network.HTTP.Types+import Network.URI -- $setup@@ -37,8 +38,8 @@ -- :} -- Just "70282c7cf82834bd5a3d6dacda1b4ccd5cf5860a63a1fa2fb86b64d576e6a1d5" createQueryStringHash :: StdMethod -> URI -> T.Text -> Maybe T.Text-createQueryStringHash method baseUrl str =- (TE.decodeUtf8 . SHA.digestToHexByteString . hsh) <$> toCanonicalUrl method baseUrl str+createQueryStringHash method baseUrl fullUrl =+ (TE.decodeUtf8 . SHA.digestToHexByteString . hsh) <$> toCanonicalUrl method baseUrl fullUrl hsh :: T.Text -> SHA.Digest SHA.SHA256 hsh = SHA.hash . TE.encodeUtf8@@ -46,22 +47,25 @@ -- TODO we ask for the method just so that we can run show method on it...I think we should give it -- here in a different way and not mandate StdMethod. toCanonicalUrl :: StdMethod -> URI -> T.Text -> Maybe T.Text-toCanonicalUrl method baseUrl input = do- uri <- parseURI (T.unpack input)- let path' = stripContextPath baseUrl uri- let sqs = sortedQueryString uri+toCanonicalUrl method baseUrl' rawFullUrl = do+ fullUrl <- parseURI (T.unpack rawFullUrl)+ guard (comparing uriScheme baseUrl' fullUrl == EQ)+ guard (comparing uriAuthority baseUrl' fullUrl == EQ)+ path' <- uriPath <$> stripBaseUrl baseUrl' fullUrl+ let sqs = sortedQueryString fullUrl return . T.pack $ intercalate "&" [show method, path', sqs] sortedQueryString :: URI -> String sortedQueryString = toCanonicalQueryString . parseQueryText . B.pack . uriQuery -stripContextPath :: URI -> URI -> String-stripContextPath baseUrl' uri = sep <> intercalate sep (u \\ b)- where- sep = "/"- f = splitOn sep . uriPath- b = f baseUrl'- u = f uri+stripBaseUrl :: URI -> URI -> Maybe URI+stripBaseUrl baseUrl' fullUrl = do+ strippedPath <- stripPrefix (uriPath baseUrl') (uriPath fullUrl)+ return fullUrl+ { uriScheme = ""+ , uriAuthority = Nothing+ , uriPath = strippedPath+ } {- - See step 5 of Creating a Query Hash:@@ -86,12 +90,12 @@ ignoreJWTParam :: [(T.Text, a)] -> [(T.Text, a)] ignoreJWTParam = filter ((/= "jwt") . fst) -sortParamValues :: Ord b => [(a, b)] -> [(a, b)]-sortParamValues = sortBy (comparing snd)- sortParamKeys :: Ord a => [(a, b)] -> [(a, b)] sortParamKeys = sortBy (comparing fst) +sortParamValues :: Ord b => [(a, b)] -> [(a, b)]+sortParamValues = sortBy (comparing snd)+ groupAndSortQueryParams :: [QueryParam] -> [[QueryParam]] groupAndSortQueryParams = fmap sortParamValues . groupBy ((==) `on` fst) . sortParamKeys @@ -111,11 +115,4 @@ render = T.intercalate "&" . fmap queryParamToString encode :: T.Text -> T.Text-encode = T.foldl' encodeChars T.empty- where- encodeChars :: T.Text -> Char -> T.Text- encodeChars s c = case c of- ' ' -> s <> "%20"- '&' -> s <> "%26"- '*' -> s <> "%2A"- _ -> s `T.snoc` c+encode = TE.decodeUtf8 . urlEncode True . TE.encodeUtf8