packages feed

hipchat-hs 0.0.2 → 0.0.3

raw patch · 34 files changed

+1204/−710 lines, 34 filesdep +aeson-casingdep +http-clientdep +network-uridep ~aesondep ~servantdep ~servant-client

Dependencies added: aeson-casing, http-client, network-uri

Dependency ranges changed: aeson, servant, servant-client

Files

hipchat-hs.cabal view
@@ -1,5 +1,5 @@ name:                hipchat-hs-version:             0.0.2+version:             0.0.3 synopsis:            Hipchat API bindings in Haskell description:         Hipchat API bindings in Haskell  license:             BSD3@@ -16,33 +16,44 @@   location: https://github.com/oswynb/hipchat-hs  library-  exposed-modules:     Network.Hipchat.Client-                       Network.Hipchat.Types.API-                       Network.Hipchat.Types.Common-                       Network.Hipchat.Types.Extensions-                       Network.Hipchat.Types.Rooms-                       Network.Hipchat.Types.Rooms.CreateRoomRequest-                       Network.Hipchat.Types.Rooms.CreateRoomResponse-                       Network.Hipchat.Types.Rooms.CreateWebhookRequest-                       Network.Hipchat.Types.Rooms.CreateWebhookResponse-                       Network.Hipchat.Types.Rooms.GetAllMembersResponse-                       Network.Hipchat.Types.TokenRequest-                       Network.Hipchat.Types.TokenResponse-                       Network.Hipchat.Types.User-  -- other-modules:       +  exposed-modules:     HipChat.Client+                       HipChat.Types.API+                       HipChat.Types.Auth+                       HipChat.Types.Common+                       HipChat.Types.Dialog+                       HipChat.Types.Extensions+                       HipChat.Types.Glance+                       HipChat.Types.Icon+                       HipChat.Types.Key+                       HipChat.Types.Name+                       HipChat.Types.Rooms+                       HipChat.Types.User+                       HipChat.Types.WebPanel+                       -- Rooms+                       HipChat.Types.Rooms.CreateRoomRequest+                       HipChat.Types.Rooms.CreateRoomResponse+                       HipChat.Types.Rooms.CreateWebhookRequest+                       HipChat.Types.Rooms.CreateWebhookResponse+                       HipChat.Types.Rooms.GetAllMembersResponse+                       HipChat.Types.Rooms.GetAllRoomsResponse+                       -- Other+                       HipChat.Types.RoomAddonUIUpdateRequest   -- other-extensions:       build-depends:       base >= 4.8 && < 4.9-                     , aeson+                     , aeson >= 0.11+                     , aeson-casing                      , async                      , bytestring                      , either+                     , http-client                      , lens-                     , servant-                     , servant-client+                     , network-uri >= 2.6+                     , servant >= 0.6+                     , servant-client >= 0.6                      , split                      , string-conversions                      , text                      , time   hs-source-dirs:      lib-  ghc-options:         -threaded -rtsopts -with-rtsopts=-N -Wall+  ghc-options:         -rtsopts -with-rtsopts=-N -Wall   default-language:    Haskell2010
+ lib/HipChat/Client.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE DataKinds         #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators     #-}++module HipChat.Client where++import           Data.Proxy+import           Servant.API+import           Servant.Client++import           HipChat.Types.API++hipChatAPI :: Proxy HipChatAPI+hipChatAPI = Proxy++(sendMessage :<|> createRoom :<|> getRoomStatistics :<|> viewUser :<|> createWebhook :<|> getAllMembers :<|> roomAddonUIUpdate :<|> generateToken) = client hipChatAPI
+ lib/HipChat/Types/API.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE DataKinds     #-}+{-# LANGUAGE TypeOperators #-}++module HipChat.Types.API where++import           Data.Text                              (Text)++import           Servant.API++import           HipChat.Types.Auth+import           HipChat.Types.Common+import           HipChat.Types.RoomAddonUIUpdateRequest+import           HipChat.Types.Rooms+import           HipChat.Types.User++type HipChatAPI = TokenAuth(+       SendMessage+  :<|> CreateRoom+  :<|> GetRoomStatistics+  :<|> ViewUser+  :<|> CreateWebhook+  :<|> GetAllMembers+  :<|> RoomAddonUIUpdate+  :<|> GenerateToken)++type GenerateToken =+    "v2" :> "oauth" :> "token"+  :> ReqBody '[JSON] TokenRequest+  :> BasicAuth "oauth" Int+  :> Post '[JSON] TokenResponse++type ViewUser =+    "v2" :> "user"+ :> Capture "id_or_email" Text+ :> Get '[JSON] User++--------------------------------------------------------------------------------+--+-- Rooms++type CreateRoom =+    "v2" :> "room"+ :> ReqBody '[JSON] CreateRoomRequest+ :> Post '[JSON] CreateRoomResponse++type CreateWebhook =+    "v2" :> "room"+ :> Capture "room_id_or_name" IdOrName+ :> "extension"+ :> "webhook"+ :> Capture "key" WebhookKey+ :> ReqBody '[JSON] CreateWebhookRequest+ :> Put '[JSON] CreateWebhookResponse++type SendMessage =+    "v2" :> "room"+ :> Capture "room" Text+ :> "message"+ :> ReqBody '[JSON] Message+ :> Post '[JSON] SendMessageResponse++type GetRoomStatistics =+    "v2" :> "room"+ :> Capture "room" Text+ :> "statistics"+ :> Get '[JSON] RoomStatistics++type GetAllMembers =+    "v2" :> "room"+  :> Capture "room_id_or_name" IdOrName+  :> "member"+  :> QueryParam "start-index" Int+  :> QueryParam "max-results" Int+  :> Get '[JSON] GetAllMembersResponse++type GetAllRooms =+    "v2" :> "room"+  :> QueryParam "start-index" Int+  :> QueryParam "max-results" Int+  :> QueryParam "include-private" Bool+  :> QueryParam "include-archived" Bool+  :> Get '[JSON] GetAllRoomsResponse++--------------------------------------------------------------------------------++-- Addons++type RoomAddonUIUpdate =+    "v2" :> "addon" :> "ui" :> "room"+  :> Capture "room_id" Int+  :> ReqBody '[JSON] RoomAddonUIUpdateRequest+  :> PostNoContent '[JSON] NoContent
+ lib/HipChat/Types/Auth.hs view
@@ -0,0 +1,171 @@+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE OverloadedStrings #-}++module HipChat.Types.Auth where++import           Control.Lens+import           Control.Monad+import           Data.Aeson+import           Data.Aeson.Casing+import           Data.Aeson.Types+import           Data.Monoid+import           Data.Text         (Text)+import qualified Data.Text         as T+import           Data.Time+import           GHC.Generics++--------------------------------------------------------------------------------++-- Scopes++data APIScope+  = AdminGroup+  | AdminRoom+  | ManageRooms+  | SendMessage+  | SendNotification+  | ViewGroup+  | ViewMessages+  deriving Eq++instance Show APIScope where+  show = T.unpack . (^. re apiScope)++instance ToJSON APIScope where+  toJSON = String . (^. re apiScope)++instance FromJSON APIScope where+  parseJSON = withText "Scope" $ \t -> case t ^? apiScope of+    Nothing -> fail (T.unpack t)+    Just s  -> return s++apiScope :: Prism' Text APIScope+apiScope = prism' enc dec+  where+    enc = \case+      AdminGroup       -> "admin_group"+      AdminRoom        -> "admin_room"+      ManageRooms      -> "manage_rooms"+      SendMessage      -> "send_message"+      SendNotification -> "send_notification"+      ViewGroup        -> "view_group"+      ViewMessages     -> "view_messages"+    dec = \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++newtype ScopeList = ScopeList [APIScope]+  deriving (Show, Eq)++instance ToJSON ScopeList where+  toJSON (ScopeList ts) = String (T.intercalate " " $ map (^. re apiScope) ts)++instance FromJSON ScopeList where+  parseJSON = withText "ScopeList" $ \s -> do+    let rawScopes = T.splitOn " " s+    scopes <- forM rawScopes $ \scope -> case scope ^? apiScope of+      Nothing -> fail "invalid scope"+      Just scope' -> return scope'+    return $ ScopeList scopes++--------------------------------------------------------------------------------++-- HipChat API Consumer++data APIConsumer = APIConsumer+  { apiAvatar   :: Maybe Text+  , apiFromName :: Maybe Text+  , apiScopes   :: [APIScope]+  } deriving (Generic, Show, Eq)++defaultAPIConsumer :: APIConsumer+defaultAPIConsumer = APIConsumer Nothing Nothing [SendNotification]++adminConsumer :: APIConsumer+adminConsumer = APIConsumer Nothing Nothing [AdminRoom]++instance ToJSON APIConsumer where+  toJSON = genericToJSON (aesonPrefix camelCase){omitNothingFields = True}++instance FromJSON APIConsumer where+  parseJSON = genericParseJSON $ aesonPrefix camelCase++clientCredentialsRequest :: Maybe Text -> TokenRequest+clientCredentialsRequest user =+  TokenRequest user ClientCredentials Nothing Nothing Nothing Nothing (Just $ ScopeList [SendNotification]) Nothing Nothing Nothing++data AccessToken = AccessToken+  { accessTokenAccessToken :: Text+  , accessTokenExpires     :: UTCTime+  } deriving (Generic, Show, Eq)++data GrantType = AuthorizationCode+               | RefreshToken+               | Password+               | ClientCredentials+               | Personal+               | RoomNotification++instance Show GrantType where+  show = show . (^. re grantType)++grantType :: Prism' Text GrantType+grantType = prism' enc dec+  where+    enc = \case+      AuthorizationCode -> "authorization_code"+      RefreshToken      -> "refresh_token"+      Password          -> "password"+      ClientCredentials -> "client_credentials"+      Personal          -> "personal"+      RoomNotification  -> "room_notification"+    dec = \case+      "authorization_code" -> Just AuthorizationCode+      "refresh_token"      -> Just RefreshToken+      "password"           -> Just Password+      "client_credentials" -> Just ClientCredentials+      "personal"           -> Just Personal+      "room_notification"  -> Just RoomNotification+      _                    -> Nothing++instance ToJSON GrantType where+  toJSON = toJSON . (^. re grantType)++data TokenRequest = TokenRequest+  { trUsername     :: Maybe Text+  , trGrantType    :: GrantType+  , trUserId       :: Maybe Text+  , trCode         :: Maybe Text+  , trClientName   :: Maybe Text+  , trRedirectUri  :: Maybe Text+  , trScope        :: Maybe ScopeList+  , trPassword     :: Maybe Text+  , trGroupId      :: Maybe Text+  , trRefreshToken :: Maybe Text+  } deriving (Generic, Show)++instance ToJSON TokenRequest where+  toJSON = genericToJSON $ aesonPrefix snakeCase++tokenRequest :: GrantType -> TokenRequest+tokenRequest gt = TokenRequest Nothing gt Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing++data TokenResponse = TokenResponse+  { trsAccessToken  :: Text+  , trsExpiresIn    :: Int+  , trsGroupName    :: Text+  , trsTokenType    :: Text+  , trsScope        :: ScopeList+  , trsGroupId      :: Int+  , trsRefreshToken :: Maybe Text+  } deriving (Generic, Show)++instance FromJSON TokenResponse where+  parseJSON = genericParseJSON $ aesonPrefix snakeCase
+ lib/HipChat/Types/Common.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE DataKinds                  #-}+{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE TypeOperators              #-}++module HipChat.Types.Common+  ( IdOrName(..)+  , Link(..)+  , PaginatedLink(..)+  , RoomEvent(..)+  , Token(..)+  , TokenAuth+  , WebhookAuth(..)+  ) where++import           Data.Aeson+import           Data.Aeson.Casing+import           Data.Aeson.Types+import           Data.Monoid+import           Data.String+import           Data.Text         (Text)+import           GHC.Generics+import           Servant.API++data RoomEvent = RoomArchived+               | RoomCreated+               | RoomDeleted+               | RoomEnter+               | RoomExit+               | RoomFileUpload+               | RoomMessage+               | RoomNotification+               | RoomTopicChange+               | RoomUnarchived+  deriving (Eq, Generic, Show)++instance ToJSON RoomEvent where+  toJSON = genericToJSON defaultOptions{constructorTagModifier=camelTo2 '_'}++instance FromJSON RoomEvent where+  parseJSON = genericParseJSON defaultOptions{constructorTagModifier=camelTo2 '_'}+data Link = Link+  { linkSelf :: Text+  } deriving (Generic, Show)++instance FromJSON Link where+  parseJSON = genericParseJSON $ aesonPrefix snakeCase++data PaginatedLink = PaginatedLink+  { paginatedSelf :: Text+  , paginatedPrev :: Maybe Text+  , paginatedNext :: Maybe Text+  } deriving (Generic, Show)++instance FromJSON PaginatedLink where+  parseJSON = genericParseJSON $ aesonPrefix snakeCase++data WebhookAuth = JWT+                 | None+  deriving (Generic, Show)++instance ToJSON WebhookAuth where+  toJSON JWT  = String "jwt"+  toJSON None = String "none"++-- | Auth Token+newtype Token = Token Text+  deriving (Show, IsString)++instance ToHttpApiData Token where+  toQueryParam (Token tok) = "Bearer " <> tok++type family TokenAuth a where+  TokenAuth (x :<|> y) = TokenAuth x :<|> TokenAuth y+  TokenAuth x = Header "Authorization" Token :> x++newtype IdOrName = IdOrName Text+  deriving (Generic, Show, IsString, ToHttpApiData)++instance FromJSON IdOrName
+ lib/HipChat/Types/Dialog.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE LambdaCase            #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}++module HipChat.Types.Dialog where++import           Data.Aeson+import           Data.Aeson.Casing+import           Data.Aeson.Types+import           Data.Text          (Text)+import           GHC.Generics++import           HipChat.Types.Name++data Dialog = Dialog+  { dialogKey     :: Text+  , dialogTitle   :: Name+  , dialogUrl     :: Text+  , dialogOptions :: Maybe DialogOptions+  } deriving (Show, Eq, Generic)++defaultDialog :: Text -> Name -> Text -> Dialog+defaultDialog k t u = Dialog k t u Nothing++instance ToJSON Dialog where+  toJSON = genericToJSON $ aesonPrefix camelCase++instance FromJSON Dialog where+  parseJSON = genericParseJSON $ aesonPrefix camelCase++data DialogStyle = Normal | Warning+  deriving (Show, Eq)++instance ToJSON DialogStyle where+  toJSON Normal = "normal"+  toJSON Warning = "warning"++instance FromJSON DialogStyle where+  parseJSON (String "normal") = return Normal+  parseJSON (String "warning") = return Warning+  parseJSON (String text) = fail ("Unexpected style string: " ++ show text)+  parseJSON x = typeMismatch "Invalid style" x++data DialogOptions = DialogOptions+  { dialogoptionsStyle            :: Maybe DialogStyle+  , dialogoptionsPrimaryAction    :: Maybe DialogAction+  , dialogoptionsSecondaryActions :: Maybe [DialogAction]+  , dialogoptionsSize             :: Maybe DialogSize+  , dialogoptionsHint             :: Maybe Name+  , dialogoptionsFilter           :: Maybe DialogFilter+  } deriving (Show, Eq, Generic)++instance ToJSON DialogOptions where+  toJSON = genericToJSON $ aesonPrefix camelCase++instance FromJSON DialogOptions where+  parseJSON = genericParseJSON $ aesonPrefix camelCase++defaultDialogOptions :: DialogOptions+defaultDialogOptions = DialogOptions Nothing Nothing Nothing Nothing Nothing Nothing++data DialogAction = DialogAction+  { dialogactionName    :: Name+  , dialogactionEnabled :: Bool+  , dialogactionKey     :: Maybe Text+  } deriving (Show, Eq, Generic)++instance ToJSON DialogAction where+  toJSON = genericToJSON $ aesonPrefix camelCase++instance FromJSON DialogAction where+  parseJSON = genericParseJSON $ aesonPrefix camelCase++data DialogSize = DialogSize+  { dialogsizeHeight :: Text -- Either 'px' or '%'+  , dialogsizeWidth  :: Text -- Either 'px' or '%'+  } deriving (Show, Eq, Generic)++instance ToJSON DialogSize where+  toJSON = genericToJSON $ aesonPrefix camelCase++instance FromJSON DialogSize where+  parseJSON = genericParseJSON $ aesonPrefix camelCase++data DialogFilter = DialogFilter+  { dialogfilterPlaceholder :: Name+  } deriving (Show, Eq, Generic)++instance ToJSON DialogFilter where+  toJSON = genericToJSON $ aesonPrefix camelCase++instance FromJSON DialogFilter where+  parseJSON = genericParseJSON $ aesonPrefix camelCase
+ lib/HipChat/Types/Extensions.hs view
@@ -0,0 +1,235 @@+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE OverloadedStrings #-}++module HipChat.Types.Extensions where++import           Data.Aeson+import           Data.Aeson.Casing+import           Data.Aeson.Types+import           Data.Maybe+import           Data.Monoid+import           Data.Text              (Text)+import           GHC.Generics++import           HipChat.Types.Auth+import           HipChat.Types.Common+import           HipChat.Types.Dialog+import           HipChat.Types.Glance+import           HipChat.Types.WebPanel++data CapabilitiesAdminPage = CapabilitiesAdminPage+  { capUrl :: Text+  } deriving (Generic, Show)++instance ToJSON CapabilitiesAdminPage where+  toJSON = genericToJSON $ aesonPrefix snakeCase++instance FromJSON CapabilitiesAdminPage where+  parseJSON = genericParseJSON $ aesonPrefix snakeCase++--------------------------------------------------------------------------------++-- Installable++data Installable = Installable+  { -- | The URL to receive a confirmation of an integration installation. The message will be an HTTP POST with the+    --   following fields in a JSON-encoded body: 'capabilitiesUrl', 'oauthId', 'oauthSecret', and optionally 'roomId'.+    --   The installation of the integration will only succeed if the POST response is a 200.+    installableCallbackUrl :: Maybe Text+  , installableAllowRoom   :: Bool+  , installableAllowGlobal :: Bool+  } deriving (Show, Eq)++instance ToJSON Installable where+  toJSON (Installable cb r g) = object $ catMaybes+    [ ("callbackUrl" .=) <$> cb+    ] <>+    [ "allowRoom" .= r+    , "allowGlobal" .= g+    ]++instance FromJSON Installable where+  parseJSON = withObject "object" $ \o -> Installable+    <$> o .:? "callbackUrl"+    <*> o .:? "allowRoom" .!= True+    <*> o .:? "allowGlobal" .!= True++defaultInstallable :: Installable+defaultInstallable = Installable Nothing True True++--------------------------------------------------------------------------------++-- Capabilities++data Capabilities = Capabilities+  { capabilitiesInstallable        :: Maybe Installable+  , capabilitiesHipchatApiConsumer :: Maybe APIConsumer+  , capabilitiesOauth2Provider     :: Maybe OAuth2Provider+  , capabilitiesWebhooks           :: [Webhook]+  , capabilitiesConfigurable       :: Maybe Configurable+  , capabilitiesDialog             :: [Dialog]+  , capabilitiesWebPanel           :: [WebPanel]+  , capabilitiesGlance             :: [Glance]+  } deriving (Show, Eq)++defaultCapabilities :: Capabilities+defaultCapabilities = Capabilities Nothing Nothing Nothing [] Nothing [] [] []++instance ToJSON Capabilities where+  toJSON (Capabilities is con o hs cfg dlg wp gl) = object $ catMaybes+    [ ("installable" .=) <$> is+    , ("hipchatApiConsumer" .=) <$> con+    , ("oauth2Provider" .=) <$> o+    , ("webhook" .=) <$> excludeEmptyList hs+    , ("configurable" .=) <$> cfg+    , ("dialog" .=) <$> excludeEmptyList dlg+    , ("webPanel" .=) <$> excludeEmptyList wp+    , ("glance" .=) <$> excludeEmptyList gl+    ]++excludeEmptyList :: [a] -> Maybe [a]+excludeEmptyList [] = Nothing+excludeEmptyList xs = Just xs++instance FromJSON Capabilities where+  parseJSON = withObject "object" $ \o -> Capabilities+    <$> o .:? "installable"+    <*> o .:? "hipchatApiConsumer"+    <*> o .:? "oauth2Provider"+    <*> o .:? "webhooks" .!= []+    <*> o .:? "configurable"+    <*> o .:? "dialog" .!= []+    <*> o .:? "webpanel" .!= []+    <*> o .:? "glance" .!= []++++--------------------------------------------------------------------------------+++data CapabilitiesLinks = CapabilitiesLinks+  { clHomepage :: Maybe Text+  , clSelf     :: Text+  } deriving (Generic, Eq, Show)++defaultCapabilitiesLinks :: Text -> CapabilitiesLinks+defaultCapabilitiesLinks = CapabilitiesLinks Nothing++instance ToJSON CapabilitiesLinks where+  toJSON = genericToJSON (aesonPrefix camelCase){omitNothingFields = True}++instance FromJSON CapabilitiesLinks where+  parseJSON = genericParseJSON $ aesonPrefix camelCase++--------------------------------------------------------------------------------++-- Vendor++data Vendor = Vendor+  { vendorUrl  :: Text+  , vendorName :: Text+  } deriving (Generic, Show, Eq)++instance ToJSON Vendor where+  toJSON = genericToJSON $ aesonPrefix camelCase++instance FromJSON Vendor where+  parseJSON = genericParseJSON $ aesonPrefix camelCase++--------------------------------------------------------------------------------++data CapabilitiesDescriptor = CapabilitiesDescriptor+  { capabilitiesDescriptorApiVersion   :: Maybe Text+  , capabilitiesDescriptorCapabilities :: Maybe Capabilities+  , capabilitiesDescriptorDescription  :: Text+  , capabilitiesDescriptorKey          :: Text+  , capabilitiesDescriptorLinks        :: CapabilitiesLinks+  , capabilitiesDescriptorName         :: Text+  , capabilitiesDescriptorVendor       :: Maybe Vendor+  } deriving (Generic, Show)++capabilitiesDescriptor :: Text -> Text -> CapabilitiesLinks -> Text -> CapabilitiesDescriptor+capabilitiesDescriptor desc key links name = CapabilitiesDescriptor Nothing Nothing desc key links name Nothing++instance ToJSON CapabilitiesDescriptor where+  toJSON = genericToJSON (aesonDrop 22 camelCase){omitNothingFields = True}++instance FromJSON CapabilitiesDescriptor where+  parseJSON = genericParseJSON $ aesonDrop 22 camelCase++--------------------------------------------------------------------------------++data Webhook = Webhook+  { webhookUrl     :: Text+  , webhookPattern :: Maybe Text+  , webhookEvent   :: RoomEvent+  } deriving (Generic, Show, Eq)++instance ToJSON Webhook where+  toJSON = genericToJSON $ aesonPrefix camelCase++instance FromJSON Webhook where+  parseJSON = genericParseJSON $ aesonPrefix camelCase++webhook :: Text -> RoomEvent -> Webhook+webhook url = Webhook url Nothing++--------------------------------------------------------------------------------++data OAuth2Provider = OAuth2Provider+  { oauth2ProviderAuthorizationUrl :: Text+  , oauth2ProviderTokenUrl         :: Text+  } deriving (Generic, Show, Eq)++instance ToJSON OAuth2Provider where+  toJSON = genericToJSON $ aesonPrefix camelCase++instance FromJSON OAuth2Provider where+  parseJSON = genericParseJSON $ aesonDrop 14 camelCase++--------------------------------------------------------------------------------++data Configurable = Configurable+  { configurableUrl :: Text+  } deriving (Generic, Show, Eq)++instance ToJSON Configurable where+  toJSON = genericToJSON $ aesonPrefix camelCase++instance FromJSON Configurable where+  parseJSON = genericParseJSON $ aesonPrefix camelCase++--------------------------------------------------------------------------------++data Registration = Registration+  { registrationOauthId         :: Text+  , registrationCapabilitiesUrl :: Text+  , registrationRoomId          :: Maybe Int+  , registrationGroupId         :: Int+  , registrationOauthSecret     :: Text+  } deriving (Generic, Show, Eq, Ord)++instance FromJSON Registration where+  parseJSON = genericParseJSON $ aesonPrefix camelCase++--------------------------------------------------------------------------------++data AddOn = AddOn+  { addOnKey          :: Text+  , addOnName         :: Text+  , addOnDescription  :: Text+  , addOnLinks        :: CapabilitiesLinks+  , addOnCapabilities :: Maybe Capabilities+  , addOnVendor       :: Maybe Vendor+  } deriving (Generic, Show, Eq)++defaultAddOn+  :: Text -- ^ key+  -> Text -- ^ name+  -> Text -- ^ description+  -> CapabilitiesLinks+  -> AddOn+defaultAddOn k n d ls = AddOn k n d ls Nothing Nothing++--------------------------------------------------------------------------------
+ lib/HipChat/Types/Glance.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE OverloadedStrings #-}++module HipChat.Types.Glance where++-- https://www.hipchat.com/docs/apiv2/glances++import           Data.Aeson+import           Data.Aeson.Casing+import           Data.Aeson.Types+import           Data.Text          (Text)+import           GHC.Generics++import           HipChat.Types.Icon+import           HipChat.Types.Key+import           HipChat.Types.Name++-- TODO make compound+data GlanceTarget = GlanceKey Text -- ^ The key of a dialog, glance or web panel that should  be opened in response to this action. Valid length range: 1 - 40.+                  | GlanceTarget Key+  deriving (Eq, Generic, Show)++instance ToJSON GlanceTarget where+  toJSON (GlanceKey x) = String x+  toJSON (GlanceTarget x) = object ["key" .= x]++instance FromJSON GlanceTarget where+  parseJSON (String x) = pure (GlanceKey x)+  parseJSON (Object x) = GlanceTarget <$> x .: "key"+  parseJSON x = typeMismatch "GlanceTarget" x++data Glance = Glance+  { glanceIcon     :: Icon               -- ^ Icon to display on the left side of the glance.+  , glanceKey      :: Key                -- ^ Unique key (in the context of the integration) to identify this glance. Valid length range: 1 - 40.+  , glanceName     :: Name               -- ^ The display name of the glance.+  , glanceQueryUrl :: Maybe Text         -- ^ The URL of the resource providing the glance content.+  , glanceTarget   :: Maybe GlanceTarget -- ^ Defines the behaviour when clicking on the glance.+  , glanceWeight   :: Maybe Integer      -- ^ Determines the order in which glances appear. Glances are displayed top to bottom in order of ascending weight. Defaults to 100.+  } deriving (Eq, Generic, Show)++data GlanceData = GlanceData+  { glanceDataLabel  :: GlanceDataLabel+  , glanceDataStatus :: Maybe GlanceDataStatus+  } deriving (Eq, Generic, Show)++instance ToJSON GlanceData where+  toJSON = genericToJSON $ aesonDrop 10 camelCase++data GlanceUpdate = GlanceUpdate+  { glanceUpdateContent :: GlanceData+  , glanceUpdateKey     :: GlanceTarget+  } deriving (Eq, Generic, Show)++instance ToJSON GlanceUpdate where+  toJSON = genericToJSON $ aesonDrop 12 camelCase++newtype GlanceDataLabel = GlanceDataLabel Text+  deriving (Eq, Show)++instance ToJSON GlanceDataLabel where+  toJSON (GlanceDataLabel val) = object [ "type" .= ("html" :: Text), "value" .= val ]++data GlanceDataStatus = GlanceLozenge Text LozengeType+                      | GlanceIcon Icon+  deriving (Eq, Show)++instance ToJSON GlanceDataStatus where+  toJSON (GlanceLozenge label ty) =+    let lozengeObj = object ["label" .= label, "type" .= ty]+    in object [ "type" .= ("lozenge" :: Text), "value" .= lozengeObj]+  toJSON (GlanceIcon icon) = object ["type" .= ("icon" :: Text), "value" .= icon]++data LozengeType = Default+                 | Success+                 | Error+                 | Current+                 | New+                 | Complete+                 | Moved+  deriving (Eq, Generic, Show)++instance ToJSON LozengeType where+  toJSON = genericToJSON defaultOptions{constructorTagModifier=camelTo2 '_'}++defaultGlance :: Glance+defaultGlance =+  let uri  = "https://wiki.haskell.org/wikiupload/4/4a/HaskellLogoStyPreview-1.png"+      icon = Icon uri uri+      name = Name Nothing "Lambdabot"+  in Glance icon "hipbot.glance" name Nothing Nothing Nothing++instance ToJSON Glance where+  toJSON = genericToJSON (aesonPrefix camelCase){omitNothingFields = True}++instance FromJSON Glance where+  parseJSON = genericParseJSON $ aesonPrefix camelCase++data GlanceConditions = GlanceConditions
+ lib/HipChat/Types/Icon.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE OverloadedStrings #-}++module HipChat.Types.Icon where++-- Common icon objects++import           Data.Aeson+import           Data.Aeson.Types+import           Data.Text        (Text)++newtype CompoundIcon = CompoundIcon+  { unCompoundIcon :: Either Text Icon+  } deriving Show++instance ToJSON CompoundIcon where+  toJSON (CompoundIcon (Left  x)) = toJSON x+  toJSON (CompoundIcon (Right x)) = toJSON x++data Icon = Icon+  { iconUrl   :: Text -- ^ Url for the icon.+  , iconUrl2x :: Text -- ^ Url for the retina version of the icon.+  } deriving (Show, Eq)++instance ToJSON Icon where+  toJSON (Icon url url2x) = object+    [ "url"    .= url+    , "url@2x" .= url2x+    ]++instance FromJSON Icon where+  parseJSON (Object x) = Icon <$> x .: "url" <*> x .: "url@2x"+  parseJSON x = typeMismatch "Icon" x
+ lib/HipChat/Types/Key.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE OverloadedStrings #-}++module HipChat.Types.Key where++-- Common length restricted key++import           Control.Lens+import           Data.Aeson+import           Data.Maybe+import           Data.Monoid+import           Data.String+import           Data.Text    (Text)+import qualified Data.Text    as T++newtype Key = Key+  { unKey :: Text+  } deriving (Eq, Show)++key :: Prism' Text Key+key = prism' enc dec+  where+    enc = unKey+    dec x = let l = T.length x+            in if l >= 1 && l <= 40 then+              Just $ Key x+            else+              Nothing++instance IsString Key where+  fromString x = fromJust (T.pack x ^? key)++instance ToJSON Key where+  toJSON (Key x) = toJSON x++instance FromJSON Key where+  parseJSON x = do+    rawKey <- parseJSON x+    case rawKey ^? key of+      Nothing -> fail $ "Invalid key length, expected [1,40], got: " <> show (T.length rawKey)+      Just k  -> return k
+ lib/HipChat/Types/Name.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE OverloadedStrings #-}++module HipChat.Types.Name where++-- Common name object++import           Data.Aeson+import           Data.Aeson.Types+import           Data.Monoid+import           Data.Text        (Text)++data Name = Name+  { nameI18n  :: Maybe Text -- ^ The optional localization key, used to look up the localized value. Valid length range: 1 - 40.+  , nameValue :: Text       -- ^ The default text. Valid length range: 1 - 100.+  } deriving (Show, Eq)++instance ToJSON Name where+  toJSON (Name i18n value) =+    object $ maybe [] (\x -> [ "i18n" .= x ]) i18n <> [ "value" .= value ]++instance FromJSON Name where+  parseJSON (Object x) = Name <$> x .:? "i18n" <*> x .: "value"+  parseJSON x = typeMismatch "Name" x
+ lib/HipChat/Types/RoomAddonUIUpdateRequest.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE DeriveGeneric #-}++module HipChat.Types.RoomAddonUIUpdateRequest where++import           Data.Aeson+import           Data.Aeson.Casing+import           GHC.Generics++import           HipChat.Types.Glance++data RoomAddonUIUpdateRequest = RoomAddonUIUpdateRequest+  { roomUIUpdateGlance :: [GlanceUpdate]+  } deriving (Eq, Generic, Show)++instance ToJSON RoomAddonUIUpdateRequest where+  toJSON = genericToJSON $ aesonDrop 12 camelCase
+ lib/HipChat/Types/Rooms.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE DataKinds                  #-}+{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE TypeOperators              #-}++module HipChat.Types.Rooms+  ( CreateRoomRequest(..)+  , CreateRoomResponse(..)+  , CreateRoomResponseLinks(..)+  , CreateWebhookRequest(..)+  , CreateWebhookResponse(..)+  , CreateWebhookResponseLinks(..)+  , GetAllMembersResponse(..)+  , GetAllRoomsResponse(..)+  , Message(..)+  , RoomEvent(..)+  , RoomStatistics(..)+  , SendMessageResponse(..)+  , UserItem(..)+  , WebhookKey(..)+  , createWebhookRequest+  ) where++import           Data.Aeson+import           Data.Aeson.Casing+import           Data.String+import           Data.Text                                 (Text)+import           GHC.Generics++import           HipChat.Types.Common+import           HipChat.Types.Rooms.CreateRoomRequest+import           HipChat.Types.Rooms.CreateRoomResponse+import           HipChat.Types.Rooms.CreateWebhookRequest+import           HipChat.Types.Rooms.CreateWebhookResponse+import           HipChat.Types.Rooms.GetAllMembersResponse+import           HipChat.Types.Rooms.GetAllRoomsResponse+++newtype Message = Message {+  message :: Text+} deriving (Generic, IsString, Show)+instance ToJSON Message++data RoomStatistics = RoomStatistics+  { roomStatisticsMessagesSent :: Int+  , roomStatisticsLastActive   :: String+  } deriving (Show, Generic)++instance FromJSON RoomStatistics where+  parseJSON = genericParseJSON $ aesonDrop 14 snakeCase++data SendMessageResponse = SendMessageResponse+  { timestamp :: Text+  , id        :: Text+  } deriving (Show, Generic)+instance FromJSON SendMessageResponse
+ lib/HipChat/Types/Rooms/CreateRoomRequest.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE OverloadedStrings #-}++module HipChat.Types.Rooms.CreateRoomRequest where++import           Data.Aeson+import           Data.Aeson.Casing+import           Data.Text         (Text)+import           GHC.Generics++data RoomPrivacy = Public+                 | Private++instance ToJSON RoomPrivacy where+  toJSON Public  = String "public"+  toJSON Private = String "private"++data CreateRoomRequest = CreateRoomRequest+  { crrName                    :: Text+  , crrPrivacy                 :: Maybe RoomPrivacy+  , crrDelegateAdminVisibility :: Maybe Bool+  , crrTopic                   :: Maybe Text+  , crrOwnerUserId             :: Maybe (Either Text Int)+  , crrGuestAccess             :: Maybe Bool+  } deriving (Generic)++instance ToJSON CreateRoomRequest where+  toJSON = genericToJSON $ aesonPrefix snakeCase
+ lib/HipChat/Types/Rooms/CreateRoomResponse.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE DeriveGeneric #-}++module HipChat.Types.Rooms.CreateRoomResponse where++import           Data.Aeson+import           Data.Aeson.Casing+import           Data.Text            (Text)+import           GHC.Generics++import           HipChat.Types.Common++data CreateRoomResponse = CreateRoomResponse+  { crrId    :: IdOrName+  , crrLinks :: CreateRoomResponseLinks+  } deriving (Generic, Show)++data CreateRoomResponseLinks = CreateRoomResponseLinks+  { crrlSelf :: Text+  } deriving (Generic, Show)++instance FromJSON CreateRoomResponse where+  parseJSON = genericParseJSON $ aesonPrefix snakeCase++instance FromJSON CreateRoomResponseLinks where+  parseJSON = genericParseJSON $ aesonPrefix snakeCase
+ lib/HipChat/Types/Rooms/CreateWebhookRequest.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module HipChat.Types.Rooms.CreateWebhookRequest where++import           Data.Aeson+import           Data.Aeson.Casing+import           Data.String+import           Data.Text            (Text)+import           GHC.Generics+import           Servant.API++import           HipChat.Types.Common++data CreateWebhookRequest = CreateWebhookRequest+  { createWebhookRequestName           :: Maybe Text+  , createWebhookRequestUrl            :: Text+  , createWebhookRequestPattern        :: Maybe Text+  , createWebhookRequestAuthentication :: Maybe WebhookAuth+  , createWebhookRequestKey            :: Maybe WebhookKey+  , createWebhookRequestEvent          :: RoomEvent+  } deriving (Generic, Show)++newtype WebhookKey = WebhookKey Text+  deriving (Generic, IsString, Show, ToHttpApiData)++instance ToJSON WebhookKey where+  toJSON = genericToJSON $ aesonDrop 20 camelCase++createWebhookRequest :: Text -> RoomEvent -> CreateWebhookRequest+createWebhookRequest url = CreateWebhookRequest Nothing url Nothing Nothing Nothing++instance ToJSON CreateWebhookRequest where+  toJSON = genericToJSON $ aesonPrefix snakeCase
+ lib/HipChat/Types/Rooms/CreateWebhookResponse.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE DeriveGeneric #-}++module HipChat.Types.Rooms.CreateWebhookResponse where++import           Data.Aeson+import           Data.Aeson.Casing+import           Data.Text         (Text)+import           GHC.Generics++data CreateWebhookResponse = CreateWebhookResponse+  { cwrId    :: Either String Int+  , cwrLinks :: CreateWebhookResponseLinks+  } deriving (Generic, Show)++data CreateWebhookResponseLinks = CreateWebhookResponseLinks+  { cwrlSelf :: Text+  } deriving (Generic, Show)++instance FromJSON CreateWebhookResponse where+  parseJSON = genericParseJSON $ aesonPrefix snakeCase++instance FromJSON CreateWebhookResponseLinks where+  parseJSON = genericParseJSON $ aesonPrefix snakeCase
+ lib/HipChat/Types/Rooms/GetAllMembersResponse.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE DeriveGeneric #-}++module HipChat.Types.Rooms.GetAllMembersResponse where+++import           Data.Aeson+import           Data.Aeson.Casing+import           Data.Text            (Text)+import           GHC.Generics++import           HipChat.Types.Common++data UserItem = UserItem+  { uiMentionName :: Text+  , uiVersion     :: Text+  , uiId          :: Int+  , uiLinks       :: Maybe Link+  , uiName        :: Text+  } deriving (Generic, Show)++instance FromJSON UserItem where+  parseJSON = genericParseJSON $ aesonPrefix snakeCase++data GetAllMembersResponse = GetAllMembersResponse+  { gamrItems      :: [UserItem]+  , gamrStartIndex :: Int+  , gamrMaxResults :: Int+  , gamrLinks      :: PaginatedLink+  } deriving (Generic, Show)++instance FromJSON GetAllMembersResponse where+  parseJSON = genericParseJSON $ aesonPrefix camelCase
+ lib/HipChat/Types/Rooms/GetAllRoomsResponse.hs view
@@ -0,0 +1,5 @@+module HipChat.Types.Rooms.GetAllRoomsResponse+  ( GetAllRoomsResponse(..)+  ) where++data GetAllRoomsResponse = GetAllRoomsResponse
+ lib/HipChat/Types/User.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE OverloadedStrings #-}++module HipChat.Types.User where++import           Data.Aeson+import           Data.Aeson.Casing+import           Data.Text         (Text)+import           GHC.Generics++data User = User+  { userXmppJid    :: Text+  , userIsDeleted  :: Bool+  , userName       :: Text+  , userLastActive :: Text+  , userEmail      :: Maybe Text+  } deriving (Generic, Show)++instance FromJSON User where+  parseJSON = genericParseJSON $ aesonPrefix snakeCase
+ lib/HipChat/Types/WebPanel.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE OverloadedStrings #-}++module HipChat.Types.WebPanel where++-- https://www.hipchat.com/docs/apiv2/webpanels++import           Data.Aeson+import           Data.Aeson.Casing+import           Data.Aeson.Types+import           Data.Monoid+import           Data.Text          (Text)+import qualified Data.Text          as T+import           GHC.Generics++import           HipChat.Types.Icon+import           HipChat.Types.Key+import           HipChat.Types.Name++data WebPanelLocation = HipchatSidebarRight+  deriving (Eq, Show)++instance ToJSON WebPanelLocation where+  toJSON HipchatSidebarRight = "hipchat.sidebar.right"++instance FromJSON WebPanelLocation where+  parseJSON (String "hipchat.sidebar.right") =  return HipchatSidebarRight+  parseJSON (String x) = fail $ "Unexpected string: \"" <> T.unpack x <> "\" when parsing WebPanelLocation"+  parseJSON x = typeMismatch "WebPanelLocation" x++data WebPanel = WebPanel+  { webPanelIcon     :: Maybe Icon       -- ^ Icon to display on the left side of the webPanel title.+  , webPanelKey      :: Key              -- ^ Unique key (in the context of the integration) to identify this webPanel. Valid length range: 1 - 40.+  , webPanelLocation :: WebPanelLocation -- ^ The location of this webPanel Valid values: hipchat.sidebar.right.+  , webPanelName     :: Name             -- ^ The display name of the webPanel.+  , webPanelUrl      :: Text             -- ^ The URL of the resource providing the view content.+  , webPanelWeight   :: Maybe Int        -- ^ Determines the order in which webPanel appear. Web panels are displayed top to bottom or left to right in order of ascending weight. Defaults to 100.+  } deriving (Eq, Generic, Show)++webPanel :: Key -> Name -> Text -> WebPanel+webPanel k name url = WebPanel Nothing k HipchatSidebarRight name url Nothing++instance ToJSON WebPanel where+  toJSON = genericToJSON (aesonDrop 8 camelCase){omitNothingFields = True}++instance FromJSON WebPanel where+  parseJSON = genericParseJSON $ aesonDrop 8 camelCase
− lib/Network/Hipchat/Client.hs 
@@ -1,110 +0,0 @@-{-# LANGUAGE DataKinds         #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeOperators     #-}-{-# LANGUAGE RecordWildCards   #-}-{-# LANGUAGE DeriveGeneric     #-}--module Network.Hipchat.Client where--import           Network.Hipchat.Types.API--import           Control.Monad.Trans.Either-import           Data.Proxy-import           Data.Text                           (Text)-import Data.Aeson-import           Servant.API-import GHC.Generics-import           Servant.Client-import qualified Data.Text as T-import System.IO-import Data.Time.Clock-import Data.Monoid-import Data.Time.Format--import           Network.Hipchat.Types.Common-import           Network.Hipchat.Types.Rooms-import           Network.Hipchat.Types.TokenRequest-import           Network.Hipchat.Types.TokenResponse-import           Network.Hipchat.Types.User--hipChatAPI :: Proxy HipchatAPI-hipChatAPI = Proxy--sendMessage       :: Maybe Token -> Text -> Message -> EitherT ServantError IO SendMessageResponse-createRoom        :: Maybe Token -> CreateRoomRequest -> EitherT ServantError IO CreateRoomResponse-getRoomStatistics :: Maybe Token -> Text -> EitherT ServantError IO RoomStatistics-generateToken     :: Maybe Token -> TokenRequest -> EitherT ServantError IO TokenResponse-viewUser          :: Maybe Token -> Text -> EitherT ServantError IO User-createWebhook     :: Maybe Token -> IdOrName -> WebhookKey -> CreateWebhookRequest -> EitherT ServantError IO CreateWebhookResponse-getAllMembers     :: Maybe Token -> IdOrName -> Maybe Int -> Maybe Int -> EitherT ServantError IO GetAllMembersResponse-sendMessage :<|> createRoom :<|> getRoomStatistics :<|> generateToken :<|> viewUser :<|> createWebhook :<|> getAllMembers = client hipChatAPI host-  where-    host = BaseUrl Https "api.hipchat.com" 443---shame :: Text -> Maybe Token -> IO ()-shame id_or_email token = do-    user <- getShame id_or_email token-    putStrLn $ T.unpack user-    shameResp <- runEitherT $ lookupShame user-    case shameResp of-        Left err -> print $ show err-        Right DirectoryResponse{..} -> do---            currentTime <- getCurrentTime---            let seconds = diffUTCTime currentTime (unDirectoryTime drHireDate)---            let days = floor $ seconds / 60 / 60 / 24 :: Int-   --         let (Manager mName mUsername) = head drManagers---            let shameMessage = full_name <> " used @_here, " <>---                    if days < 90 then---                        " but has only been here for " <> T.pack (show days) <> " days, lets be nice."---                    else---                        " and has been here for " <> T.pack (show days) <> " days, SHAME!\n" <>---                        "Maybe we should tell their manager, " <> mName <> "..."-            -- putStrLn $ T.unpack shameMessage-            --result <- runEitherT $ sendMessage "Build Engineering - Private" (Message shameMessage) token-            result <- runEitherT $ sendMessage token "top secrat" (Message $ drFullName <> ": " <> drTenure)-            case result of-                Left err -> print $ show err-                Right resp -> print resp--getShame :: Text -> Maybe Token -> IO Text-getShame id_or_email token = do-    result <- runEitherT $ viewUser token id_or_email-    case result of-        Left err -> return "" -- $ fromString $ show err-        Right User{..} -> case userEmail of-            Nothing -> return "no email =("-            Just email -> return $ head (T.splitOn "@" email)--type Directory = "api" :> "staffData" :> Capture "staff_name" Text :> Get '[JSON] DirectoryResponse--directory :: Proxy Directory-directory = Proxy--lookupShame = client directory host-  where-    host = BaseUrl Https "directory.atlassian.io" 443-data Manager = Manager Text Text deriving (Show)--instance FromJSON Manager where-    parseJSON (Object v) = Manager <$> v .: "full_name" <*> v .: "username"--data DirectoryResponse = DirectoryResponse-  { drFullName  :: Text-  --, drHireDate  :: DirectoryTime-  , drTenure     :: Text-  , drManagers   :: [Manager]---  , drBlogPosts :: [()]-  } deriving (Generic, Show)--instance FromJSON DirectoryResponse where-  parseJSON = genericHipchatParseJSON 2--newtype DirectoryTime = DirectoryTime-  { unDirectoryTime :: UTCTime-  } deriving Show--instance FromJSON DirectoryTime where-    parseJSON (String x) = do-        utcTime <- parseTimeM False defaultTimeLocale "%F %X" (T.unpack x)-        return $ DirectoryTime utcTime
− lib/Network/Hipchat/Types/API.hs 
@@ -1,73 +0,0 @@-{-# LANGUAGE DataKinds     #-}-{-# LANGUAGE TypeOperators #-}--module Network.Hipchat.Types.API where--import           Data.Text                           (Text)--import           Servant.API--import           Network.Hipchat.Types.Common-import           Network.Hipchat.Types.Rooms-import           Network.Hipchat.Types.TokenRequest-import           Network.Hipchat.Types.TokenResponse-import           Network.Hipchat.Types.User--type HipchatAPI =-       SendMessage-  :<|> CreateRoom-  :<|> GetRoomStatistics-  :<|> GenerateToken-  :<|> ViewUser-  :<|> CreateWebhook-  :<|> GetAllMembers---type GenerateToken = TokenAuth (-    "v2" :> "oauth" :> "token"-  :> ReqBody '[JSON] TokenRequest-  :> Post '[JSON] TokenResponse)--type ViewUser = TokenAuth (-    "v2" :> "user"- :> Capture "id_or_email" Text- :> Get '[JSON] User)---------------------------------------------------------------------------------------- Rooms--type CreateRoom = TokenAuth (-    "v2" :> "room"- :> ReqBody '[JSON] CreateRoomRequest- :> Post '[JSON] CreateRoomResponse)--type CreateWebhook = TokenAuth (-    "v2" :> "room"- :> Capture "room_id_or_name" IdOrName- :> "extension"- :> "webhook"- :> Capture "key" WebhookKey- :> ReqBody '[JSON] CreateWebhookRequest- :> Put '[JSON] CreateWebhookResponse)--type SendMessage = TokenAuth (-    "v2" :> "room"- :> Capture "room" Text- :> "message"- :> ReqBody '[JSON] Message- :> Post '[JSON] SendMessageResponse)--type GetRoomStatistics = TokenAuth (-    "v2" :> "room"- :> Capture "room" Text- :> "statistics"- :> Get '[JSON] RoomStatistics)--type GetAllMembers = TokenAuth (-    "v2" :> "room"-  :> Capture "room_id_or_name" IdOrName-  :> "member"-  :> QueryParam "start-index" Int-  :> QueryParam "max-results" Int-  :> Get '[JSON] GetAllMembersResponse)
− lib/Network/Hipchat/Types/Common.hs 
@@ -1,74 +0,0 @@-{-# LANGUAGE DataKinds                  #-}-{-# LANGUAGE DeriveGeneric              #-}-{-# LANGUAGE FlexibleContexts           #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE TypeFamilies               #-}-{-# LANGUAGE TypeOperators              #-}--module Network.Hipchat.Types.Common-  ( genericHipchatToJSON-  , genericHipchatParseJSON-  , WebhookAuth(..)-  , Token(..)-  , TokenAuth-  , IdOrName(..)-  , Link(..)-  , PaginatedLink(..)-  ) where--import           Data.Aeson-import           Data.Aeson.Types-import           Data.Monoid-import           Data.String-import           Data.Text        (Text)-import           GHC.Generics-import           Servant.API--genericHipchatToJSON :: (Generic a, GToJSON (Rep a)) => Int -> a -> Value-genericHipchatToJSON len = genericToJSON defaultOptions{fieldLabelModifier=processField len, omitNothingFields = True}--genericHipchatParseJSON :: (Generic a, GFromJSON (Rep a)) => Int -> Value -> Parser a-genericHipchatParseJSON len = genericParseJSON defaultOptions{fieldLabelModifier=processField len}--processField :: Int -> String -> String-processField len x = camelTo '_' $  drop len x--data Link = Link-  { linkSelf :: Text-  } deriving (Generic, Show)--instance FromJSON Link where-  parseJSON = genericHipchatParseJSON 4--data PaginatedLink = PaginatedLink-  { plSelf :: Text-  , plPrev :: Maybe Text-  , plNext :: Maybe Text-  } deriving (Generic, Show)--instance FromJSON PaginatedLink where-  parseJSON = genericHipchatParseJSON 2--data WebhookAuth = JWT-                 | None-  deriving (Generic, Show)--instance ToJSON WebhookAuth where-  toJSON JWT  = String "jwt"-  toJSON None = String "none"---- | Auth Token-newtype Token = Token Text-  deriving (Show, IsString)--instance ToText Token where-  toText (Token tok) = "Bearer " <> tok--type family TokenAuth a where-  TokenAuth x = Header "Authorization" Token :> x--newtype IdOrName = IdOrName Text-  deriving (FromText, Generic, Show, ToText, IsString)--instance FromJSON IdOrName
− lib/Network/Hipchat/Types/Extensions.hs 
@@ -1,112 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}--module Network.Hipchat.Types.Extensions where--import Data.Aeson-import Data.Aeson.Types-import Data.Char-import GHC.Generics-import           Data.Text (Text)--import Network.Hipchat.Types.Common--type AddonAction = ()--data CapabilitiesAdminPage = CapabilitiesAdminPage-  { capUrl :: Text-  } deriving (Generic, Show)--instance ToJSON CapabilitiesAdminPage where-  toJSON = genericHipchatToJSON 3--instance FromJSON CapabilitiesAdminPage where-  parseJSON = genericHipchatParseJSON 3--data CapabilitiesInstallable = CapabilitiesInstallable-  { ciAllowGlobal :: Maybe Bool-  , ciAllowRoom   :: Maybe Bool-  -- | The URL to receive a confirmation of an integration installation. The message will be an HTTP POST with the-  --   following fields in a JSON-encoded body: 'capabilitiesUrl', 'oauthId', 'oauthSecret', and optionally 'roomId'.-  --   The installation of the integration will only succeed if the POST response is a 200.-  , ciCallbackUrl :: Maybe Text- -- , ciInstalledUrl :: Maybe Text-  } deriving (Generic, Show)--instance ToJSON CapabilitiesInstallable where-  toJSON = genericToJSON defaultOptions{fieldLabelModifier = \x -> let (y:ys) = drop 2 x in toLower y:ys, omitNothingFields = True}--instance FromJSON CapabilitiesInstallable where-  parseJSON = genericParseJSON defaultOptions{fieldLabelModifier = \x -> let (y:ys) = drop 2 x in toLower y:ys, omitNothingFields = True}--data Capabilities = Capabilities-  { cAction    :: Maybe [AddonAction]-  , cAdminPage :: Maybe CapabilitiesAdminPage-  , cConfigurable :: Maybe ()-  , cDialog :: Maybe [()]-  , cExternalPage :: Maybe [()]-  , cGlance :: Maybe [()]-  , cHipchatApiConsumer :: Maybe HipchatApiConsumer-  , cInstallable :: Maybe CapabilitiesInstallable-  } deriving (Generic, Show)--instance ToJSON Capabilities where-  toJSON = genericToJSON defaultOptions{fieldLabelModifier = \x -> let (y:ys) = drop 1 x in toLower y:ys, omitNothingFields = True}--instance FromJSON Capabilities where-  parseJSON = genericParseJSON defaultOptions{fieldLabelModifier = \x -> let (y:ys) = drop 1 x in toLower y:ys, omitNothingFields = True}--data HipchatApiConsumer = HipchatApiConsumer-  { hacAvatar   :: Maybe Text-  , hacFromName :: Maybe Text-  , hacScopes   :: [Text]-  } deriving (Generic, Show)--instance ToJSON HipchatApiConsumer where-  toJSON = genericToJSON defaultOptions{fieldLabelModifier = \x -> let (y:ys) = drop 3 x in toLower y:ys, omitNothingFields = True}--instance FromJSON HipchatApiConsumer where-  parseJSON = genericParseJSON defaultOptions{fieldLabelModifier = \x -> let (y:ys) = drop 3 x in toLower y:ys, omitNothingFields = True}--data CapabilitiesLinks = CapabilitiesLinks-  { clHomepage :: Maybe Text-  , clSelf :: Text-  } deriving (Generic, Show)--capabilitiesLinks :: Text -> CapabilitiesLinks-capabilitiesLinks self = CapabilitiesLinks Nothing self--instance ToJSON CapabilitiesLinks where-  toJSON = genericToJSON defaultOptions{fieldLabelModifier = \x -> let (y:ys) = drop 2 x in toLower y:ys, omitNothingFields = True}--instance FromJSON CapabilitiesLinks where-  parseJSON = genericParseJSON defaultOptions{fieldLabelModifier = \x -> let (y:ys) = drop 2 x in toLower y:ys, omitNothingFields = True}--data CapabilitiesVendor = CapabilitiesVendor-  {--  } deriving (Generic, Show)--instance ToJSON CapabilitiesVendor where-  toJSON = genericToJSON defaultOptions{fieldLabelModifier = \x -> let (y:ys) = drop 2 x in toLower y:ys, omitNothingFields = True}--instance FromJSON CapabilitiesVendor where-  parseJSON = genericParseJSON defaultOptions{fieldLabelModifier = \x -> let (y:ys) = drop 2 x in toLower y:ys, omitNothingFields = True}--data CapabilitiesDescriptor = CapabilitiesDescriptor-  { cdApiVersion   :: Maybe Text-  , cdCapabilities :: Maybe Capabilities-  , cdDescription  :: Text-  , cdKey          :: Text-  , cdLinks        :: CapabilitiesLinks-  , cdName         :: Text-  , cdVendor       :: Maybe CapabilitiesVendor-  } deriving (Generic, Show)--capabilitiesDescriptor :: Text -> Text -> CapabilitiesLinks -> Text -> CapabilitiesDescriptor-capabilitiesDescriptor desc key links name = CapabilitiesDescriptor Nothing Nothing desc key links name Nothing--instance ToJSON CapabilitiesDescriptor where-  toJSON = genericToJSON defaultOptions{fieldLabelModifier = \x -> let (y:ys) = drop 2 x in toLower y:ys, omitNothingFields = True}--instance FromJSON CapabilitiesDescriptor where-  parseJSON = genericParseJSON defaultOptions{fieldLabelModifier = \x -> let (y:ys) = drop 2 x in toLower y:ys, omitNothingFields = True}
− lib/Network/Hipchat/Types/Rooms.hs 
@@ -1,53 +0,0 @@-{-# LANGUAGE DataKinds                  #-}-{-# LANGUAGE DeriveGeneric              #-}-{-# LANGUAGE FlexibleInstances          #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses      #-}-{-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE TypeOperators              #-}--module Network.Hipchat.Types.Rooms-  ( CreateRoomRequest(..)-  , CreateRoomResponse(..)-  , CreateRoomResponseLinks(..)-  , Message(..)-  , RoomEvent(..)-  , CreateWebhookRequest(..)-  , createWebhookRequest-  , CreateWebhookResponse(..)-  , CreateWebhookResponseLinks(..)-  , SendMessageResponse(..)-  , RoomStatistics(..)-  , WebhookKey(..)-  , GetAllMembersResponse(..)-  , UserItem(..)-  ) where--import           Data.Aeson-import           Data.String-import           Data.Text                                         (Text)-import           GHC.Generics--import           Network.Hipchat.Types.Rooms.CreateRoomRequest-import           Network.Hipchat.Types.Rooms.CreateRoomResponse-import           Network.Hipchat.Types.Rooms.CreateWebhookRequest-import           Network.Hipchat.Types.Rooms.CreateWebhookResponse-import           Network.Hipchat.Types.Rooms.GetAllMembersResponse---newtype Message = Message {-  message :: Text-} deriving (Generic, IsString, Show)-instance ToJSON Message--data RoomStatistics = RoomStatistics-  { messages_sent :: Int-  , last_active   :: String-  } deriving (Show, Generic)-instance FromJSON RoomStatistics--data SendMessageResponse = SendMessageResponse-  { timestamp :: Text-  , id        :: Text-  } deriving (Show, Generic)-instance FromJSON SendMessageResponse
− lib/Network/Hipchat/Types/Rooms/CreateRoomRequest.hs 
@@ -1,29 +0,0 @@-{-# LANGUAGE DeriveGeneric     #-}-{-# LANGUAGE OverloadedStrings #-}--module Network.Hipchat.Types.Rooms.CreateRoomRequest where--import           Data.Aeson-import           Data.Text                    (Text)-import           GHC.Generics--import           Network.Hipchat.Types.Common--data RoomPrivacy = Public-                 | Private--instance ToJSON RoomPrivacy where-  toJSON Public  = String "public"-  toJSON Private = String "private"--data CreateRoomRequest = CreateRoomRequest-  { crrName                    :: Text-  , crrPrivacy                 :: Maybe RoomPrivacy-  , crrDelegateAdminVisibility :: Maybe Bool-  , crrTopic                   :: Maybe Text-  , crrOwnerUserId             :: Maybe (Either Text Int)-  , crrGuestAccess             :: Maybe Bool-  } deriving (Generic)--instance ToJSON CreateRoomRequest where-  toJSON = genericHipchatToJSON 3
− lib/Network/Hipchat/Types/Rooms/CreateRoomResponse.hs 
@@ -1,24 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}--module Network.Hipchat.Types.Rooms.CreateRoomResponse where--import           Data.Aeson-import           Data.Text                    (Text)-import           GHC.Generics--import           Network.Hipchat.Types.Common--data CreateRoomResponse = CreateRoomResponse-  { crrId    :: IdOrName-  , crrLinks :: CreateRoomResponseLinks-  } deriving (Generic, Show)--data CreateRoomResponseLinks = CreateRoomResponseLinks-  { crrlSelf :: Text-  } deriving (Generic, Show)--instance FromJSON CreateRoomResponse where-  parseJSON = genericHipchatParseJSON 3--instance FromJSON CreateRoomResponseLinks where-  parseJSON = genericHipchatParseJSON 4
− lib/Network/Hipchat/Types/Rooms/CreateWebhookRequest.hs 
@@ -1,48 +0,0 @@-{-# LANGUAGE DeriveGeneric              #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}--module Network.Hipchat.Types.Rooms.CreateWebhookRequest where--import           Data.Aeson-import           Data.Aeson.Types-import           Data.String-import           Data.Text                    (Text)-import           GHC.Generics-import           Servant.API--import           Network.Hipchat.Types.Common--data CreateWebhookRequest = CreateWebhookRequest-  { cwrName           :: Maybe Text-  , cwrUrl            :: Text-  , cwrPattern        :: Maybe Text-  , cwrAuthentication :: Maybe WebhookAuth-  , cwrKey            :: Maybe WebhookKey-  , cwrEvent          :: RoomEvent-  } deriving (Generic, Show)--data RoomEvent = RoomArchived-               | RoomCreated-               | RoomDeleted-               | RoomEnter-               | RoomExit-               | RoomFileUpload-               | RoomMessage-               | RoomNotification-               | RoomTopicChange-               | RoomUnarchived-  deriving (Generic, Show)--newtype WebhookKey = WebhookKey Text-  deriving (FromText, Generic, ToText, IsString, Show)--instance ToJSON WebhookKey--instance ToJSON RoomEvent where-  toJSON = genericToJSON defaultOptions{constructorTagModifier=camelTo '_'}--createWebhookRequest :: Text -> RoomEvent -> CreateWebhookRequest-createWebhookRequest url event = CreateWebhookRequest Nothing url Nothing Nothing Nothing event--instance ToJSON CreateWebhookRequest where-  toJSON = genericHipchatToJSON 3
− lib/Network/Hipchat/Types/Rooms/CreateWebhookResponse.hs 
@@ -1,24 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}--module Network.Hipchat.Types.Rooms.CreateWebhookResponse where--import           Data.Aeson-import           Data.Text                    (Text)-import           GHC.Generics--import           Network.Hipchat.Types.Common--data CreateWebhookResponse = CreateWebhookResponse-  { cwrId    :: Either String Int-  , cwrLinks :: CreateWebhookResponseLinks-  } deriving (Generic, Show)--data CreateWebhookResponseLinks = CreateWebhookResponseLinks-  { cwrlSelf :: Text-  } deriving (Generic, Show)--instance FromJSON CreateWebhookResponse where-  parseJSON = genericHipchatParseJSON 3--instance FromJSON CreateWebhookResponseLinks where-  parseJSON = genericHipchatParseJSON 4
− lib/Network/Hipchat/Types/Rooms/GetAllMembersResponse.hs 
@@ -1,34 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}--module Network.Hipchat.Types.Rooms.GetAllMembersResponse where---import           Data.Aeson-import           Data.Aeson.Types-import Data.Char-import           Data.Text                    (Text)-import GHC.Generics--import Network.Hipchat.Types.Common--data UserItem = UserItem-  { uiMentionName :: Text-  , uiVersion :: Text-  , uiId :: Int-  , uiLinks :: Maybe Link-  , uiName :: Text-  } deriving (Generic, Show)---instance FromJSON UserItem where-  parseJSON = genericHipchatParseJSON 2--data GetAllMembersResponse = GetAllMembersResponse-  { gamrItems :: [UserItem]-  , gamrStartIndex :: Int-  , gamrMaxResults :: Int-  , gamrLinks :: PaginatedLink-  } deriving (Generic, Show)--instance FromJSON GetAllMembersResponse where-  parseJSON = genericParseJSON defaultOptions{fieldLabelModifier = \x -> let (y:ys) = drop 4 x in toLower y:ys}
− lib/Network/Hipchat/Types/TokenRequest.hs 
@@ -1,66 +0,0 @@-{-# LANGUAGE DeriveGeneric         #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings     #-}-{-# LANGUAGE TypeOperators         #-}--module Network.Hipchat.Types.TokenRequest where--import           Control.Lens-import           Data.Aeson-import           Data.String-import           Data.String.Conversions-import           Data.Text               (Text)-import qualified Data.Text               as T-import           GHC.Generics--import           Servant.API--data GrantType = AuthorizationCode-               | RefreshToken-               | Password-               | ClientCredentials-               | Personal-               | RoomNotification--instance Show GrantType where-  show = show . (^. re grantType)--grantType :: Prism' Text GrantType-grantType = prism' display parse-  where-    display AuthorizationCode = "authorization_code"-    display RefreshToken      = "refresh_token"-    display Password          = "password"-    display ClientCredentials = "client_credentials"-    display Personal          = "personal"-    display RoomNotification  = "room_notification"--    parse "authorization_code" = Just AuthorizationCode-    parse "refresh_token"      = Just RefreshToken-    parse "password"           = Just Password-    parse "client_credentials" = Just ClientCredentials-    parse "personal"           = Just Personal-    parse "room_notification"  = Just RoomNotification-    parse _                    = Nothing--instance ToJSON GrantType where-  toJSON = toJSON . (^. re grantType)--data TokenRequest = TokenRequest-  { username      :: Maybe Text-  , grant_type    :: GrantType-  , user_id       :: Maybe Text-  , code          :: Maybe Text-  , client_name   :: Maybe Text-  , redirect_uri  :: Maybe Text-  , scope         :: Maybe Text-  , password      :: Maybe Text-  , group_id      :: Maybe Text-  , refresh_token :: Maybe Text-  } deriving (Generic, Show)--instance ToJSON TokenRequest--tokenRequest :: GrantType -> TokenRequest-tokenRequest grant_type = TokenRequest Nothing grant_type Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
− lib/Network/Hipchat/Types/TokenResponse.hs 
@@ -1,23 +0,0 @@-{-# LANGUAGE DeriveGeneric         #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings     #-}-{-# LANGUAGE TypeOperators         #-}--module Network.Hipchat.Types.TokenResponse where--import           Data.Aeson-import           Data.Text               (Text)-import           GHC.Generics--data TokenResponse = TokenResponse-  { access_token  :: Text-  , expires_in    :: Int-  , group_name    :: Text-  , token_type    :: Text-  , scope         :: Text-  , group_id      :: Int-  , refresh_token :: Int-  } deriving (Generic, Show)--instance FromJSON TokenResponse
− lib/Network/Hipchat/Types/User.hs 
@@ -1,21 +0,0 @@-{-# LANGUAGE DeriveGeneric     #-}-{-# LANGUAGE OverloadedStrings #-}--module Network.Hipchat.Types.User where--import           Data.Aeson-import           Data.Text                    (Text)-import           GHC.Generics--import           Network.Hipchat.Types.Common--data User = User-  { userXmppJid    :: Text-  , userIsDeleted  :: Bool-  , userName       :: Text-  , userLastActive :: Text-  , userEmail      :: Maybe Text-  } deriving (Generic, Show)--instance FromJSON User where-  parseJSON = genericHipchatParseJSON 4