packages feed

hipbot 0.3.0.2 → 0.5

raw patch · 11 files changed

+590/−301 lines, 11 filesdep +webcrankdep ~bifunctorsdep ~blaze-builderdep ~webcrank-waiPVP ok

version bump matches the API change (PVP)

Dependencies added: webcrank

Dependency ranges changed: bifunctors, blaze-builder, webcrank-wai

API changes (from Hackage documentation)

- HipBot: [APIConsumer] :: [APIScope] -> Maybe Text -> APIConsumer
- HipBot: [AbsoluteURI] :: URI -> AbsoluteURI
- HipBot: [AccessToken] :: Text -> UTCTime -> AccessToken
- HipBot: [AddOn] :: Text -> Text -> Text -> Links -> Maybe Capabilities -> Maybe Vendor -> AddOn
- HipBot: [AdminGroup] :: APIScope
- HipBot: [AdminRoom] :: APIScope
- HipBot: [Capabilities] :: Maybe Installable -> Maybe APIConsumer -> Maybe OAuth2Provider -> [Webhook] -> Maybe Configurable -> Capabilities
- HipBot: [Configurable] :: AbsoluteURI -> Configurable
- HipBot: [HtmlNotification] :: Text -> Notification
- HipBot: [Installable] :: Maybe AbsoluteURI -> Bool -> Bool -> Installable
- HipBot: [Links] :: AbsoluteURI -> Maybe AbsoluteURI -> Links
- HipBot: [ManageRooms] :: APIScope
- HipBot: [OAuth2Provider] :: AbsoluteURI -> AbsoluteURI -> OAuth2Provider
- HipBot: [Registration] :: OAuthId -> AbsoluteURI -> Maybe RoomId -> Int -> Text -> Registration
- HipBot: [SendMessage] :: APIScope
- HipBot: [SendNotification] :: APIScope
- HipBot: [TextNotification] :: Text -> Notification
- HipBot: [Vendor] :: AbsoluteURI -> Text -> Vendor
- HipBot: [ViewGroup] :: APIScope
- HipBot: [ViewMessages] :: APIScope
- HipBot: [Webhook] :: AbsoluteURI -> Maybe Text -> RoomEvent -> Webhook
- HipBot: [_accessTokenAccessToken] :: AccessToken -> Text
- HipBot: [_accessTokenExpires] :: AccessToken -> UTCTime
- HipBot: [_addOnCapabilities] :: AddOn -> Maybe Capabilities
- HipBot: [_addOnDescription] :: AddOn -> Text
- HipBot: [_addOnKey] :: AddOn -> Text
- HipBot: [_addOnLinks] :: AddOn -> Links
- HipBot: [_addOnName] :: AddOn -> Text
- HipBot: [_addOnVendor] :: AddOn -> Maybe Vendor
- HipBot: [_apiFromName] :: APIConsumer -> Maybe Text
- HipBot: [_apiScopes] :: APIConsumer -> [APIScope]
- HipBot: [_capabilitiesConfigurable] :: Capabilities -> Maybe Configurable
- HipBot: [_capabilitiesHipchatApiConsumer] :: Capabilities -> Maybe APIConsumer
- HipBot: [_capabilitiesInstallable] :: Capabilities -> Maybe Installable
- HipBot: [_capabilitiesOauth2Provider] :: Capabilities -> Maybe OAuth2Provider
- HipBot: [_capabilitiesWebhooks] :: Capabilities -> [Webhook]
- HipBot: [_configurableUrl] :: Configurable -> AbsoluteURI
- HipBot: [_installableAllowGlobal] :: Installable -> Bool
- HipBot: [_installableAllowRoom] :: Installable -> Bool
- HipBot: [_installableCallbackUrl] :: Installable -> Maybe AbsoluteURI
- HipBot: [_linksHomepage] :: Links -> Maybe AbsoluteURI
- HipBot: [_linksSelf] :: Links -> AbsoluteURI
- HipBot: [_oAuth2ProviderAuthorizationUrl] :: OAuth2Provider -> AbsoluteURI
- HipBot: [_oAuth2ProviderTokenUrl] :: OAuth2Provider -> AbsoluteURI
- HipBot: [_registrationCapabilitiesUrl] :: Registration -> AbsoluteURI
- HipBot: [_registrationGroupId] :: Registration -> Int
- HipBot: [_registrationOauthId] :: Registration -> OAuthId
- HipBot: [_registrationOauthSecret] :: Registration -> Text
- HipBot: [_registrationRoomId] :: Registration -> Maybe RoomId
- HipBot: [_vendorName] :: Vendor -> Text
- HipBot: [_vendorUrl] :: Vendor -> AbsoluteURI
- HipBot: [_webhookEvent] :: Webhook -> RoomEvent
- HipBot: [_webhookPattern] :: Webhook -> Maybe Text
- HipBot: [_webhookUrl] :: Webhook -> AbsoluteURI
- HipBot: accessToken :: HasAccessToken s a => Lens' s a
- HipBot: allowGlobal :: HasAllowGlobal s a => Lens' s a
- HipBot: allowRoom :: HasAllowRoom s a => Lens' s a
- HipBot: apiScopeStr :: IsString a => APIScope -> a
- HipBot: appendPath :: AbsoluteURI -> [Text] -> AbsoluteURI
- HipBot: authorizationUrl :: HasAuthorizationUrl s a => Lens' s a
- HipBot: callbackUrl :: HasCallbackUrl s a => Lens' s a
- HipBot: capabilities :: HasCapabilities s a => Lens' s a
- HipBot: capabilitiesUrl :: HasCapabilitiesUrl s a => Lens' s a
- HipBot: class HasAccessToken s a | s -> a
- HipBot: class HasAllowGlobal s a | s -> a
- HipBot: class HasAllowRoom s a | s -> a
- HipBot: class HasAuthorizationUrl s a | s -> a
- HipBot: class HasCallbackUrl s a | s -> a
- HipBot: class HasCapabilities s a | s -> a
- HipBot: class HasCapabilitiesUrl s a | s -> a
- HipBot: class HasConfigurable s a | s -> a
- HipBot: class HasDescription s a | s -> a
- HipBot: class HasExpires s a | s -> a
- HipBot: class HasFromName s a | s -> a
- HipBot: class HasGroupId s a | s -> a
- HipBot: class HasHipchatApiConsumer s a | s -> a
- HipBot: class HasHomepage s a | s -> a
- HipBot: class HasInstallable s a | s -> a
- HipBot: class HasKey s a | s -> a
- HipBot: class HasLinks s a | s -> a
- HipBot: class HasName s a | s -> a
- HipBot: class HasOauth2Provider s a | s -> a
- HipBot: class HasOauthId s a | s -> a
- HipBot: class HasOauthSecret s a | s -> a
- HipBot: class HasRoomId s a | s -> a
- HipBot: class HasScopes s a | s -> a
- HipBot: class HasSelf s a | s -> a
- HipBot: class HasTokenUrl s a | s -> a
- HipBot: class HasUrl s a | s -> a
- HipBot: class HasVendor s a | s -> a
- HipBot: class HasWebhooks s a | s -> a
- HipBot: configurable :: HasConfigurable s a => Lens' s a
- HipBot: data APIConsumer
- HipBot: data APIScope
- HipBot: data AccessToken
- HipBot: data AddOn
- HipBot: data Capabilities
- HipBot: data Configurable
- HipBot: data Installable
- HipBot: data Links
- HipBot: data Notification
- HipBot: data OAuth2Provider
- HipBot: data Registration
- HipBot: data Vendor
- HipBot: data Webhook
- HipBot: defaultAPIConsumer :: APIConsumer
- HipBot: defaultAddOn :: Text -> Text -> Text -> Links -> AddOn
- HipBot: defaultCapabilities :: Capabilities
- HipBot: defaultInstallable :: Installable
- HipBot: defaultLinks :: AbsoluteURI -> Links
- HipBot: description :: HasDescription s a => Lens' s a
- HipBot: expires :: HasExpires s a => Lens' s a
- HipBot: fromName :: HasFromName s a => Lens' s a
- HipBot: groupId :: HasGroupId s a => Lens' s a
- HipBot: hipchatApiConsumer :: HasHipchatApiConsumer s a => Lens' s a
- HipBot: homepage :: HasHomepage s a => Lens' s a
- HipBot: installable :: HasInstallable s a => Lens' s a
- HipBot: key :: HasKey s a => Lens' s a
- HipBot: links :: HasLinks s a => Lens' s a
- HipBot: name :: HasName s a => Lens' s a
- HipBot: newtype AbsoluteURI
- HipBot: oauth2Provider :: HasOauth2Provider s a => Lens' s a
- HipBot: oauthId :: HasOauthId s a => Lens' s a
- HipBot: oauthSecret :: HasOauthSecret s a => Lens' s a
- HipBot: parseAbsoluteURI :: String -> Maybe AbsoluteURI
- HipBot: relPath :: [Text] -> String
- HipBot: relativeTo :: [Text] -> AbsoluteURI -> AbsoluteURI
- HipBot: roomId :: HasRoomId s a => Lens' s a
- HipBot: scopes :: HasScopes s a => Lens' s a
- HipBot: self :: HasSelf s a => Lens' s a
- HipBot: tokenUrl :: HasTokenUrl s a => Lens' s a
- HipBot: url :: HasUrl s a => Lens' s a
- HipBot: vendor :: HasVendor s a => Lens' s a
- HipBot: webhooks :: HasWebhooks s a => Lens' s a
+ HipBot: newHipBot' :: Monad m => HipBotAPI m -> AddOn -> IO (HipBot m)
+ HipBot: type OnUninstall m = OAuthId -> m ()
+ HipBot.AbsoluteURI: [AbsoluteURI] :: URI -> AbsoluteURI
+ HipBot.AbsoluteURI: appendPath :: AbsoluteURI -> [Text] -> AbsoluteURI
+ HipBot.AbsoluteURI: instance Eq AbsoluteURI
+ HipBot.AbsoluteURI: instance FromJSON AbsoluteURI
+ HipBot.AbsoluteURI: instance IsString AbsoluteURI
+ HipBot.AbsoluteURI: instance Show AbsoluteURI
+ HipBot.AbsoluteURI: instance ToJSON AbsoluteURI
+ HipBot.AbsoluteURI: newtype AbsoluteURI
+ HipBot.AbsoluteURI: parseAbsoluteURI :: String -> Maybe AbsoluteURI
+ HipBot.AbsoluteURI: relPath :: [Text] -> String
+ HipBot.AbsoluteURI: relativeTo :: [Text] -> AbsoluteURI -> AbsoluteURI
+ HipBot.Descriptor: [APIConsumer] :: [APIScope] -> Maybe Text -> APIConsumer
+ HipBot.Descriptor: [AccessToken] :: Text -> UTCTime -> AccessToken
+ HipBot.Descriptor: [AddOn] :: Text -> Text -> Text -> Links -> Maybe Capabilities -> Maybe Vendor -> AddOn
+ HipBot.Descriptor: [AdminGroup] :: APIScope
+ HipBot.Descriptor: [AdminRoom] :: APIScope
+ HipBot.Descriptor: [Capabilities] :: Maybe Installable -> Maybe APIConsumer -> Maybe OAuth2Provider -> [Webhook] -> Maybe Configurable -> Capabilities
+ HipBot.Descriptor: [Configurable] :: AbsoluteURI -> Configurable
+ HipBot.Descriptor: [Installable] :: Maybe AbsoluteURI -> Bool -> Bool -> Installable
+ HipBot.Descriptor: [Links] :: AbsoluteURI -> Maybe AbsoluteURI -> Links
+ HipBot.Descriptor: [ManageRooms] :: APIScope
+ HipBot.Descriptor: [OAuth2Provider] :: AbsoluteURI -> AbsoluteURI -> OAuth2Provider
+ HipBot.Descriptor: [Registration] :: OAuthId -> AbsoluteURI -> Maybe RoomId -> Int -> Text -> Registration
+ HipBot.Descriptor: [SendMessage] :: APIScope
+ HipBot.Descriptor: [SendNotification] :: APIScope
+ HipBot.Descriptor: [Vendor] :: AbsoluteURI -> Text -> Vendor
+ HipBot.Descriptor: [ViewGroup] :: APIScope
+ HipBot.Descriptor: [ViewMessages] :: APIScope
+ HipBot.Descriptor: [Webhook] :: AbsoluteURI -> Maybe Text -> RoomEvent -> Webhook
+ HipBot.Descriptor: [_accessTokenAccessToken] :: AccessToken -> Text
+ HipBot.Descriptor: [_accessTokenExpires] :: AccessToken -> UTCTime
+ HipBot.Descriptor: [_addOnCapabilities] :: AddOn -> Maybe Capabilities
+ HipBot.Descriptor: [_addOnDescription] :: AddOn -> Text
+ HipBot.Descriptor: [_addOnKey] :: AddOn -> Text
+ HipBot.Descriptor: [_addOnLinks] :: AddOn -> Links
+ HipBot.Descriptor: [_addOnName] :: AddOn -> Text
+ HipBot.Descriptor: [_addOnVendor] :: AddOn -> Maybe Vendor
+ HipBot.Descriptor: [_apiFromName] :: APIConsumer -> Maybe Text
+ HipBot.Descriptor: [_apiScopes] :: APIConsumer -> [APIScope]
+ HipBot.Descriptor: [_capabilitiesConfigurable] :: Capabilities -> Maybe Configurable
+ HipBot.Descriptor: [_capabilitiesHipchatApiConsumer] :: Capabilities -> Maybe APIConsumer
+ HipBot.Descriptor: [_capabilitiesInstallable] :: Capabilities -> Maybe Installable
+ HipBot.Descriptor: [_capabilitiesOauth2Provider] :: Capabilities -> Maybe OAuth2Provider
+ HipBot.Descriptor: [_capabilitiesWebhooks] :: Capabilities -> [Webhook]
+ HipBot.Descriptor: [_configurableUrl] :: Configurable -> AbsoluteURI
+ HipBot.Descriptor: [_installableAllowGlobal] :: Installable -> Bool
+ HipBot.Descriptor: [_installableAllowRoom] :: Installable -> Bool
+ HipBot.Descriptor: [_installableCallbackUrl] :: Installable -> Maybe AbsoluteURI
+ HipBot.Descriptor: [_linksHomepage] :: Links -> Maybe AbsoluteURI
+ HipBot.Descriptor: [_linksSelf] :: Links -> AbsoluteURI
+ HipBot.Descriptor: [_oAuth2ProviderAuthorizationUrl] :: OAuth2Provider -> AbsoluteURI
+ HipBot.Descriptor: [_oAuth2ProviderTokenUrl] :: OAuth2Provider -> AbsoluteURI
+ HipBot.Descriptor: [_registrationCapabilitiesUrl] :: Registration -> AbsoluteURI
+ HipBot.Descriptor: [_registrationGroupId] :: Registration -> Int
+ HipBot.Descriptor: [_registrationOauthId] :: Registration -> OAuthId
+ HipBot.Descriptor: [_registrationOauthSecret] :: Registration -> Text
+ HipBot.Descriptor: [_registrationRoomId] :: Registration -> Maybe RoomId
+ HipBot.Descriptor: [_vendorName] :: Vendor -> Text
+ HipBot.Descriptor: [_vendorUrl] :: Vendor -> AbsoluteURI
+ HipBot.Descriptor: [_webhookEvent] :: Webhook -> RoomEvent
+ HipBot.Descriptor: [_webhookPattern] :: Webhook -> Maybe Text
+ HipBot.Descriptor: [_webhookUrl] :: Webhook -> AbsoluteURI
+ HipBot.Descriptor: accessToken :: HasAccessToken s a => Lens' s a
+ HipBot.Descriptor: allowGlobal :: HasAllowGlobal s a => Lens' s a
+ HipBot.Descriptor: allowRoom :: HasAllowRoom s a => Lens' s a
+ HipBot.Descriptor: apiScopeStr :: IsString a => APIScope -> a
+ HipBot.Descriptor: authorizationUrl :: HasAuthorizationUrl s a => Lens' s a
+ HipBot.Descriptor: callbackUrl :: HasCallbackUrl s a => Lens' s a
+ HipBot.Descriptor: capabilities :: HasCapabilities s a => Lens' s a
+ HipBot.Descriptor: capabilitiesUrl :: HasCapabilitiesUrl s a => Lens' s a
+ HipBot.Descriptor: class HasAccessToken s a | s -> a
+ HipBot.Descriptor: class HasAllowGlobal s a | s -> a
+ HipBot.Descriptor: class HasAllowRoom s a | s -> a
+ HipBot.Descriptor: class HasAuthorizationUrl s a | s -> a
+ HipBot.Descriptor: class HasCallbackUrl s a | s -> a
+ HipBot.Descriptor: class HasCapabilities s a | s -> a
+ HipBot.Descriptor: class HasCapabilitiesUrl s a | s -> a
+ HipBot.Descriptor: class HasConfigurable s a | s -> a
+ HipBot.Descriptor: class HasDescription s a | s -> a
+ HipBot.Descriptor: class HasEvent s a | s -> a
+ HipBot.Descriptor: class HasExpires s a | s -> a
+ HipBot.Descriptor: class HasFromName s a | s -> a
+ HipBot.Descriptor: class HasGroupId s a | s -> a
+ HipBot.Descriptor: class HasHipchatApiConsumer s a | s -> a
+ HipBot.Descriptor: class HasHomepage s a | s -> a
+ HipBot.Descriptor: class HasInstallable s a | s -> a
+ HipBot.Descriptor: class HasKey s a | s -> a
+ HipBot.Descriptor: class HasLinks s a | s -> a
+ HipBot.Descriptor: class HasName s a | s -> a
+ HipBot.Descriptor: class HasOauth2Provider s a | s -> a
+ HipBot.Descriptor: class HasOauthId s a | s -> a
+ HipBot.Descriptor: class HasOauthSecret s a | s -> a
+ HipBot.Descriptor: class HasPattern s a | s -> a
+ HipBot.Descriptor: class HasRoomId s a | s -> a
+ HipBot.Descriptor: class HasScopes s a | s -> a
+ HipBot.Descriptor: class HasSelf s a | s -> a
+ HipBot.Descriptor: class HasTokenUrl s a | s -> a
+ HipBot.Descriptor: class HasUrl s a | s -> a
+ HipBot.Descriptor: class HasVendor s a | s -> a
+ HipBot.Descriptor: class HasWebhooks s a | s -> a
+ HipBot.Descriptor: configurable :: HasConfigurable s a => Lens' s a
+ HipBot.Descriptor: data APIConsumer
+ HipBot.Descriptor: data APIScope
+ HipBot.Descriptor: data AccessToken
+ HipBot.Descriptor: data AddOn
+ HipBot.Descriptor: data Capabilities
+ HipBot.Descriptor: data Configurable
+ HipBot.Descriptor: data Installable
+ HipBot.Descriptor: data Links
+ HipBot.Descriptor: data OAuth2Provider
+ HipBot.Descriptor: data Registration
+ HipBot.Descriptor: data Vendor
+ HipBot.Descriptor: data Webhook
+ HipBot.Descriptor: defaultAPIConsumer :: APIConsumer
+ HipBot.Descriptor: defaultAddOn :: Text -> Text -> Text -> Links -> AddOn
+ HipBot.Descriptor: defaultCapabilities :: Capabilities
+ HipBot.Descriptor: defaultInstallable :: Installable
+ HipBot.Descriptor: defaultLinks :: AbsoluteURI -> Links
+ HipBot.Descriptor: description :: HasDescription s a => Lens' s a
+ HipBot.Descriptor: event :: HasEvent s a => Lens' s a
+ HipBot.Descriptor: expires :: HasExpires s a => Lens' s a
+ HipBot.Descriptor: fromName :: HasFromName s a => Lens' s a
+ HipBot.Descriptor: groupId :: HasGroupId s a => Lens' s a
+ HipBot.Descriptor: hipchatApiConsumer :: HasHipchatApiConsumer s a => Lens' s a
+ HipBot.Descriptor: homepage :: HasHomepage s a => Lens' s a
+ HipBot.Descriptor: installable :: HasInstallable s a => Lens' s a
+ HipBot.Descriptor: instance Eq APIConsumer
+ HipBot.Descriptor: instance Eq APIScope
+ HipBot.Descriptor: instance Eq AddOn
+ HipBot.Descriptor: instance Eq Capabilities
+ HipBot.Descriptor: instance Eq Configurable
+ HipBot.Descriptor: instance Eq Installable
+ HipBot.Descriptor: instance Eq Links
+ HipBot.Descriptor: instance Eq OAuth2Provider
+ HipBot.Descriptor: instance Eq Vendor
+ HipBot.Descriptor: instance Eq Webhook
+ HipBot.Descriptor: instance FromJSON APIConsumer
+ HipBot.Descriptor: instance FromJSON APIScope
+ HipBot.Descriptor: instance FromJSON AddOn
+ HipBot.Descriptor: instance FromJSON Capabilities
+ HipBot.Descriptor: instance FromJSON Configurable
+ HipBot.Descriptor: instance FromJSON Installable
+ HipBot.Descriptor: instance FromJSON Links
+ HipBot.Descriptor: instance FromJSON OAuth2Provider
+ HipBot.Descriptor: instance FromJSON Registration
+ HipBot.Descriptor: instance FromJSON Vendor
+ HipBot.Descriptor: instance FromJSON Webhook
+ HipBot.Descriptor: instance HasAccessToken AccessToken Text
+ HipBot.Descriptor: instance HasAllowGlobal Installable Bool
+ HipBot.Descriptor: instance HasAllowRoom Installable Bool
+ HipBot.Descriptor: instance HasAuthorizationUrl OAuth2Provider AbsoluteURI
+ HipBot.Descriptor: instance HasCallbackUrl Installable (Maybe AbsoluteURI)
+ HipBot.Descriptor: instance HasCapabilities AddOn (Maybe Capabilities)
+ HipBot.Descriptor: instance HasCapabilitiesUrl Registration AbsoluteURI
+ HipBot.Descriptor: instance HasConfigurable Capabilities (Maybe Configurable)
+ HipBot.Descriptor: instance HasDescription AddOn Text
+ HipBot.Descriptor: instance HasEvent Webhook RoomEvent
+ HipBot.Descriptor: instance HasExpires AccessToken UTCTime
+ HipBot.Descriptor: instance HasFromName APIConsumer (Maybe Text)
+ HipBot.Descriptor: instance HasGroupId Registration Int
+ HipBot.Descriptor: instance HasHipchatApiConsumer Capabilities (Maybe APIConsumer)
+ HipBot.Descriptor: instance HasHomepage Links (Maybe AbsoluteURI)
+ HipBot.Descriptor: instance HasInstallable Capabilities (Maybe Installable)
+ HipBot.Descriptor: instance HasKey AddOn Text
+ HipBot.Descriptor: instance HasLinks AddOn Links
+ HipBot.Descriptor: instance HasName AddOn Text
+ HipBot.Descriptor: instance HasOauth2Provider Capabilities (Maybe OAuth2Provider)
+ HipBot.Descriptor: instance HasOauthId Registration OAuthId
+ HipBot.Descriptor: instance HasOauthSecret Registration Text
+ HipBot.Descriptor: instance HasPattern Webhook (Maybe Text)
+ HipBot.Descriptor: instance HasRoomId Registration (Maybe RoomId)
+ HipBot.Descriptor: instance HasScopes APIConsumer [APIScope]
+ HipBot.Descriptor: instance HasSelf Links AbsoluteURI
+ HipBot.Descriptor: instance HasTokenUrl OAuth2Provider AbsoluteURI
+ HipBot.Descriptor: instance HasUrl Configurable AbsoluteURI
+ HipBot.Descriptor: instance HasUrl Webhook AbsoluteURI
+ HipBot.Descriptor: instance HasVendor AddOn (Maybe Vendor)
+ HipBot.Descriptor: instance HasWebhooks Capabilities [Webhook]
+ HipBot.Descriptor: instance Show APIConsumer
+ HipBot.Descriptor: instance Show APIScope
+ HipBot.Descriptor: instance Show AddOn
+ HipBot.Descriptor: instance Show Capabilities
+ HipBot.Descriptor: instance Show Configurable
+ HipBot.Descriptor: instance Show Installable
+ HipBot.Descriptor: instance Show Links
+ HipBot.Descriptor: instance Show OAuth2Provider
+ HipBot.Descriptor: instance Show Vendor
+ HipBot.Descriptor: instance Show Webhook
+ HipBot.Descriptor: instance ToJSON APIConsumer
+ HipBot.Descriptor: instance ToJSON APIScope
+ HipBot.Descriptor: instance ToJSON AddOn
+ HipBot.Descriptor: instance ToJSON Capabilities
+ HipBot.Descriptor: instance ToJSON Configurable
+ HipBot.Descriptor: instance ToJSON Installable
+ HipBot.Descriptor: instance ToJSON Links
+ HipBot.Descriptor: instance ToJSON OAuth2Provider
+ HipBot.Descriptor: instance ToJSON Registration
+ HipBot.Descriptor: instance ToJSON Vendor
+ HipBot.Descriptor: instance ToJSON Webhook
+ HipBot.Descriptor: key :: HasKey s a => Lens' s a
+ HipBot.Descriptor: links :: HasLinks s a => Lens' s a
+ HipBot.Descriptor: name :: HasName s a => Lens' s a
+ HipBot.Descriptor: oauth2Provider :: HasOauth2Provider s a => Lens' s a
+ HipBot.Descriptor: oauthId :: HasOauthId s a => Lens' s a
+ HipBot.Descriptor: oauthSecret :: HasOauthSecret s a => Lens' s a
+ HipBot.Descriptor: pattern :: HasPattern s a => Lens' s a
+ HipBot.Descriptor: roomId :: HasRoomId s a => Lens' s a
+ HipBot.Descriptor: scopes :: HasScopes s a => Lens' s a
+ HipBot.Descriptor: self :: HasSelf s a => Lens' s a
+ HipBot.Descriptor: tokenUrl :: HasTokenUrl s a => Lens' s a
+ HipBot.Descriptor: url :: HasUrl s a => Lens' s a
+ HipBot.Descriptor: vendor :: HasVendor s a => Lens' s a
+ HipBot.Descriptor: webhook :: AbsoluteURI -> RoomEvent -> Webhook
+ HipBot.Descriptor: webhooks :: HasWebhooks s a => Lens' s a
+ HipBot.Notification: [Gray] :: NotificationColor
+ HipBot.Notification: [Green] :: NotificationColor
+ HipBot.Notification: [HtmlNotification] :: Text -> NotificationMessage
+ HipBot.Notification: [Notification] :: Maybe NotificationColor -> Bool -> NotificationMessage -> Notification
+ HipBot.Notification: [Purple] :: NotificationColor
+ HipBot.Notification: [Random] :: NotificationColor
+ HipBot.Notification: [Red] :: NotificationColor
+ HipBot.Notification: [TextNotification] :: Text -> NotificationMessage
+ HipBot.Notification: [Yellow] :: NotificationColor
+ HipBot.Notification: [_notificationColor] :: Notification -> Maybe NotificationColor
+ HipBot.Notification: [_notificationMessage] :: Notification -> NotificationMessage
+ HipBot.Notification: [_notificationNotify] :: Notification -> Bool
+ HipBot.Notification: class HasColor s a | s -> a
+ HipBot.Notification: class HasMessage s a | s -> a
+ HipBot.Notification: class HasNotify s a | s -> a
+ HipBot.Notification: color :: HasColor s a => Lens' s a
+ HipBot.Notification: data Notification
+ HipBot.Notification: data NotificationColor
+ HipBot.Notification: data NotificationMessage
+ HipBot.Notification: defaultNotification :: NotificationMessage -> Notification
+ HipBot.Notification: htmlNotification :: Text -> Notification
+ HipBot.Notification: instance Eq Notification
+ HipBot.Notification: instance Eq NotificationColor
+ HipBot.Notification: instance Eq NotificationMessage
+ HipBot.Notification: instance HasColor Notification (Maybe NotificationColor)
+ HipBot.Notification: instance HasMessage Notification NotificationMessage
+ HipBot.Notification: instance HasNotify Notification Bool
+ HipBot.Notification: instance Show Notification
+ HipBot.Notification: instance Show NotificationColor
+ HipBot.Notification: instance Show NotificationMessage
+ HipBot.Notification: instance ToJSON Notification
+ HipBot.Notification: instance ToJSON NotificationColor
+ HipBot.Notification: message :: HasMessage s a => Lens' s a
+ HipBot.Notification: notify :: HasNotify s a => Lens' s a
+ HipBot.Notification: textNotification :: Text -> Notification
+ HipBot.Webhooks: [MessageItem] :: Text -> MessageItem
+ HipBot.Webhooks: [RoomLinks] :: Maybe AbsoluteURI -> AbsoluteURI -> AbsoluteURI -> AbsoluteURI -> RoomLinks
+ HipBot.Webhooks: [Room] :: RoomId -> RoomName -> RoomLinks -> Room
+ HipBot.Webhooks: [WebhookRoomEvent] :: Int -> Maybe String -> WebhookRoomItem -> WebhookRoomEvent
+ HipBot.Webhooks: [WebhookRoomMessage] :: Room -> MessageItem -> WebhookRoomItem
+ HipBot.Webhooks: [_messageItemMessage] :: MessageItem -> Text
+ HipBot.Webhooks: [_roomLinksMembers] :: RoomLinks -> Maybe AbsoluteURI
+ HipBot.Webhooks: [_roomLinksParticipants] :: RoomLinks -> AbsoluteURI
+ HipBot.Webhooks: [_roomLinksSelf] :: RoomLinks -> AbsoluteURI
+ HipBot.Webhooks: [_roomLinksWebhooks] :: RoomLinks -> AbsoluteURI
+ HipBot.Webhooks: [_roomLinks] :: Room -> RoomLinks
+ HipBot.Webhooks: [_roomName] :: Room -> RoomName
+ HipBot.Webhooks: [_roomRoomId] :: Room -> RoomId
+ HipBot.Webhooks: [_webhookRoomEventItem] :: WebhookRoomEvent -> WebhookRoomItem
+ HipBot.Webhooks: [_webhookRoomEventOauthId] :: WebhookRoomEvent -> Maybe String
+ HipBot.Webhooks: [_webhookRoomEventWebhookId] :: WebhookRoomEvent -> Int
+ HipBot.Webhooks: class HasItem s a | s -> a
+ HipBot.Webhooks: class HasLinks s a | s -> a
+ HipBot.Webhooks: class HasMembers s a | s -> a
+ HipBot.Webhooks: class HasMessage s a | s -> a
+ HipBot.Webhooks: class HasName s a | s -> a
+ HipBot.Webhooks: class HasOauthId s a | s -> a
+ HipBot.Webhooks: class HasParticipants s a | s -> a
+ HipBot.Webhooks: class HasRoomId s a | s -> a
+ HipBot.Webhooks: class HasSelf s a | s -> a
+ HipBot.Webhooks: class HasWebhookId s a | s -> a
+ HipBot.Webhooks: class HasWebhooks s a | s -> a
+ HipBot.Webhooks: data MessageItem
+ HipBot.Webhooks: data Room
+ HipBot.Webhooks: data RoomLinks
+ HipBot.Webhooks: data WebhookRoomEvent
+ HipBot.Webhooks: data WebhookRoomItem
+ HipBot.Webhooks: decodeWebhookRoomEvent :: (Functor m, MonadIO m, MonadReader s m, HasRequest s Request) => m (Either String WebhookRoomEvent)
+ HipBot.Webhooks: instance Eq MessageItem
+ HipBot.Webhooks: instance Eq Room
+ HipBot.Webhooks: instance Eq RoomLinks
+ HipBot.Webhooks: instance Eq WebhookRoomEvent
+ HipBot.Webhooks: instance Eq WebhookRoomItem
+ HipBot.Webhooks: instance FromJSON MessageItem
+ HipBot.Webhooks: instance FromJSON Room
+ HipBot.Webhooks: instance FromJSON RoomLinks
+ HipBot.Webhooks: instance FromJSON WebhookRoomEvent
+ HipBot.Webhooks: instance HasItem WebhookRoomEvent WebhookRoomItem
+ HipBot.Webhooks: instance HasLinks Room RoomLinks
+ HipBot.Webhooks: instance HasMembers RoomLinks (Maybe AbsoluteURI)
+ HipBot.Webhooks: instance HasMessage MessageItem Text
+ HipBot.Webhooks: instance HasName Room RoomName
+ HipBot.Webhooks: instance HasOauthId WebhookRoomEvent (Maybe String)
+ HipBot.Webhooks: instance HasParticipants RoomLinks AbsoluteURI
+ HipBot.Webhooks: instance HasRoomId Room RoomId
+ HipBot.Webhooks: instance HasSelf RoomLinks AbsoluteURI
+ HipBot.Webhooks: instance HasWebhookId WebhookRoomEvent Int
+ HipBot.Webhooks: instance HasWebhooks RoomLinks AbsoluteURI
+ HipBot.Webhooks: instance Show MessageItem
+ HipBot.Webhooks: instance Show Room
+ HipBot.Webhooks: instance Show RoomLinks
+ HipBot.Webhooks: instance Show WebhookRoomEvent
+ HipBot.Webhooks: instance Show WebhookRoomItem
+ HipBot.Webhooks: item :: HasItem s a => Lens' s a
+ HipBot.Webhooks: links :: HasLinks s a => Lens' s a
+ HipBot.Webhooks: members :: HasMembers s a => Lens' s a
+ HipBot.Webhooks: message :: HasMessage s a => Lens' s a
+ HipBot.Webhooks: name :: HasName s a => Lens' s a
+ HipBot.Webhooks: oauthId :: HasOauthId s a => Lens' s a
+ HipBot.Webhooks: participants :: HasParticipants s a => Lens' s a
+ HipBot.Webhooks: roomId :: HasRoomId s a => Lens' s a
+ HipBot.Webhooks: roomMessageWebhookResource :: (MonadIO m, MonadReader r m, MonadState s m, HasReqData s, HasRequest r Request) => String -> (Room -> MessageItem -> HaltT m (Maybe Notification)) -> Resource m
+ HipBot.Webhooks: self :: HasSelf s a => Lens' s a
+ HipBot.Webhooks: simpleWebhookResource :: MonadIO m => String -> [Text] -> (Text -> Maybe Text) -> WaiResource m
+ HipBot.Webhooks: webhookId :: HasWebhookId s a => Lens' s a
+ HipBot.Webhooks: webhookResource :: (MonadIO m, MonadReader r m, HasRequest r Request, MonadState s m, HasReqData s) => String -> (WebhookRoomEvent -> HaltT m (Maybe Notification)) -> Resource m
+ HipBot.Webhooks: webhooks :: HasWebhooks s a => Lens' s a

