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
-> Text
-> Text
-> 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
-> 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)