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"
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
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.dcBaseUrl = CD.connectBaseUrl connectData
}
convertPluginDescriptor :: CD.DynamicDescriptorConfig -> D.Plugin -> D.Plugin
convertPluginDescriptor dc plugin = plugin
{ D.pluginBaseUrl = CD.dcBaseUrl dc
}