diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,202 @@ + + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright [yyyy] [name of copyright owner] + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,5 @@ +# Atlassian Connect Core (for Haskell) + +This is a library that provides Atlassian Connect functionality for applications built on top of the +Snap Framework. We provide a snaplet so that you can integrate Atlassian Connect into your +applications. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/atlassian-connect-core.cabal b/atlassian-connect-core.cabal new file mode 100644 --- /dev/null +++ b/atlassian-connect-core.cabal @@ -0,0 +1,128 @@ +-- Initial atlassian-connect-core.cabal generated by cabal init. For +-- further documentation, see http://haskell.org/cabal/users-guide/ + +-- The name of the package. +name: atlassian-connect-core + +-- The package version. See the Haskell package versioning policy (PVP) +-- for standards guiding when and how versions should be incremented. +-- http://www.haskell.org/haskellwiki/Package_versioning_policy +-- PVP summary: +-+------- breaking API changes +-- | | +----- non-breaking API additions +-- | | | +--- code changes with no API change +version: 0.1.0.0 + +-- A short (one-line) description of the package. +synopsis: Atlassian Connect snaplet for the Snap Framework and helper code. + +-- A longer description of the package. +description: This library allows you to quickly get an Atlassian Connect application running + on top of the Snap Framework. It provides best practices and helper functions to get you moving + quickly. Please read the rest of the documentation for more details. + +homepage: https://bitbucket.org/ajknoll/atlassian-connect-core + +-- The license under which the package is released. +license: Apache-2.0 + +-- The file containing the license text. +license-file: LICENSE + +-- The package author(s). +author: Robert Massaioli + +-- An email address to which users can send suggestions, bug reports, and +-- patches. +maintainer: rmassaioli@atlassian.com + +-- A copyright notice. +copyright: (c) 2014 Robert Massaioli, Avi Knoll, Eero Kaukonen + +category: Web, Snap + +build-type: Simple + +-- Extra files to be distributed with the package, such as examples or a +-- README. +extra-source-files: README.md + +data-files: resources/connect.cfg + +-- Constraint on the version of Cabal needed to build this package. +cabal-version: >=1.10 + +source-repository head + type: git + location: git@bitbucket.org:ajknoll/atlassian-connect-core.git + +flag network-uri + description: Get Network.URI from the network-uri package + default: True + +library + -- Modules exported by the library. + -- TODO need a better name for this + -- TODO do page tokens even belong here? Should they even be a separate library per service? + exposed-modules: Snap.AtlassianConnect + , Snap.AtlassianConnect.HostRequest + + -- Modules included in this library but not exported. + other-modules: Data.AesonHelpers + , Data.ConfigurationHelpers + , Data.EnvironmentHelpers + , Data.Padding + , Data.Padding.PKCS + , Data.Padding.Util + , Data.TimeUnitUTC + , Paths_atlassian_connect_core + , Snap.AtlassianConnect.Connect + , Snap.AtlassianConnect.AtlassianTypes + , Snap.AtlassianConnect.Data + , Snap.AtlassianConnect.Instances + , Snap.AtlassianConnect.LifecycleResponse + , Snap.AtlassianConnect.PageToken + , Snap.AtlassianConnect.QueryStringHash + , Snap.AtlassianConnect.Routes + , Snap.AtlassianConnect.Tenant + , Snap.AtlassianConnect.TimeUnits + , Snap.Helpers + + -- LANGUAGE extensions used by modules in this package. + -- other-extensions: + + -- Other library packages from which modules are imported. + build-depends: base >=4.7 && <4.8 + , atlassian-connect-descriptor >= 0.2 + , jwt >= 0.3 && < 0.5 + , aeson > 0.7.0.3 && < 0.9 + , bytestring >= 0.9 && <= 0.11 + , base64-bytestring == 1.0.* + , case-insensitive == 1.* + , cipher-aes == 0.2.* + , configurator == 0.2.* + , containers == 0.5.* + , hostname == 1.* + , http-media == 0.4.* + , mtl == 2.* + , snap >= 0.13.3 && < 0.14 + , snap-core >= 0.9 && < 0.10 + , split == 0.2.* + , text >= 0.11 && < 1.3 + , time >= 1.1 && < 1.5 + , time-units == 1.* + , transformers >= 0.3 && < 0.5 + , http-client == 0.3.* + , http-types == 0.8.* + , network-api-support == 0.1.* + , cryptohash == 0.11.* + + if flag(network-uri) + build-depends: network-uri >= 2.6, network >= 2.6 + else + build-depends: network-uri < 2.6, network < 2.6 + + -- Directories containing source files. + hs-source-dirs: src + + -- Base language which the package is written in. + default-language: Haskell2010 diff --git a/resources/connect.cfg b/resources/connect.cfg new file mode 100644 --- /dev/null +++ b/resources/connect.cfg @@ -0,0 +1,13 @@ +# Plugin Details +plugin_name = "My Atlassian Addon" +plugin_key = "com.myorgname.myaddonname" +base_url = "http://localhost:8080" + +# Secret Key - Currently only used for page tokens. Please keep secure. +# A good way to generate a secret key is to run the following in your terminal: +# $ dd if=/dev/urandom bs=1000 count=1 2> /dev/null | md5 +secret_key = "replaceme14daebcf59d7252692be9ab" + +# How long until the page token times out. You will have to choose a setting +# appropriate for your application. +page_token_timeout_seconds = 32400 # ==> 9 hours => 9 * 60 * 60 diff --git a/src/Data/AesonHelpers.hs b/src/Data/AesonHelpers.hs new file mode 100644 --- /dev/null +++ b/src/Data/AesonHelpers.hs @@ -0,0 +1,37 @@ +module Data.AesonHelpers + ( baseOptions + , stripFieldNamePrefix + , dropAndSnakeCase + ) where + +import Data.Aeson.Types +import qualified Data.Char as C +import qualified Data.List as L +import Data.Maybe (fromMaybe) + +baseOptions :: Options +baseOptions = defaultOptions + { omitNothingFields = True + } + +stripFieldNamePrefix :: String -> String -> String +stripFieldNamePrefix pre = lowerFirst . try (L.stripPrefix pre) + +dropAndSnakeCase :: String -> String -> String +dropAndSnakeCase toDrop = camelToSnakeCase . dropCondition toDrop . lowerFirst + +lowerFirst :: String -> String +lowerFirst (x : xs) = C.toLower x : xs +lowerFirst [] = [] + +camelToSnakeCase :: String -> String +camelToSnakeCase input = case L.break C.isUpper input of + (first, []) -> first + (first, x : xs) -> first ++ ('_' : C.toLower x : camelToSnakeCase xs) + +dropCondition :: String -> String -> String +dropCondition toDrop = L.reverse . try (L.stripPrefix . L.reverse $ toDrop) . L.reverse + +try :: (a -> Maybe a) -> a -> a +try f v = fromMaybe v (f v) + diff --git a/src/Data/ConfigurationHelpers.hs b/src/Data/ConfigurationHelpers.hs new file mode 100644 --- /dev/null +++ b/src/Data/ConfigurationHelpers.hs @@ -0,0 +1,13 @@ +module Data.ConfigurationHelpers + ( require + ) where + +import qualified Data.Configurator as DC +import qualified Data.Configurator.Types as DCT + +require :: DCT.Configured a => DCT.Config -> DCT.Name -> String -> IO a +require config name errorMessage = do + potentialValue <- DC.lookup config name + case potentialValue of + Nothing -> fail errorMessage + Just x -> return x diff --git a/src/Data/EnvironmentHelpers.hs b/src/Data/EnvironmentHelpers.hs new file mode 100644 --- /dev/null +++ b/src/Data/EnvironmentHelpers.hs @@ -0,0 +1,21 @@ +module Data.EnvironmentHelpers + ( getEnv + , getEnvWithDefault + , showMaybe + ) where + +import Data.List (find) +import Data.Maybe (fromMaybe) +import qualified System.Environment as E + +getEnv :: String -> IO (Maybe String) +getEnv key = do + env <- E.getEnvironment + return . fmap snd . find ((==) key . fst) $ env + +getEnvWithDefault :: String -> String -> IO String +getEnvWithDefault def = fmap (fromMaybe def) . getEnv + +showMaybe :: Show a => Maybe a -> String +showMaybe Nothing = "[Not Available]" +showMaybe (Just x) = show x diff --git a/src/Data/Padding.hs b/src/Data/Padding.hs new file mode 100644 --- /dev/null +++ b/src/Data/Padding.hs @@ -0,0 +1,20 @@ +module Data.Padding + ( zeroPad + , zeroUnpad + ) where + +import Data.Padding.Util (requiredPadding) + +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as BC +import Data.Char (chr) + +zeroPad :: Int -> B.ByteString -> B.ByteString +zeroPad boundary input = input `B.append` padding + where + padding = BC.replicate padLength (chr 0) + padLength = requiredPadding inputLength boundary + inputLength = B.length input + +zeroUnpad :: B.ByteString -> B.ByteString +zeroUnpad = fst . BC.spanEnd (== chr 0) diff --git a/src/Data/Padding/PKCS.hs b/src/Data/Padding/PKCS.hs new file mode 100644 --- /dev/null +++ b/src/Data/Padding/PKCS.hs @@ -0,0 +1,30 @@ +-- TODO Replace with with the Crypto package +module Data.Padding.PKCS where + +import Data.Padding.Util (requiredPadding) + +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as BC +import Data.Char (chr) +import Data.Word (Word8) + +pkcs7Pad :: Word8 -> B.ByteString -> B.ByteString +pkcs7Pad blockBoundary input = input `B.append` padding + where + padding = BC.replicate paddingLength padCharacter + padCharacter = chr . fromIntegral $ paddingLength + paddingLength = requiredPadding inputLength (fromIntegral blockBoundary) + inputLength = B.length input + +pkcs7Unpad :: Word8 -> B.ByteString -> Maybe B.ByteString +pkcs7Unpad blockBoundary input = if validLength + then Just (if lastChar >= blockBoundary then input else removedPadding) + else Nothing + where + removedPadding = if B.length padding == fromIntegral lastChar + then potentialGoodData + else input + (potentialGoodData, padding) = B.spanEnd (== lastChar) input + inputLength = B.length input + lastChar = B.last input + validLength = inputLength `mod` fromIntegral blockBoundary == 0 diff --git a/src/Data/Padding/Util.hs b/src/Data/Padding/Util.hs new file mode 100644 --- /dev/null +++ b/src/Data/Padding/Util.hs @@ -0,0 +1,10 @@ +module Data.Padding.Util + ( requiredPadding + ) where + +requiredPadding :: Int -> Int -> Int +requiredPadding length' boundary = + case length' `mod` boundary of + 0 -> 0 + x -> boundary - x + diff --git a/src/Data/TimeUnitUTC.hs b/src/Data/TimeUnitUTC.hs new file mode 100644 --- /dev/null +++ b/src/Data/TimeUnitUTC.hs @@ -0,0 +1,16 @@ +module Data.TimeUnitUTC + ( timeUnitToDiffTime + , diffTimeToTimeUnit + ) where + +import Data.Time.Units +import Data.Time.Clock + +timeUnitToDiffTime :: TimeUnit a => a -> NominalDiffTime +timeUnitToDiffTime t = fromInteger $ toMicroseconds t `div` microsecondsPerSecond + +diffTimeToTimeUnit :: NominalDiffTime -> Second +diffTimeToTimeUnit t = fromMicroseconds . floor $ t * fromInteger microsecondsPerSecond + +microsecondsPerSecond :: Num a => a +microsecondsPerSecond = 10 ^ (6 :: Integer) diff --git a/src/Snap/AtlassianConnect.hs b/src/Snap/AtlassianConnect.hs new file mode 100644 --- /dev/null +++ b/src/Snap/AtlassianConnect.hs @@ -0,0 +1,78 @@ +{-| +Module : Snap.AtlassianConnect +Description : Defines a snaplet for the Atlassian Connect framework. +Copyright : (c) Robert Massioli, 2014 +License : APACHE-2 +Maintainer : rmassaioli@atlassian.com +Stability : experimental + +This module provides an Snap Framework Snaplet for the Atlassian Connect framework. In order to use it in your +snap application you just need to run initConnectSnaplet in your initialiser like so: + +> appConnect <- nestSnaplet "connect" connect (initConnectSnaplet myPluginDescriptor) + +All you need to provide us with is a descriptor that you have generated using the +. + +It is important to note that certain configuration values can be overriden with Environment Variables because they may +be specific to the environment that you deployed the service to: + +* Use CONNECT_BASE_URL to override the Base Url in the Addon Descriptor. +* Use CONNECT_SECRET_KEY to override the Page Token Secret Key. + +To test that it has worked you can start your application and find your descriptor at: \/connect\/atlassian-connect.json + +We will also automatically create a connect.cfg file for you in the snaplets/connect directory. If this does not happen +then delete the snaplets/connect directory and restart your application. Please have a look inside the connect.cfg directory +as there will be plugin specific setting that you will have to override. It is likely that you will want to override all +of those configuration options. +-} +module Snap.AtlassianConnect ( + -- * Connect Snaplet + initConnectSnaplet + , Connect(..) + , HasConnect(..) + , HostName + -- * Atlassian Standard Types + , UserKey + , UserEmail + , IssueKey + , IssueId + , ProjectKey + , ProjectId + , IssueSummary + , UserDetails(..) + , IssueDetails(..) + -- * Lifecycle and Tenant + , getLifecycleResponse + , LifecycleResponse(..) + , ClientKey + , Tenant(..) + , TenantKey + , TenantWithUser + -- * Page Tokens + , PageToken(..) -- TODO make it so that you can query the token but nothing else + , generateToken + , generateTokenCurrentTime + , encryptPageToken + , decryptPageToken + , defaultTimeoutSeconds + -- * Routes Helpers + , homeHandler + -- * Connect Data Types + , ConnectURI(..) + , getURI + , ConnectSecond(..) + , getSecond + ) where + +import Snap.AtlassianConnect.AtlassianTypes +import Snap.AtlassianConnect.Connect +import Snap.AtlassianConnect.Data +import Snap.AtlassianConnect.Instances +import Snap.AtlassianConnect.LifecycleResponse +import Snap.AtlassianConnect.PageToken +import Snap.AtlassianConnect.Routes +import Snap.AtlassianConnect.Tenant +import Snap.AtlassianConnect.TimeUnits + diff --git a/src/Snap/AtlassianConnect/AtlassianTypes.hs b/src/Snap/AtlassianConnect/AtlassianTypes.hs new file mode 100644 --- /dev/null +++ b/src/Snap/AtlassianConnect/AtlassianTypes.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Snap.AtlassianConnect.AtlassianTypes + ( UserKey + , UserEmail + , IssueKey + , IssueId + , ProjectId + , ProjectKey + , IssueSummary + , UserDetails(..) + , IssueDetails(..) + ) where + +import qualified Data.ByteString as B +import qualified Data.Text as T +import GHC.Generics + +-- | Represents an Atlassian User Key. This is guaranteed to be unique on any given tenant. +type UserKey = T.Text + +-- | Represents an Atlassian User Email. This has no uniqueness guarantees; an email does not map to a unique user. +type UserEmail = B.ByteString -- TODO use a standard email type + +-- | The Key of an Atlassian JIRA issue. They are usually in the format -. Please note +-- that issues can be moved between projects so this is not guaranteed to remain constant. +type IssueKey = T.Text + +-- | The ID of an Atlassian JIRA issue. This id will never change and will always refer to the same issue. It +-- is an immutable reference to a JIRA issue. +type IssueId = Integer + +-- | The user visible key of an Atlassian JIRA Project. Project Keys are not guaranteed to remain the same forever. +type ProjectKey = T.Text + +-- | The project id of an Atlassian JIRA Project. The same project will always have the same project id. The project +-- id is immutable for a given project. +type ProjectId = Integer + +-- | Represents an Atlassian JIRA Issue summary. +type IssueSummary = T.Text + +-- | Represents the user details of an Atlassian JIRA user. +data UserDetails = UserDetails + { userKey :: UserKey + , userEmail :: UserEmail + } deriving (Show, Generic) + +-- | Represents simple issue details that every Atlassian JIRA issue will have. +data IssueDetails = IssueDetails + { issueKey :: IssueKey + , issueId :: IssueId + , issueSummary :: IssueSummary + } deriving (Show, Generic) diff --git a/src/Snap/AtlassianConnect/Connect.hs b/src/Snap/AtlassianConnect/Connect.hs new file mode 100644 --- /dev/null +++ b/src/Snap/AtlassianConnect/Connect.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Snap.AtlassianConnect.Connect + ( initConnectSnaplet + ) where + +-- Data file imports +import qualified Paths_atlassian_connect_core as PACC + +-- Helper Imports +import Data.ConfigurationHelpers + +-- Atlassian Connect Imports +import qualified Data.Connect.Descriptor as D +import Snap.AtlassianConnect.Data +import qualified Snap.AtlassianConnect.PageToken as PT +import qualified Snap.AtlassianConnect.Routes as CR +import qualified Snap.AtlassianConnect.TimeUnits as TU + +-- Standard imports +import qualified Control.Monad as CM +import qualified Control.Monad.IO.Class as MI +import qualified Crypto.Cipher.AES as CCA +import qualified Data.ByteString.Char8 as BSC +import qualified Data.Configurator as DC +import qualified Data.Configurator.Types as DCT +import qualified Data.EnvironmentHelpers as DE +import Data.Maybe (fromMaybe) +import Data.Text +import Data.Time.Units +import qualified Network.HostName as HN +import qualified Network.URI as NU +import qualified Snap.Snaplet as SS + +-- | Initialise the Atlassian Connect part of this application. This gives you an Atlassian Connect configuration that +-- comes with: +-- +-- * An Atlassian Connect configuration file. +-- * The definition of what it means to be an Atlassian Connect Tenant. +-- * Default routes for your Atlassian Connect Descriptor. (With automatic configuration injection of Plugin Keys / Names) +-- * Page Token support +-- * Host Whitelist Support +-- +-- In short, it is the easy way to get up and running with Atlassian Connect in your Snap applications. +initConnectSnaplet :: D.Plugin -> SS.SnapletInit b Connect +initConnectSnaplet plugin = SS.makeSnaplet "connect" "Atlassian Connect" (Just dataDir) $ do + SS.addRoutes CR.connectRoutes + configurationDirectory <- SS.getSnapletFilePath + MI.liftIO . fmap (toConnect plugin) $ SS.loadAppConfig "connect.cfg" configurationDirectory >>= loadConnectConfig + +dataDir :: IO FilePath +dataDir = CM.liftM (++"/resources") PACC.getDataDir + +data ConnectConfig = ConnectConfig + { ccSecretKey :: BSC.ByteString + , ccPluginName :: Text + , ccPluginKey :: Text + , ccBaseUrl :: NU.URI + , ccPageTokenTimeout :: TU.ConnectSecond + , ccHostWhiteList :: [Text] -- TODO This host whitelist should be loaded from configuration + } + +toConnect :: D.Plugin -> ConnectConfig -> Connect +toConnect plugin conf = Connect + { connectPlugin = plugin + , connectAES = CCA.initAES $ ccSecretKey conf + , connectPluginName = D.Name $ ccPluginName conf + , connectPluginKey = D.PluginKey $ ccPluginKey conf + , connectBaseUrl = ccBaseUrl conf + , connectPageTokenTimeout = D.Timeout . TU.getSecond . ccPageTokenTimeout $ conf + , connectHostWhitelist = ccHostWhiteList conf + } + +loadConnectConfig :: DCT.Config -> IO ConnectConfig +loadConnectConfig connectConf = do + name <- require connectConf "plugin_name" "Missing plugin name in connect configuration file." + key <- require connectConf "plugin_key" "Missing plugin key in connect configuration file." + rawBaseUrl <- require connectConf "base_url" "Missing base url in connect configuration file." + secret <- require connectConf "secret_key" "Missing secret key in connect configuration file." + hostWhiteList <- validHosts + let keyLength = BSC.length secret + CM.when (keyLength /= 32) $ fail ("Expected Atlassian Connect secret_key to be 32 Hex Digits long but was actually: " ++ show keyLength) + envBaseUrl <- DE.getEnv "CONNECT_BASE_URL" + envSecretKey <- DE.getEnv "CONNECT_SECRET_KEY" + let baseUrlToParse = fromMaybe rawBaseUrl envBaseUrl + case NU.parseURI baseUrlToParse of + Nothing -> fail("Could not parse the baseUrl in the configuration file: " ++ rawBaseUrl) + Just baseUrl -> do + pageTokenTimeoutInSeconds <- DC.lookupDefault PT.defaultTimeoutSeconds connectConf "page_token_timeout_seconds" + return ConnectConfig + { ccPluginName = name + , ccPluginKey = key + , ccBaseUrl = baseUrl + , ccSecretKey = maybe secret BSC.pack envSecretKey + , ccPageTokenTimeout = pageTokenTimeoutInSeconds + , ccHostWhiteList = hostWhiteList + } + +validHosts :: IO[Text] +validHosts = fmap hosts HN.getHostName + where hosts localhost = fmap pack (localhost : ["localhost", "jira-dev.com", "jira.com", "atlassian.net"]) diff --git a/src/Snap/AtlassianConnect/Data.hs b/src/Snap/AtlassianConnect/Data.hs new file mode 100644 --- /dev/null +++ b/src/Snap/AtlassianConnect/Data.hs @@ -0,0 +1,39 @@ +module Snap.AtlassianConnect.Data + ( Connect(..) + , HasConnect(..) + , HostName + , DynamicDescriptorConfig(..) + ) where + +-- Connect Modules +import Data.Connect.Descriptor + +-- Standard Modules +import qualified Crypto.Cipher.AES as CCA +import qualified Data.Text as T +import qualified Network.URI as NU + +-- | The Atlassian Connect Snaplet Context +data Connect = Connect + { connectAES :: CCA.AES -- ^ The AES key that will be used for Page Token support. + , connectPageTokenTimeout :: Timeout -- ^ The Page Token Timeout (how long the token is valid for). + , connectPlugin :: Plugin -- ^ The Atlassian Connect Descriptor for your Add-on. + , connectPluginName :: Name Connect -- ^ The Name of your Atlassian Connect Add-on loaded from configuration. + , connectPluginKey :: PluginKey -- ^ The Key of your Atlassian Connect Add-on loaded from configuration. + , connectBaseUrl :: NU.URI -- ^ The URL that your Add-on will report as it's base URL. Especially useful if you are behind a load balancer. + , connectHostWhitelist :: [HostName] -- ^ The suffixes in the hostname that should be allowed to be installed as Connect Add-ons. + } + +-- | Represents a URL hostname +type HostName = T.Text + +-- | If a Snap application provides Atlassian Connect then it can impliment HasConnect to allow connect methods to be +-- called easily. +class HasConnect m where + getConnect :: m Connect + +data DynamicDescriptorConfig = DynamicDescriptorConfig + { dcPluginName :: Name Plugin + , dcPluginKey :: PluginKey + , dcBaseUrl :: NU.URI + } diff --git a/src/Snap/AtlassianConnect/HostRequest.hs b/src/Snap/AtlassianConnect/HostRequest.hs new file mode 100644 --- /dev/null +++ b/src/Snap/AtlassianConnect/HostRequest.hs @@ -0,0 +1,152 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} + +{-| +Module : Snap.AtlassianConnect.HostRequest +Description : Allows you to easily make requests from your Atlassian Connect addon to the Host Application (like Jira or Confluence). +Copyright : (c) Robert Massioli, 2014 +License : APACHE-2 +Maintainer : rmassaioli@atlassian.com +Stability : experimental + +While writing Atlassian Connect applications you will often be in a situation where you want to query the Host Application +directly in a trusted way. This may be because: + +* You are not making this request on behalf of a user. You are making it on behalf of your Addon. (Data ingestion etc.) +* You cannot trust the information that the Customer has given you. For example: don't trust the customer to tell you if they are an admin or not. Go directly to the Host application for that. + +This module allows you to make HTTP requests to the host application and expect JSON responses. There are convinience +methods for GET, POST and PUT requests which make up the majority of the requests that you are going to make. + +It is important to note that these requests are still restricted by the + that you have asked for in your +Atlassian Connect Descriptor. + +For an example of usage: look at the httpGetRequest function. +-} +module Snap.AtlassianConnect.HostRequest ( + -- * Host (Product) Request Helpers + hostRequest + , hostGetRequest + , hostPostRequest + , hostPutRequest + , StdMethod(..) + , ProductErrorResponse(..) + -- * Request Modifiers + , addHeader + , setPostParams + , 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 + +-- | 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 is a convinience method that calls 'hostRequest' as a GET method. +-- +-- Here is an example of it being used to make a call for user details: +-- +-- > jiraUserDetailsResponse <- hostGetRequest myConnectTenant "/rest/api/2/user" [("username", Just "admin")] mempty +-- +-- This example assumes that you are using the OverloadedStrings LANGUAGE pragma and that you don't need to modify the request. +-- You might want to might want to modify the request for multiple reasons. Too add proxy details for example. +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 + +-- | This is a convinience method that calls 'hostRequest' as a POST method. +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 + +-- | This is a convinience method that calls 'hostRequest' as a PUT method. +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 + +-- | As an Atlassian Connect application you will want to make requests of the Host Applicaiton (JIRA / Confluence) +-- so that you can get important information. This function lets you do so by doing most of the heavy lifting of +-- having to create a JWT token and a Query String Hash. It also asserts that you intended to get a JSON response. +-- You should use this method or the helper methods whenever you want to make requests of the host application. +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 AC.connectPluginKey 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)] -- TODO fromJust is horrible. Remove it's use. + } + where + expiryTime :: P.POSIXTime + expiryTime = fromTime + timeUnitToDiffTime expiryPeriod + + -- Our default expiry period when talking to the host product directly + expiryPeriod :: Minute + expiryPeriod = 1 + +responder :: FromJSON a => Int -> BL.ByteString -> Either ProductErrorResponse a +responder 200 body = case eitherDecode body of + Right jsonResponse -> Right jsonResponse + Left err -> Left $ ProductErrorResponse 200 (T.pack $ "Could not parse the json response: " ++ show err) +responder responseCode body = Left $ ProductErrorResponse responseCode (T.decodeUtf8 . BL.toStrict $ body) + +-- Wrapping this method for now. See: http://goo.gl/AZtRHZ +setPostParams :: [(B.ByteString, B.ByteString)] -> Endo Request +setPostParams = setParams diff --git a/src/Snap/AtlassianConnect/Instances.hs b/src/Snap/AtlassianConnect/Instances.hs new file mode 100644 --- /dev/null +++ b/src/Snap/AtlassianConnect/Instances.hs @@ -0,0 +1,21 @@ +module Snap.AtlassianConnect.Instances + ( ConnectURI(..) + , getURI + ) where + +import Control.Monad +import Data.Aeson.Types +import qualified Data.Text as T +import Network.URI + +-- | An Atlassian Connect URI +newtype ConnectURI = CURI URI + deriving(Eq, Show) + +-- | Get a regular URI from an Atlassian Connect URI +getURI :: ConnectURI -> URI +getURI (CURI u) = u + +instance FromJSON ConnectURI where + parseJSON (String uriString) = maybe mzero return (fmap CURI . parseURI . T.unpack $ uriString) + parseJSON _ = mzero diff --git a/src/Snap/AtlassianConnect/LifecycleResponse.hs b/src/Snap/AtlassianConnect/LifecycleResponse.hs new file mode 100644 --- /dev/null +++ b/src/Snap/AtlassianConnect/LifecycleResponse.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE DeriveGeneric #-} +module Snap.AtlassianConnect.LifecycleResponse + ( LifecycleResponse(..) + , ClientKey + , getLifecycleResponse + ) where + +import Control.Applicative ((<$>)) +import qualified Data.Aeson as A +import Data.Aeson.Types +import Data.AesonHelpers +import qualified Data.Text as T +import GHC.Generics +import Snap.AtlassianConnect.Instances +import qualified Snap.Core as SC +import qualified Snap.Snaplet as SS + +-- | Represents the 'client key' from the Atlassian Connect framework in the host product. +type ClientKey = T.Text + +-- | When an Atlassian Connect plugin is installed or uninstalled this is the lifecycle response that your add-on +-- will be sent (in JSON). Use this data structure to handle lifecycle event data from the host application. +data LifecycleResponse = LifecycleResponseInstalled + { lrKey :: T.Text + , lrClientKey :: ClientKey + , lrPublicKey :: T.Text + , lrSharedSecret :: Maybe T.Text + , lrServerVersion :: Maybe T.Text + , lrPluginsVersion :: Maybe T.Text + , lrBaseUrl :: ConnectURI + , lrProductType :: Maybe T.Text + , lrDescription :: Maybe T.Text + , lrEventType :: Maybe T.Text + } deriving (Eq, Show, Generic) + +instance FromJSON LifecycleResponse where + parseJSON = genericParseJSON baseOptions + { fieldLabelModifier = stripFieldNamePrefix "lr" + } + +-- | A convenience method to get a Lifecycle Response from the response body. +getLifecycleResponse :: SS.Handler b a (Maybe LifecycleResponse) +getLifecycleResponse = A.decode <$> SC.readRequestBody (1024 * 10) diff --git a/src/Snap/AtlassianConnect/PageToken.hs b/src/Snap/AtlassianConnect/PageToken.hs new file mode 100644 --- /dev/null +++ b/src/Snap/AtlassianConnect/PageToken.hs @@ -0,0 +1,100 @@ +{-# LANGUAGE OverloadedStrings #-} +module Snap.AtlassianConnect.PageToken + ( PageToken(..) -- TODO make it so that you can query the token but nothing else + , generateToken + , generateTokenCurrentTime + , encryptPageToken + , decryptPageToken + , defaultTimeoutSeconds + ) where + +import qualified Control.Applicative as CA +import qualified Crypto.Cipher.AES as CCA +import Data.Aeson +import Data.Aeson.Types +import qualified Data.ByteString as DB +import qualified Data.ByteString.Base64 as B64 +import qualified Data.ByteString.Lazy as DBL +import qualified Data.Padding as DP +import qualified Data.Text as DT +import Data.Time.Clock +import Data.Time.Units + +import qualified Snap.AtlassianConnect.AtlassianTypes as CA +import qualified Snap.AtlassianConnect.Tenant as CT +import qualified Snap.AtlassianConnect.TimeUnits as TU + +-- | The default timeout for a Page Token. It is likely that you will want to make this longer. +defaultTimeoutSeconds :: TU.ConnectSecond +defaultTimeoutSeconds = TU.CSecond $ 5 * 60 + +-- | Page Tokens are your way of providing a token to the client's browser and have them make trusted requests +-- back to the Atlassian Connect application without having to go through the host product. +data PageToken = PageToken + { pageTokenHost :: CT.TenantKey -- ^ The Atlassian Cloud tenant that this token was generated for. + , pageTokenUser :: Maybe CA.UserKey -- ^ The potential user that this token was generated for. + , pageTokenTimestamp :: UTCTime -- ^ The time at which this token was generated. + , pageTokenAllowInsecurePolling :: Bool -- ^ (Deprecated) This is currently unsupported. Don't use it. + } deriving (Eq, Show) + +instance ToJSON PageToken where + toJSON (PageToken host potentialUser timestamp insecurePolling) = object $ + [ "h" .= host + , "t" .= timestamp + ] + ++ user potentialUser + ++ polling insecurePolling + where + user :: Maybe CA.UserKey -> [Pair] + user (Just userKey) = [ "u" .= userKey ] + user Nothing = [] + + polling :: Bool -> [Pair] + polling True = [ "p" .= DT.pack "1" ] -- Unfortunately we need to write out a true + polling False = [] + +instance FromJSON PageToken where + parseJSON (Object tokenData) = PageToken + CA.<$> tokenData .: "h" + CA.<*> tokenData .:? "u" + CA.<*> tokenData .: "t" + CA.<*> tokenData .:? "p" .!= False + parseJSON _ = fail "The PageToken should contain a JSON object." + +-- | Given a tentant, a potential user and a time generate a page token. +generateToken :: CT.TenantWithUser -> UTCTime -> PageToken +generateToken (tenant, userKey) timestamp = PageToken + { pageTokenHost = CT.key tenant + , pageTokenUser = userKey + , pageTokenTimestamp = timestamp + , pageTokenAllowInsecurePolling = False + } + +-- | Given a tenant and a potential user generate a token for the current time. +generateTokenCurrentTime :: CT.TenantWithUser -> IO PageToken +generateTokenCurrentTime ct = fmap (generateToken ct) getCurrentTime + +-- In order to write the token out: +-- 1. Generate the token. +-- 1. Write the token out to json in the supported format. +-- 1. Base64 encode the json. +-- 1. AES ECB encrypt the string + +-- | Given an AES context encrypt a page token into a bytestring. +encryptPageToken :: CCA.AES -> PageToken -> DB.ByteString +encryptPageToken aes pageToken = encryptedEncodedToken + where + tokenAsJson = encode pageToken + tokenAsBase64 = B64.encode . DBL.toStrict $ tokenAsJson + paddedBase64 = DP.zeroPad 16 tokenAsBase64 + encryptedToken = CCA.encryptECB aes paddedBase64 + encryptedEncodedToken = B64.encode encryptedToken + +-- | Given an AES context decrypt a page token. +decryptPageToken :: CCA.AES -> DB.ByteString -> Either String PageToken +decryptPageToken aes input = do + undecodedEncryptedToken <- B64.decode input + let decryptedToken = CCA.decryptECB aes undecodedEncryptedToken + (B64.decode . DP.zeroUnpad $ decryptedToken) >>= eitherDecode . DBL.fromStrict + +-- TODO we should write unit tests to ensure that every combination of this encrypt and decrypt can be translated correctly. diff --git a/src/Snap/AtlassianConnect/QueryStringHash.hs b/src/Snap/AtlassianConnect/QueryStringHash.hs new file mode 100644 --- /dev/null +++ b/src/Snap/AtlassianConnect/QueryStringHash.hs @@ -0,0 +1,121 @@ +{-# 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 qualified Crypto.Hash as SHA +import Network.HTTP.Types +import Network.URI +import Data.Function +import Data.Ord +import Data.Maybe +import Data.Monoid +import Data.List.Split +import Control.Applicative +import Data.List + + +-- $setup +-- >>> import Data.Maybe +-- >>> import Data.Text + +-- | Create a query string hash (required for the JWT claim set for an +-- Atlassian connect application) based on the HTTP method, the base URL +-- and the url to be used. This function will canonicalize the given URL +-- based on the rules outlined on +-- +-- >>> :{ +-- let +-- baseUrl = fromMaybe nullURI $ parseURI "http://localhost:2990" +-- input = "http://localhost:2990/path/to/service?a=1&A=2&b=3&B=4" :: Text +-- in createQueryStringHash GET baseUrl input +-- :} +-- Just "70282c7cf82834bd5a3d6dacda1b4ccd5cf5860a63a1fa2fb86b64d576e6a1d5" +createQueryStringHash :: StdMethod -> URI -> T.Text -> Maybe T.Text +createQueryStringHash method baseUrl str = + (TE.decodeUtf8 . SHA.digestToHexByteString . hsh) <$> toCanonicalUrl method baseUrl str + +hsh :: T.Text -> SHA.Digest SHA.SHA256 +hsh = SHA.hash . TE.encodeUtf8 + +-- 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 + 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 + +{- + - See step 5 of Creating a Query Hash: + - https://developer.atlassian.com/static/connect/docs/concepts/understanding-jwt.html +* Sort the query parameters primarily by their percent-encoded names and secondarily by their percent-encoded values +* Sorting is by codepoint: sort(["a", "A", "b", "B"]) => ["A", "B", "a", "b"] +* For each parameter append its percent-encoded name, the '=' character and then its percent-encoded value. +* In the case of repeated parameters append the ',' character and subsequent percent-encoded values. +* Ignore the jwt parameter, if present. +* Some particular values to be aware of: + "+" is encoded as "%20", + "*" as "%2A" and + "~" as "~". + (These values used for consistency with OAuth1.) + This method needs to be functionally equivalent to: com.atlassian.jwt.core.HttpRequestCanonicalizer#canonicalizeQueryParameters from atlassian-jwt +-} +toCanonicalQueryString :: QueryText -> String +toCanonicalQueryString = T.unpack . render . joinQueryParams . groupAndSortQueryParams . ignoreJWTParam + +type QueryParam = (T.Text, Maybe T.Text) + +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) + +groupAndSortQueryParams :: [QueryParam] -> [[QueryParam]] +groupAndSortQueryParams = fmap sortParamValues . groupBy ((==) `on` fst) . sortParamKeys + +joinQueryParams :: [[QueryParam]] -> [(T.Text, T.Text)] +joinQueryParams = catMaybes . fmap joinQueryParam + +joinQueryParam :: [QueryParam] -> Maybe (T.Text, T.Text) +joinQueryParam [] = Nothing +joinQueryParam xs@(x : _) = return (fst x, T.intercalate sep . catMaybes . fmap snd $ xs) + where + sep = T.singleton ',' + +queryParamToString :: (T.Text, T.Text) -> T.Text +queryParamToString (key, value) = encode key <> T.singleton '=' <> encode value + +render :: [(T.Text, T.Text)] -> T.Text +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 diff --git a/src/Snap/AtlassianConnect/Routes.hs b/src/Snap/AtlassianConnect/Routes.hs new file mode 100644 --- /dev/null +++ b/src/Snap/AtlassianConnect/Routes.hs @@ -0,0 +1,99 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +module Snap.AtlassianConnect.Routes + ( connectRoutes + , homeHandler + ) where + +import Control.Applicative +import qualified Control.Arrow as ARO +import Control.Monad (mzero) +import Control.Monad.State.Class (get) +import qualified Data.Aeson as A +import qualified Data.ByteString.Char8 as BC +import qualified Data.CaseInsensitive as CI +import Data.Connect.Descriptor as D +import Data.List +import Data.List.Split (splitOn) +import qualified Data.Map.Lazy as ML +import Data.Maybe (catMaybes, fromMaybe) +import qualified Network.HTTP.Media as NM +import qualified Snap.AtlassianConnect.Data as CD +import qualified Snap.AtlassianConnect.LifecycleResponse as CL +import qualified Snap.Core as SC +import qualified Snap.Helpers as SH +import qualified Snap.Snaplet as SS + +data MediaType = ApplicationJson | TextHtml deriving (Eq) + +newtype OrdMediaType = OMT NM.MediaType deriving (Eq, Show) + +instance Ord OrdMediaType where + compare a b = compare (show a) (show b) + +instance Show (MediaType) where + show ApplicationJson = "application/json" + show TextHtml = "text/html" + +-- | In old versions of Atlassian Connect, if you queried the application root and your Accept headers wanted an +-- "application/json" response then they would return your Atlassian Connect descriptor and if the Accept headers +-- requested "text/html" then they returned your applications home page. This is a convenience method to enable that +-- behaviour to continue. If you use this method in your routes then you can make your home page behave in the same way. +-- This is not required for an Atlassian Connect application so feel free to just return home page content on your home +-- page and ignore this method. +homeHandler :: SS.Handler b CD.Connect () -> SS.Handler b CD.Connect () +homeHandler sendHomePage = SC.method SC.GET handleGet <|> SH.respondWithError SH.badRequest "You can only GET the homepage." + where + handleGet = do + potentialAcceptHeader <- SC.getHeader bsAccept <$> SC.getRequest + case potentialAcceptHeader of + Just acceptHeader -> fromMaybe unknownHeader (NM.mapAcceptMedia mediaTypeMap acceptHeader) + Nothing -> mzero + + mediaTypeMap = + [ (jsonMT, atlassianConnectHandler) + , (textHtmlMT, sendHomePage) + ] + + unknownHeader = SH.respondWithError SH.notFound "No response to a request with the provided Accept header." + + jsonMT = "application" NM.// "json" + textHtmlMT = "text" NM.// "html" + +bsAccept :: CI.CI BC.ByteString +bsAccept = CI.mk "Accept" + +connectRoutes :: [(BC.ByteString, SS.Handler b CD.Connect ())] +connectRoutes = fmap (ARO.first BC.pack) simpleConnectRoutes + +-- Handler b v a +-- b: lens from the base state to the current snaplets state (is the base state) +-- v: is the state of the current "view" snaplet (or simply, current state) +-- a: Monad return type +-- The MonadSnaplet type class distills the essence of the operations used with this pattern. +-- Its functions define fundamental methods for navigating snaplet trees. + +simpleConnectRoutes :: [(String, SS.Handler b CD.Connect ())] +simpleConnectRoutes = + [ ("/atlassian-connect.json" , atlassianConnectHandler) + ] + +atlassianConnectHandler :: SS.Handler b CD.Connect () +atlassianConnectHandler = do + connectData <- get + let dc = genDescriptorExtrasFromConnect connectData + SH.writeJson $ convertPluginDescriptor dc (CD.connectPlugin connectData) + +genDescriptorExtrasFromConnect :: CD.Connect -> CD.DynamicDescriptorConfig +genDescriptorExtrasFromConnect connectData = CD.DynamicDescriptorConfig + { CD.dcPluginName = case CD.connectPluginName connectData of D.Name t -> D.Name t + , CD.dcPluginKey = CD.connectPluginKey connectData + , CD.dcBaseUrl = CD.connectBaseUrl connectData + } + +convertPluginDescriptor :: CD.DynamicDescriptorConfig -> D.Plugin -> D.Plugin +convertPluginDescriptor dc plugin = plugin + { D.pluginKey = CD.dcPluginKey dc + , D.pluginName = Just . CD.dcPluginName $ dc + , D.pluginBaseUrl = CD.dcBaseUrl dc + } diff --git a/src/Snap/AtlassianConnect/Tenant.hs b/src/Snap/AtlassianConnect/Tenant.hs new file mode 100644 --- /dev/null +++ b/src/Snap/AtlassianConnect/Tenant.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE DeriveGeneric #-} +module Snap.AtlassianConnect.Tenant + ( TenantWithUser + , Tenant(..) + , TenantKey + ) where + +import Data.Aeson.Types +import qualified Data.Text as T +import GHC.Generics +import qualified Snap.AtlassianConnect.AtlassianTypes as CA +import Snap.AtlassianConnect.Instances + +-- | When we get a tenant from Atlassian Connect we can also optionally reciever the user key that made the request. +-- This structure reflects that possibility. +type TenantWithUser = (Tenant, Maybe CA.UserKey) + +instance FromJSON Tenant + +-- | Represents a tenant key. The unique identifier for each Atlassian Connect tenant. +type TenantKey = T.Text + +-- | Represents an Atlassian Cloud tenant. Your Atlassian Connect add-on can be installed into multiple Atlassian +-- Cloud tenants. +data Tenant = Tenant + { tenantId :: Integer -- ^ Your identifier for this tenant. + , key :: TenantKey -- ^ The unique identifier for this tenant accross Atlassian Connect. + , publicKey :: T.Text -- ^ The public key for this atlassian connect application. + , sharedSecret :: T.Text -- ^ The shared secret for this atlassian connect application. Used for JWT token generation. + , baseUrl :: ConnectURI -- ^ The base url of the Atlassian Cloud host application (product). + , productType :: T.Text -- ^ The type of product you have connected to in the Atlassian Cloud. (E.g. JIRA, Confluence) + } deriving (Eq, Show, Generic) diff --git a/src/Snap/AtlassianConnect/TimeUnits.hs b/src/Snap/AtlassianConnect/TimeUnits.hs new file mode 100644 --- /dev/null +++ b/src/Snap/AtlassianConnect/TimeUnits.hs @@ -0,0 +1,23 @@ +module Snap.AtlassianConnect.TimeUnits + ( ConnectSecond(..) + , getSecond + ) where + +import qualified Data.Configurator.Types as DCT +import Data.Ratio (denominator, numerator) +import qualified Data.Time.Units as DTU + +-- | Represents a second for Atlassian Connect +newtype ConnectSecond = CSecond DTU.Second + deriving(Eq, Show) + +-- | Gets the Data.Time.Units representation of this Atlassian Connect second. +getSecond :: ConnectSecond -> DTU.Second +getSecond (CSecond s) = s + +instance DCT.Configured ConnectSecond where + convert (DCT.Number x) = Just . CSecond . fromIntegral . rationalToInteger $ x + convert _ = Nothing + +rationalToInteger :: Rational -> Integer +rationalToInteger x = numerator x `div` denominator x diff --git a/src/Snap/Helpers.hs b/src/Snap/Helpers.hs new file mode 100644 --- /dev/null +++ b/src/Snap/Helpers.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE DeriveGeneric #-} +module Snap.Helpers + ( respondWith + -- HTTP Codes + , noContent + , temporaryRedirect + , badRequest + , unauthorised + , forbidden + , notFound + , internalServer + , ok + , serviceUnavaliable + -- Responses with Http Codes + , respondBadRequest + , respondNotFound + , respondInternalServer + , respondNoContent + -- Respond with an error + , respondWithError + , respondWithErrors + -- Write Aeson into a response + , writeJson + ) where + +import Data.Aeson +import qualified Data.ByteString.Char8 as BSC +import GHC.Generics +import qualified Snap.Core as SC + +respondWith :: SC.MonadSnap m => Int -> m () +respondWith = SC.modifyResponse . SC.setResponseCode + +noContent, temporaryRedirect, badRequest, unauthorised, forbidden, notFound, internalServer, ok, serviceUnavaliable :: Int +ok = 200 +noContent = 204 +temporaryRedirect = 302 +badRequest = 400 +unauthorised = 401 +forbidden = 403 +notFound = 404 +internalServer = 500 +serviceUnavaliable = 503 + +respondBadRequest, respondNotFound, respondInternalServer, respondNoContent :: SC.MonadSnap m => m () +respondBadRequest = respondWith badRequest +respondNotFound = respondWith notFound +respondInternalServer = respondWith internalServer +respondNoContent = respondWith noContent + +respondWithError :: SC.MonadSnap m => Int -> String -> m () +respondWithError errorCode response = respondWithErrors errorCode [response] + +respondWithErrors :: SC.MonadSnap m => Int -> [String] -> m () +respondWithErrors errorCode responses = do + writeJson errorResponse + respondWith errorCode + where + errorResponse = ErrorResponse responses + +writeJson :: (SC.MonadSnap m, ToJSON a) => a -> m () +writeJson a = do + SC.modifyResponse . SC.setContentType . BSC.pack $ "application/json" + SC.writeLBS $ encode a + +data ErrorResponse = ErrorResponse + { errorMessages :: [String] + } deriving (Show, Generic) + +instance ToJSON ErrorResponse