Files

hipbot.cabal view
@@ -1,5 +1,5 @@ name:               hipbot-version:            0.3.0.2+version:            0.5 license:            BSD3 license-file:       LICENSE author:             Richard Wallace <rwallace@atlassian.com>@@ -32,7 +32,11 @@   hs-source-dirs:   src    exposed-modules:  HipBot+                  , HipBot.AbsoluteURI                   , HipBot.API+                  , HipBot.Descriptor+                  , HipBot.Notification+                  , HipBot.Webhooks    other-modules:    HipBot.Internal.HipBot                   , HipBot.Internal.OAuth@@ -64,6 +68,7 @@                   , utf8-string                     >=0.3.1 && <1.1                   , wai                             >=3.0 && <4                   , wai-lens                        >=0.1 && <1-                  , webcrank-wai                    >=0.2 && <1+                  , webcrank                        >=0.2.2 && <1+                  , webcrank-wai                    >=0.2.1 && <1                   , wreq                            >=0.2 && <1
src/HipBot.hs view
@@ -7,12 +7,20 @@ module HipBot   ( HipBot   , HipBotAPI(..)+  , OnUninstall+  , OAuthId+  , RoomName+  , RoomId+  , RoomEvent(..)   , newHipBot+  , newHipBot'   , hipBotResources   , configResource   , verifySignature   , sendNotification-  , module HipBot.Internal.Types+  , module HipBot.AbsoluteURI+  , module HipBot.Descriptor+  , module HipBot.Notification   ) where  import Control.Applicative@@ -20,13 +28,11 @@ import Control.Monad.Catch import Control.Monad.Trans import Control.Monad.Trans.Either-import Data.Aeson ((.=)) import qualified Data.Aeson as A import Data.Bifunctor import qualified Data.ByteString.UTF8 as B import qualified Data.List as List import Data.Monoid-import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T import Data.Time.Clock@@ -37,11 +43,14 @@ import Prelude import Safe +import HipBot.AbsoluteURI import HipBot.API+import HipBot.Descriptor import HipBot.Internal.HipBot import HipBot.Internal.OAuth import HipBot.Internal.Resources import HipBot.Internal.Types+import HipBot.Notification  data NotificationError   = NoSuchRegistration OAuthId@@ -59,15 +68,7 @@   -> m (Maybe NotificationError) sendNotification bot oid room n =   let-    msg = case n of-      TextNotification t -> A.object-        [ "message_format" .= ("text" :: Text)-        , "message" .= t-        ]-      HtmlNotification t -> A.object-        [ "message_format" .= ("html" :: Text)-        , "message" .= t-        ]+    msg = A.encode n     opts tok = wreqDefaults bot       & Wreq.header hAuthorization .~           [("Bearer " <>) .  T.encodeUtf8 . view accessToken $ tok]
src/HipBot/API.hs view
@@ -26,6 +26,8 @@ import Prelude import Safe +import HipBot.AbsoluteURI+import HipBot.Descriptor import HipBot.Internal.Types  data HipBotAPI m = HipBotAPI
+ src/HipBot/AbsoluteURI.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE DeriveDataTypeable #-}++module HipBot.AbsoluteURI where++import Blaze.ByteString.Builder (toLazyByteString)+import Control.Monad+import qualified Data.Aeson as A+import qualified Data.ByteString.Lazy.UTF8 as LB+import Data.List (isSuffixOf)+import Data.Maybe+import Data.Monoid+import Data.String+import Data.Text (Text)+import qualified Data.Text as T+import Data.Typeable+import Network.HTTP.Types+import Network.URI (URI)+import qualified Network.URI as URI+import Prelude++newtype AbsoluteURI = AbsoluteURI URI+  deriving (Eq, Typeable)++parseAbsoluteURI :: String -> Maybe AbsoluteURI+parseAbsoluteURI = fmap AbsoluteURI . URI.parseAbsoluteURI++appendPath :: AbsoluteURI -> [Text] -> AbsoluteURI+appendPath (AbsoluteURI uri) xs = AbsoluteURI uri' where+  uri' = uri { URI.uriPath = URI.uriPath uri <> dropSlash (relPath xs) }+  dropSlash s = if "/" `isSuffixOf` URI.uriPath uri+    then tail s+    else s++relPath :: [Text] -> String+relPath = LB.toString . toLazyByteString . encodePathSegments++relativeTo :: [Text] -> AbsoluteURI -> AbsoluteURI+relativeTo xs (AbsoluteURI uri) = AbsoluteURI (URI.relativeTo rel uri) where+  rel = fromJust . URI.parseURIReference . drop 1 . relPath $ xs++instance Show AbsoluteURI where+  show (AbsoluteURI u) = show u++instance IsString AbsoluteURI where+  fromString s =+    fromMaybe (error $ "Not an absolute URI: " <> s) (parseAbsoluteURI s)++instance A.ToJSON AbsoluteURI where+  toJSON = A.toJSON . show++instance A.FromJSON AbsoluteURI where+  parseJSON = A.withText "String" $ \t ->+    maybe mzero return . parseAbsoluteURI . T.unpack $ t+
+ src/HipBot/Descriptor.hs view
@@ -0,0 +1,253 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module HipBot.Descriptor where++import Control.Applicative+import Control.Lens.TH+import Data.Aeson ((.=), (.:?), (.!=))+import qualified Data.Aeson as A+import qualified Data.Aeson.TH as A+import Data.Char+import Data.Maybe+import Data.Monoid+import Data.String+import Data.Text (Text)+import qualified Data.Text as T+import Data.Time.Clock+import Prelude++import HipBot.AbsoluteURI+import HipBot.Internal.Types++data AddOn = AddOn+  { _addOnKey :: Text+  , _addOnName :: Text+  , _addOnDescription :: Text+  , _addOnLinks :: Links+  , _addOnCapabilities :: Maybe Capabilities+  , _addOnVendor :: Maybe Vendor+  } deriving (Show, Eq)++defaultAddOn+  :: Text -- ^ key+  -> Text -- ^ name+  -> Text -- ^ description+  -> Links+  -> AddOn+defaultAddOn k n d ls = AddOn k n d ls Nothing Nothing++data Links = Links+  { _linksSelf :: AbsoluteURI+  , _linksHomepage :: Maybe AbsoluteURI+  } deriving (Show, Eq)++defaultLinks+  :: AbsoluteURI  -- ^ self+  -> Links+defaultLinks s = Links s Nothing++data Capabilities = Capabilities+  { _capabilitiesInstallable :: Maybe Installable+  , _capabilitiesHipchatApiConsumer :: Maybe APIConsumer+  , _capabilitiesOauth2Provider :: Maybe OAuth2Provider+  , _capabilitiesWebhooks :: [Webhook]+  , _capabilitiesConfigurable :: Maybe Configurable+  } deriving (Show, Eq)++defaultCapabilities :: Capabilities+defaultCapabilities = Capabilities Nothing Nothing Nothing [] Nothing++instance A.ToJSON Capabilities where+  toJSON (Capabilities is con o hs cfg) = A.object $ catMaybes+    [ ("installable" .=) <$> is+    , ("hipchatApiConsumer" .=) <$> con+    , ("oauth2Provider" .=) <$> o+    , ("webhook" .= hs) <$ listToMaybe hs+    , ("configurable" .=) <$> cfg+    ]++instance A.FromJSON Capabilities where+  parseJSON = A.withObject "object" $ \o -> Capabilities+    <$> o .:? "installable"+    <*> o .:? "hipchatApiConsumer"+    <*> o .:? "oauth2Provider"+    <*> o .:? "webhooks" .!= []+    <*> o .:? "configurable"++data Installable = Installable+  { _installableCallbackUrl :: Maybe AbsoluteURI+  , _installableAllowRoom :: Bool+  , _installableAllowGlobal :: Bool+  } deriving (Show, Eq)++instance A.ToJSON Installable where+  toJSON (Installable cb r g) = A.object $ catMaybes+    [ ("callbackUrl" .=) <$> cb+    ] <>+    [ "allowRoom" .= r+    , "allowGlobal" .= g+    ]++instance A.FromJSON Installable where+  parseJSON = A.withObject "object" $ \o -> Installable+    <$> o .:? "callbackUrl"+    <*> o .:? "allowRoom" .!= True+    <*> o .:? "allowGlobal" .!= True++defaultInstallable :: Installable+defaultInstallable = Installable Nothing True True++data APIConsumer = APIConsumer+  { _apiScopes :: [APIScope]+  , _apiFromName :: Maybe Text+  } deriving (Show, Eq)++defaultAPIConsumer :: APIConsumer+defaultAPIConsumer = APIConsumer [SendNotification] Nothing++data OAuth2Provider = OAuth2Provider+  { _oAuth2ProviderAuthorizationUrl :: AbsoluteURI+  , _oAuth2ProviderTokenUrl :: AbsoluteURI+  } deriving (Show, Eq)++data APIScope+  = AdminGroup+  | AdminRoom+  | ManageRooms+  | SendMessage+  | SendNotification+  | ViewGroup+  | ViewMessages+  deriving Eq++instance Show APIScope where+  show = apiScopeStr++instance A.ToJSON APIScope where+  toJSON = A.String . apiScopeStr++apiScopeStr :: IsString a => APIScope -> a+apiScopeStr = \case+  AdminGroup -> "admin_group"+  AdminRoom -> "admin_room"+  ManageRooms -> "manage_rooms"+  SendMessage -> "send_message"+  SendNotification -> "send_notification"+  ViewGroup -> "view_group"+  ViewMessages -> "view_messages"++instance A.FromJSON APIScope where+  parseJSON = A.withText "string" $ \case+    "admin_group" -> return AdminGroup+    "admin_room" -> return AdminRoom+    "manage_rooms" -> return ManageRooms+    "send_message" -> return SendMessage+    "send_notification" -> return SendNotification+    "view_group" -> return ViewGroup+    "view_messages" -> return ViewMessages+    s -> fail $ "unexpected API scope " <> T.unpack s++data Webhook = Webhook+  { _webhookUrl :: AbsoluteURI+  , _webhookPattern :: Maybe Text+  , _webhookEvent :: RoomEvent+  } deriving (Show, Eq)++webhook :: AbsoluteURI -> RoomEvent -> Webhook+webhook url = Webhook url Nothing++data Configurable = Configurable+  { _configurableUrl :: AbsoluteURI+  } deriving (Show, Eq)++data Vendor = Vendor+  { _vendorUrl :: AbsoluteURI+  , _vendorName :: Text+  } deriving (Show, Eq)++data Registration = Registration+  { _registrationOauthId :: OAuthId+  , _registrationCapabilitiesUrl :: AbsoluteURI+  , _registrationRoomId :: Maybe RoomId+  , _registrationGroupId :: Int+  , _registrationOauthSecret :: Text+  }++data AccessToken = AccessToken+  { _accessTokenAccessToken :: Text+  , _accessTokenExpires :: UTCTime+  }++makeFields ''AddOn+makeFields ''Links+makeFields ''Capabilities+makeFields ''Installable+makeLensesWith abbreviatedFields ''APIConsumer+makeFields ''OAuth2Provider+makeFields ''Configurable+makeFields ''Registration+makeFields ''AccessToken+makeFields ''Webhook++$(A.deriveJSON+  A.defaultOptions+     { A.fieldLabelModifier = \l -> toLower (l !! 13) : drop 14 l+     , A.omitNothingFields = True+     }+  ''Configurable)++$(A.deriveJSON+  A.defaultOptions+     { A.fieldLabelModifier = \l -> toLower (l !! 4) : drop 5 l+     , A.omitNothingFields = True+     }+  ''APIConsumer)++$(A.deriveJSON+  A.defaultOptions+     { A.fieldLabelModifier = \l -> toLower (l !! 15) : drop 16 l+     , A.omitNothingFields = True+     }+  ''OAuth2Provider)++$(A.deriveJSON+  A.defaultOptions+     { A.fieldLabelModifier = \l -> toLower (l !! 6) : drop 7 l+     , A.omitNothingFields = True+     }+  ''AddOn)++$(A.deriveJSON+  A.defaultOptions+     { A.fieldLabelModifier = \l -> toLower (l !! 6) : drop 7 l+     , A.omitNothingFields = True+     }+  ''Links)++$(A.deriveJSON+  A.defaultOptions+     { A.fieldLabelModifier = \l -> toLower (l !! 7) : drop 8 l+     , A.omitNothingFields = True+     }+  ''Vendor)++$(A.deriveJSON+  A.defaultOptions+     { A.fieldLabelModifier = \l -> toLower (l !! 8) : drop 9 l+     , A.omitNothingFields = True+     }+  ''Webhook)++$(A.deriveJSON+  A.defaultOptions+     { A.fieldLabelModifier = \l -> toLower (l !! 13) : drop 14 l+     , A.omitNothingFields = True+     }+  ''Registration)+
src/HipBot/Internal/HipBot.hs view
@@ -13,6 +13,7 @@ import Prelude  import HipBot.API+import HipBot.Descriptor import HipBot.Internal.Types  type OnUninstall m = OAuthId -> m ()
src/HipBot/Internal/OAuth.hs view
@@ -25,9 +25,10 @@ import qualified Network.Wreq as Wreq import Prelude +import HipBot.AbsoluteURI import HipBot.API+import HipBot.Descriptor import HipBot.Internal.HipBot-import HipBot.Internal.Types  data OAuthError   = MissingAccessTokenUrl Registration
src/HipBot/Internal/Resources.hs view
@@ -26,7 +26,7 @@ import HipBot.API import HipBot.Internal.HipBot import HipBot.Internal.OAuth-import HipBot.Internal.Types+import HipBot.Descriptor  hipBotResources   :: (Applicative m, MonadCatch m, MonadIO m)
src/HipBot/Internal/Types.hs view
@@ -1,202 +1,17 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}  module HipBot.Internal.Types where -import Blaze.ByteString.Builder (toLazyByteString)-import Control.Applicative-import Control.Lens.TH-import Control.Monad-import Data.Aeson ((.=), (.:?), (.!=)) import qualified Data.Aeson as A-import qualified Data.Aeson.TH as A-import qualified Data.ByteString.Lazy.UTF8 as LB-import Data.Char-import Data.List (isSuffixOf)-import Data.Maybe import Data.Monoid-import Data.String import Data.Text (Text) import qualified Data.Text as T-import Data.Time.Clock-import Data.Typeable-import Network.HTTP.Types-import Network.URI (URI)-import qualified Network.URI as URI import Prelude -newtype AbsoluteURI = AbsoluteURI URI-  deriving (Eq, Typeable)--parseAbsoluteURI :: String -> Maybe AbsoluteURI-parseAbsoluteURI = fmap AbsoluteURI . URI.parseAbsoluteURI--appendPath :: AbsoluteURI -> [Text] -> AbsoluteURI-appendPath (AbsoluteURI uri) xs = AbsoluteURI uri' where-  uri' = uri { URI.uriPath = URI.uriPath uri <> dropSlash (relPath xs) }-  dropSlash s = if "/" `isSuffixOf` URI.uriPath uri-    then tail s-    else s--relPath :: [Text] -> String-relPath = LB.toString . toLazyByteString . encodePathSegments--relativeTo :: [Text] -> AbsoluteURI -> AbsoluteURI-relativeTo xs (AbsoluteURI uri) = AbsoluteURI (URI.relativeTo rel uri) where-  rel = fromJust . URI.parseURIReference . drop 1 . relPath $ xs--instance Show AbsoluteURI where-  show (AbsoluteURI u) = show u--instance IsString AbsoluteURI where-  fromString s =-    fromMaybe (error $ "Not an absolute URI: " <> s) (parseAbsoluteURI s)--instance A.ToJSON AbsoluteURI where-  toJSON = A.toJSON . show--instance A.FromJSON AbsoluteURI where-  parseJSON = A.withText "String" $ \t ->-    maybe mzero return . parseAbsoluteURI . T.unpack $ t--data AddOn = AddOn-  { _addOnKey :: Text-  , _addOnName :: Text-  , _addOnDescription :: Text-  , _addOnLinks :: Links-  , _addOnCapabilities :: Maybe Capabilities-  , _addOnVendor :: Maybe Vendor-  } deriving (Show, Eq)--defaultAddOn-  :: Text -- ^ key-  -> Text -- ^ name-  -> Text -- ^ description-  -> Links-  -> AddOn-defaultAddOn k n d ls = AddOn k n d ls Nothing Nothing--data Links = Links-  { _linksSelf :: AbsoluteURI-  , _linksHomepage :: Maybe AbsoluteURI-  } deriving (Show, Eq)--defaultLinks-  :: AbsoluteURI  -- ^ self-  -> Links-defaultLinks s = Links s Nothing--data Capabilities = Capabilities-  { _capabilitiesInstallable :: Maybe Installable-  , _capabilitiesHipchatApiConsumer :: Maybe APIConsumer-  , _capabilitiesOauth2Provider :: Maybe OAuth2Provider-  , _capabilitiesWebhooks :: [Webhook]-  , _capabilitiesConfigurable :: Maybe Configurable-  } deriving (Show, Eq)--defaultCapabilities :: Capabilities-defaultCapabilities = Capabilities Nothing Nothing Nothing [] Nothing--instance A.ToJSON Capabilities where-  toJSON (Capabilities is con o hs cfg) = A.object $ catMaybes-    [ ("installable" .=) <$> is-    , ("hipchatApiConsumer" .=) <$> con-    , ("oauth2Provider" .=) <$> o-    , ("webhooks" .= hs) <$ listToMaybe hs-    , ("configurable" .=) <$> cfg-    ]--instance A.FromJSON Capabilities where-  parseJSON = A.withObject "object" $ \o -> Capabilities-    <$> o .:? "installable"-    <*> o .:? "hipchatApiConsumer"-    <*> o .:? "oauth2Provider"-    <*> o .:? "webhooks" .!= []-    <*> o .:? "configurable"--data Installable = Installable-  { _installableCallbackUrl :: Maybe AbsoluteURI-  , _installableAllowRoom :: Bool-  , _installableAllowGlobal :: Bool-  } deriving (Show, Eq)--instance A.ToJSON Installable where-  toJSON (Installable cb r g) = A.object $ catMaybes-    [ ("callbackUrl" .=) <$> cb-    ] <>-    [ "allowRoom" .= r-    , "allowGlobal" .= g-    ]--instance A.FromJSON Installable where-  parseJSON = A.withObject "object" $ \o -> Installable-    <$> o .:? "callbackUrl"-    <*> o .:? "allowRoom" .!= True-    <*> o .:? "allowGlobal" .!= True--defaultInstallable :: Installable-defaultInstallable = Installable Nothing True True--data APIConsumer = APIConsumer-  { _apiScopes :: [APIScope]-  , _apiFromName :: Maybe Text-  } deriving (Show, Eq)--defaultAPIConsumer :: APIConsumer-defaultAPIConsumer = APIConsumer [SendNotification] Nothing--data OAuth2Provider = OAuth2Provider-  { _oAuth2ProviderAuthorizationUrl :: AbsoluteURI-  , _oAuth2ProviderTokenUrl :: AbsoluteURI-  } deriving (Show, Eq)--data APIScope-  = AdminGroup-  | AdminRoom-  | ManageRooms-  | SendMessage-  | SendNotification-  | ViewGroup-  | ViewMessages-  deriving Eq--instance Show APIScope where-  show = apiScopeStr--instance A.ToJSON APIScope where-  toJSON = A.String . apiScopeStr--apiScopeStr :: IsString a => APIScope -> a-apiScopeStr = \case-  AdminGroup -> "admin_group"-  AdminRoom -> "admin_room"-  ManageRooms -> "manage_rooms"-  SendMessage -> "send_message"-  SendNotification -> "send_notification"-  ViewGroup -> "view_group"-  ViewMessages -> "view_messages"--instance A.FromJSON APIScope where-  parseJSON = A.withText "string" $ \case-    "admin_group" -> return AdminGroup-    "admin_room" -> return AdminRoom-    "manage_rooms" -> return ManageRooms-    "send_message" -> return SendMessage-    "send_notification" -> return SendNotification-    "view_group" -> return ViewGroup-    "view_messages" -> return ViewMessages-    s -> fail $ "unexpected API scope " <> T.unpack s--data Webhook = Webhook-  { _webhookUrl :: AbsoluteURI-  , _webhookPattern :: Maybe Text-  , _webhookEvent :: RoomEvent-  } deriving (Show, Eq)+type OAuthId = Text+type RoomId = Int+type RoomName = Text  data RoomEvent   = RoomMessage@@ -222,101 +37,4 @@     "room_enter" -> return RoomEnter     "room_topic_change" -> return RoomTopicChange     s -> fail $ "unexpected room event" <> T.unpack s--data Configurable = Configurable-  { _configurableUrl :: AbsoluteURI-  } deriving (Show, Eq)--data Vendor = Vendor-  { _vendorUrl :: AbsoluteURI-  , _vendorName :: Text-  } deriving (Show, Eq)--type OAuthId = Text-type RoomId = Int-type RoomName = Text--data Registration = Registration-  { _registrationOauthId :: OAuthId-  , _registrationCapabilitiesUrl :: AbsoluteURI-  , _registrationRoomId :: Maybe RoomId-  , _registrationGroupId :: Int-  , _registrationOauthSecret :: Text-  }--data AccessToken = AccessToken-  { _accessTokenAccessToken :: Text-  , _accessTokenExpires :: UTCTime-  }--data Notification-  = TextNotification Text-  | HtmlNotification Text-  deriving (Show, Typeable)--makeFields ''AddOn-makeFields ''Links-makeFields ''Capabilities-makeFields ''Installable-makeLensesWith abbreviatedFields ''APIConsumer-makeFields ''OAuth2Provider-makeFields ''Configurable-makeFields ''Registration-makeFields ''AccessToken--$(A.deriveJSON-  A.defaultOptions-     { A.fieldLabelModifier = \l -> toLower (l !! 13) : drop 14 l-     , A.omitNothingFields = True-     }-  ''Configurable)--$(A.deriveJSON-  A.defaultOptions-     { A.fieldLabelModifier = \l -> toLower (l !! 4) : drop 5 l-     , A.omitNothingFields = True-     }-  ''APIConsumer)--$(A.deriveJSON-  A.defaultOptions-     { A.fieldLabelModifier = \l -> toLower (l !! 15) : drop 16 l-     , A.omitNothingFields = True-     }-  ''OAuth2Provider)--$(A.deriveJSON-  A.defaultOptions-     { A.fieldLabelModifier = \l -> toLower (l !! 6) : drop 7 l-     , A.omitNothingFields = True-     }-  ''AddOn)--$(A.deriveJSON-  A.defaultOptions-     { A.fieldLabelModifier = \l -> toLower (l !! 6) : drop 7 l-     , A.omitNothingFields = True-     }-  ''Links)--$(A.deriveJSON-  A.defaultOptions-     { A.fieldLabelModifier = \l -> toLower (l !! 7) : drop 8 l-     , A.omitNothingFields = True-     }-  ''Vendor)--$(A.deriveJSON-  A.defaultOptions-     { A.fieldLabelModifier = \l -> toLower (l !! 7) : drop 8 l-     , A.omitNothingFields = True-     }-  ''Webhook)--$(A.deriveJSON-  A.defaultOptions-     { A.fieldLabelModifier = \l -> toLower (l !! 13) : drop 14 l-     , A.omitNothingFields = True-     }-  ''Registration)
+ src/HipBot/Notification.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module HipBot.Notification where++import Control.Lens hiding ((.=))+import Data.Aeson ((.=))+import qualified Data.Aeson as A+import Data.Monoid+import Data.Text (Text)+import Data.Typeable+import Prelude++data NotificationColor+  = Yellow+  | Green+  | Red+  | Purple+  | Gray+  | Random+  deriving (Show, Eq, Typeable)++instance A.ToJSON NotificationColor where+  toJSON = \case+    Yellow -> "yellow"+    Green -> "green"+    Red -> "red"+    Purple -> "purple"+    Gray -> "gray"+    Random -> "random"++data NotificationMessage+  = TextNotification Text+  | HtmlNotification Text+  deriving (Show, Eq, Typeable)++data Notification = Notification+  { _notificationColor :: Maybe NotificationColor+  , _notificationNotify :: Bool+  , _notificationMessage :: NotificationMessage+  } deriving (Show, Eq, Typeable)++makeFields ''Notification++instance A.ToJSON Notification where+  toJSON n =+    let+      c = case n ^. color of+        Just x | x /= Yellow -> [ "color" .= x ]+        _ -> []+      nu =  [ "notify" .= True | n ^. notify ]+      m = case n ^. message of+        TextNotification t ->+          [ "message_format" .= ("text" :: Text)+          , "message" .= t+          ]+        HtmlNotification t ->+          [ "message_format" .= ("html" :: Text)+          , "message" .= t+          ]+    in+      A.object (c <> nu <> m)++defaultNotification :: NotificationMessage -> Notification+defaultNotification = Notification Nothing False++textNotification :: Text -> Notification+textNotification = defaultNotification . TextNotification++htmlNotification :: Text -> Notification+htmlNotification = defaultNotification . HtmlNotification+
+ src/HipBot/Webhooks.hs view
@@ -0,0 +1,177 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module HipBot.Webhooks+  ( RoomLinks(..)+  , Room(..)+  , MessageItem(..)+  , WebhookRoomItem(..)+  , WebhookRoomEvent(..)+  , HasMembers(..)+  , HasParticipants(..)+  , HasSelf(..)+  , HasWebhooks(..)+  , HasRoomId(..)+  , HasName(..)+  , HasLinks(..)+  , HasMessage(..)+  , HasWebhookId(..)+  , HasOauthId(..)+  , HasItem(..)+  , decodeWebhookRoomEvent+  , webhookResource+  , roomMessageWebhookResource+  , simpleWebhookResource+  ) where++import Control.Applicative+import Control.Lens hiding ((.=))+import Control.Monad.Reader+import Control.Monad.State+import Data.Aeson ((.:), (.:?))+import qualified Data.Aeson as A+import qualified Data.Aeson.TH as A+import qualified Data.Aeson.Types as A+import Data.Char (toLower)+import Data.Foldable+import Data.Maybe+import Data.Monoid+import Data.Text (Text)+import qualified Data.Text as T+import qualified Network.Wai as Wai+import Prelude hiding (foldl1)++import Webcrank+import Webcrank.Wai++import HipBot.AbsoluteURI+import HipBot.Internal.Types+import HipBot.Notification++data RoomLinks = RoomLinks+  { _roomLinksMembers :: Maybe AbsoluteURI+  , _roomLinksParticipants :: AbsoluteURI+  , _roomLinksSelf :: AbsoluteURI+  , _roomLinksWebhooks :: AbsoluteURI+  } deriving (Show, Eq)++makeFields ''RoomLinks++data Room = Room+  { _roomRoomId :: RoomId+  , _roomName :: RoomName+  , _roomLinks :: RoomLinks+  } deriving (Show, Eq)++makeFields ''Room++instance A.FromJSON Room where+  parseJSON = A.withObject "object" $ \o -> Room+    <$> o .: "id"+    <*> o .: "name"+    <*> o .: "links"++data MessageItem = MessageItem+  { _messageItemMessage :: Text+  } deriving (Show, Eq)++makeFields ''MessageItem++data WebhookRoomItem+  = WebhookRoomMessage Room MessageItem+  --  WebhookRoomArchived+  --  WebhookRoomDeleted+  --  WebhookRoomEnter+  --  WebhookRoomExit+  --  WebhookRoomNotification+  --  WebhookRoomTopicChange+  --  WebhookRoomUnarchived+  deriving (Show, Eq)++data WebhookRoomEvent = WebhookRoomEvent+  { _webhookRoomEventWebhookId :: Int+  , _webhookRoomEventOauthId :: Maybe String+  , _webhookRoomEventItem :: WebhookRoomItem+  } deriving (Show, Eq)++makeFields ''WebhookRoomEvent++instance A.FromJSON WebhookRoomEvent where+  parseJSON = A.withObject "object" $ \o -> WebhookRoomEvent+    <$> o .: "webhook_id"+    <*> o .:? "oauth_client_id"+    <*> readItem o++readItem :: A.Object -> A.Parser WebhookRoomItem+readItem o = do+  oi <- o .: "item"+  o .: "event" >>= \case+    RoomMessage -> WebhookRoomMessage <$> oi .: "room" <*> oi .: "message"+    _ -> A.typeMismatch "only supports room_message events at this time" (A.Object o)++decodeWebhookRoomEvent :: (Functor m, MonadIO m, MonadReader s m, HasRequest s Wai.Request) => m (Either String WebhookRoomEvent)+decodeWebhookRoomEvent = A.eitherDecode <$> getRequestBodyLBS++$(A.deriveFromJSON+  A.defaultOptions+     { A.fieldLabelModifier = \l -> toLower (l !! 10) : drop 11 l+     , A.omitNothingFields = True+     }+  ''RoomLinks)++$(A.deriveFromJSON+  A.defaultOptions+     { A.fieldLabelModifier = \l -> toLower (l !! 12) : drop 13 l+     , A.omitNothingFields = True+     }+  ''MessageItem)++webhookResource+  :: (MonadIO m, MonadReader r m, HasRequest r Wai.Request, MonadState s m, HasReqData s)+  => String -- ^ webhook name+  -> (WebhookRoomEvent -> HaltT m (Maybe Notification)) -- ^ event processor+  -> Resource m+webhookResource hookName f = resource+  { allowedMethods = return [ methodPost ]+  , postAction = postProcess $+      decodeWebhookRoomEvent >>= \case+        Left e -> liftIO . putStrLn . mconcat $+          [ "[ERROR] Failed to parse event to "+          , hookName+          , " webhook: "+          , e+          ]+        Right ev -> f ev >>= traverse_ (writeLBS . A.encode)+  }++roomMessageWebhookResource+  :: (MonadIO m, MonadReader r m, MonadState s m, HasReqData s, HasRequest r Wai.Request)+  => String+  -> (Room -> MessageItem -> HaltT m (Maybe Notification))+  -> Resource m+roomMessageWebhookResource hookName f = webhookResource hookName $ \ev ->+  case ev ^. item of+    WebhookRoomMessage room msg -> f room msg++-- | Creates a simple "command" processing webhook resource.+-- Commands processes are limited to pure functions that may+-- or may not produce a reply.+simpleWebhookResource+  :: MonadIO m+  => String -- ^ webhook name+  -> [Text] -- ^ command aliases, they will be removed before calling the processing function+  -> (Text -> Maybe Text) -- ^ processing function, the result will become a room notification+  -> WaiResource m+simpleWebhookResource hookName aliases f =+  let+    expr t = T.strip <$> foldl1 (<|>) (fmap (`T.stripPrefix` t) aliases)+    command = views message (return . fmap textNotification . (f =<<) . expr)+  in+    roomMessageWebhookResource hookName (const command)+