Extensions.hs

{-# 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           Database.PostgreSQL.Simple.FromRow
import           Database.PostgreSQL.Simple.ToRow
import           GHC.Generics

import           HipChat.Types.Auth
import           HipChat.Types.Common
import           HipChat.Types.Dialog
import           HipChat.Types.ExternalPage
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]
  , capabilitiesExternalPage       :: [ExternalPage]
  } 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 ep) = object $ catMaybes
    [ ("installable" .=) <$> is
    , ("hipchatApiConsumer" .=) <$> con
    , ("oauth2Provider" .=) <$> o
    , ("webhook" .=) <$> excludeEmptyList hs
    , ("configurable" .=) <$> cfg
    , ("dialog" .=) <$> excludeEmptyList dlg
    , ("webPanel" .=) <$> excludeEmptyList wp
    , ("glance" .=) <$> excludeEmptyList gl
    , ("externalPage" .=) <$> excludeEmptyList ep
    ]

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" .!= []
    <*> o .:? "externalPage" .!= []

--------------------------------------------------------------------------------


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

instance ToRow Registration where
  toRow (Registration a b c d e) = toRow (a, b, c, d, e)

instance FromRow Registration where
  fromRow = Registration <$> field <*> field <*> field <*> field <*> field

--------------------------------------------------------------------------------

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

--------------------------------------------------------------------------------