diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2015, Oswyn Brent + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Oswyn Brent nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/hipchat-hs.cabal b/hipchat-hs.cabal new file mode 100644 --- /dev/null +++ b/hipchat-hs.cabal @@ -0,0 +1,48 @@ +name: hipchat-hs +version: 0.0.2 +synopsis: Hipchat API bindings in Haskell +description: Hipchat API bindings in Haskell +license: BSD3 +license-file: LICENSE +author: Oswyn Brent +maintainer: oztastic703@gmail.com +copyright: Oswyn Brent 2015 +category: Web +build-type: Simple +cabal-version: >=1.18 + +source-repository HEAD + type: git + 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: + -- other-extensions: + build-depends: base >= 4.8 && < 4.9 + , aeson + , async + , bytestring + , either + , lens + , servant + , servant-client + , split + , string-conversions + , text + , time + hs-source-dirs: lib + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall + default-language: Haskell2010 diff --git a/lib/Network/Hipchat/Client.hs b/lib/Network/Hipchat/Client.hs new file mode 100644 --- /dev/null +++ b/lib/Network/Hipchat/Client.hs @@ -0,0 +1,110 @@ +{-# 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 diff --git a/lib/Network/Hipchat/Types/API.hs b/lib/Network/Hipchat/Types/API.hs new file mode 100644 --- /dev/null +++ b/lib/Network/Hipchat/Types/API.hs @@ -0,0 +1,73 @@ +{-# 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) diff --git a/lib/Network/Hipchat/Types/Common.hs b/lib/Network/Hipchat/Types/Common.hs new file mode 100644 --- /dev/null +++ b/lib/Network/Hipchat/Types/Common.hs @@ -0,0 +1,74 @@ +{-# 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 diff --git a/lib/Network/Hipchat/Types/Extensions.hs b/lib/Network/Hipchat/Types/Extensions.hs new file mode 100644 --- /dev/null +++ b/lib/Network/Hipchat/Types/Extensions.hs @@ -0,0 +1,112 @@ +{-# 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} diff --git a/lib/Network/Hipchat/Types/Rooms.hs b/lib/Network/Hipchat/Types/Rooms.hs new file mode 100644 --- /dev/null +++ b/lib/Network/Hipchat/Types/Rooms.hs @@ -0,0 +1,53 @@ +{-# 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 diff --git a/lib/Network/Hipchat/Types/Rooms/CreateRoomRequest.hs b/lib/Network/Hipchat/Types/Rooms/CreateRoomRequest.hs new file mode 100644 --- /dev/null +++ b/lib/Network/Hipchat/Types/Rooms/CreateRoomRequest.hs @@ -0,0 +1,29 @@ +{-# 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 diff --git a/lib/Network/Hipchat/Types/Rooms/CreateRoomResponse.hs b/lib/Network/Hipchat/Types/Rooms/CreateRoomResponse.hs new file mode 100644 --- /dev/null +++ b/lib/Network/Hipchat/Types/Rooms/CreateRoomResponse.hs @@ -0,0 +1,24 @@ +{-# 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 diff --git a/lib/Network/Hipchat/Types/Rooms/CreateWebhookRequest.hs b/lib/Network/Hipchat/Types/Rooms/CreateWebhookRequest.hs new file mode 100644 --- /dev/null +++ b/lib/Network/Hipchat/Types/Rooms/CreateWebhookRequest.hs @@ -0,0 +1,48 @@ +{-# 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 diff --git a/lib/Network/Hipchat/Types/Rooms/CreateWebhookResponse.hs b/lib/Network/Hipchat/Types/Rooms/CreateWebhookResponse.hs new file mode 100644 --- /dev/null +++ b/lib/Network/Hipchat/Types/Rooms/CreateWebhookResponse.hs @@ -0,0 +1,24 @@ +{-# 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 diff --git a/lib/Network/Hipchat/Types/Rooms/GetAllMembersResponse.hs b/lib/Network/Hipchat/Types/Rooms/GetAllMembersResponse.hs new file mode 100644 --- /dev/null +++ b/lib/Network/Hipchat/Types/Rooms/GetAllMembersResponse.hs @@ -0,0 +1,34 @@ +{-# 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} diff --git a/lib/Network/Hipchat/Types/TokenRequest.hs b/lib/Network/Hipchat/Types/TokenRequest.hs new file mode 100644 --- /dev/null +++ b/lib/Network/Hipchat/Types/TokenRequest.hs @@ -0,0 +1,66 @@ +{-# 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 diff --git a/lib/Network/Hipchat/Types/TokenResponse.hs b/lib/Network/Hipchat/Types/TokenResponse.hs new file mode 100644 --- /dev/null +++ b/lib/Network/Hipchat/Types/TokenResponse.hs @@ -0,0 +1,23 @@ +{-# 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 diff --git a/lib/Network/Hipchat/Types/User.hs b/lib/Network/Hipchat/Types/User.hs new file mode 100644 --- /dev/null +++ b/lib/Network/Hipchat/Types/User.hs @@ -0,0 +1,21 @@ +{-# 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