{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RecordWildCards #-}

module Network.Mattermost.WebSocket.Types
( WebsocketEventType(..)
, WebsocketEvent(..)
, WEData(..)
, WEBroadcast(..)
, WebsocketAction(..)
, WebsocketActionResponse(..)
, WebsocketActionStatus(..)
) where

import           Control.Applicative
import           Control.Exception ( throw )
import           Data.Aeson ( FromJSON(..)
                            , ToJSON(..)
                            , (.:)
                            , (.:?)
                            , (.=)
                            )
import qualified Data.Aeson as A
import qualified Data.Aeson.Types as A
#if !MIN_VERSION_base(4,11,0)
import           Data.Monoid ( (<>) )
#endif
import           Data.ByteString.Lazy (fromStrict, toStrict)
import qualified Data.ByteString.Lazy.Char8 as BC
import qualified Data.HashMap.Strict as HM
import           Data.Int (Int64)
import           Data.Sequence (Seq)
import           Data.Set (Set)
import           Data.Text (Text)
import qualified Data.Text as T
import           Data.Text.Encoding (decodeUtf8, encodeUtf8)
import           Network.WebSockets (WebSocketsData(..))
import qualified Network.WebSockets as WS

import           Network.Mattermost.Types
import           Network.Mattermost.Exceptions


data WebsocketEventType
  = WMTyping
  | WMPosted
  | WMPostEdited
  | WMPostDeleted
  | WMChannelDeleted
  | WMChannelCreated
  | WMDirectAdded
  | WMGroupAdded
  | WMNewUser
  | WMAddedToTeam
  | WMLeaveTeam
  | WMUpdateTeam
  | WMTeamDeleted
  | WMUserAdded
  | WMUserUpdated
  | WMUserRemoved
  | WMPreferenceChanged
  | WMPreferenceDeleted
  | WMEphemeralMessage
  | WMStatusChange
  | WMHello
  | WMWebRTC
  | WMAuthenticationChallenge
  | WMReactionAdded
  | WMReactionRemoved
  | WMChannelViewed
  | WMChannelUpdated
  | WMEmojiAdded
  | WMUserRoleUpdated
  | WMPluginStatusesChanged
  | WMPluginEnabled
  | WMPluginDisabled
  deriving (Read, Show, Eq, Ord)

instance FromJSON WebsocketEventType where
  parseJSON = A.withText "event type" $ \s -> case s of
    "typing"             -> return WMTyping
    "posted"             -> return WMPosted
    "post_edited"        -> return WMPostEdited
    "post_deleted"       -> return WMPostDeleted
    "channel_deleted"    -> return WMChannelDeleted
    "direct_added"       -> return WMDirectAdded
    "new_user"           -> return WMNewUser
    "leave_team"         -> return WMLeaveTeam
    "user_added"         -> return WMUserAdded
    "user_updated"       -> return WMUserUpdated
    "user_removed"       -> return WMUserRemoved
    "preferences_changed" -> return WMPreferenceChanged
    "ephemeral_message"  -> return WMEphemeralMessage
    "status_change"      -> return WMStatusChange
    "hello"              -> return WMHello
    "update_team"        -> return WMUpdateTeam
    "delete_team"        -> return WMTeamDeleted
    "reaction_added"     -> return WMReactionAdded
    "reaction_removed"   -> return WMReactionRemoved
    "channel_created"    -> return WMChannelCreated
    "group_added"        -> return WMGroupAdded
    "added_to_team"      -> return WMAddedToTeam
    "webrtc"             -> return WMWebRTC
    "authentication_challenge" -> return WMAuthenticationChallenge
    "preferences_deleted" -> return WMPreferenceDeleted
    "channel_viewed"     -> return WMChannelViewed
    "channel_updated"    -> return WMChannelUpdated
    "emoji_added"        -> return WMEmojiAdded
    "user_role_updated"  -> return WMUserRoleUpdated
    "plugin_statuses_changed" -> return WMPluginStatusesChanged
    "plugin_enabled"     -> return WMPluginEnabled
    "plugin_disabled"    -> return WMPluginDisabled
    _                    -> fail ("Unknown websocket message: " ++ show s)

instance ToJSON WebsocketEventType where
  toJSON WMTyping                  = "typing"
  toJSON WMPosted                  = "posted"
  toJSON WMPostEdited              = "post_edited"
  toJSON WMPostDeleted             = "post_deleted"
  toJSON WMChannelDeleted          = "channel_deleted"
  toJSON WMDirectAdded             = "direct_added"
  toJSON WMNewUser                 = "new_user"
  toJSON WMLeaveTeam               = "leave_team"
  toJSON WMUserAdded               = "user_added"
  toJSON WMUserUpdated             = "user_updated"
  toJSON WMUserRemoved             = "user_removed"
  toJSON WMPreferenceChanged       = "preferences_changed"
  toJSON WMPreferenceDeleted       = "preferences_deleted"
  toJSON WMEphemeralMessage        = "ephemeral_message"
  toJSON WMStatusChange            = "status_change"
  toJSON WMHello                   = "hello"
  toJSON WMUpdateTeam              = "update_team"
  toJSON WMTeamDeleted             = "delete_team"
  toJSON WMReactionAdded           = "reaction_added"
  toJSON WMReactionRemoved         = "reaction_removed"
  toJSON WMChannelCreated          = "channel_created"
  toJSON WMGroupAdded              = "group_added"
  toJSON WMAddedToTeam             = "added_to_team"
  toJSON WMWebRTC                  = "webrtc"
  toJSON WMAuthenticationChallenge = "authentication_challenge"
  toJSON WMChannelViewed           = "channel_viewed"
  toJSON WMChannelUpdated          = "channel_updated"
  toJSON WMEmojiAdded              = "emoji_added"
  toJSON WMUserRoleUpdated         = "user_role_updated"
  toJSON WMPluginStatusesChanged   = "plugin_statuses_changed"
  toJSON WMPluginEnabled           = "plugin_enabled"
  toJSON WMPluginDisabled          = "plugin_disabled"

--

toValueString :: ToJSON a => a -> A.Value
toValueString v =  toJSON (decodeUtf8 (toStrict (A.encode v)))

fromValueString :: FromJSON a => A.Value -> A.Parser a
fromValueString = A.withText "string-encoded json" $ \s -> do
    case A.eitherDecode (fromStrict (encodeUtf8 s)) of
      Right v  -> return v
      Left err -> throw (JSONDecodeException err (T.unpack s))

--

data WebsocketEvent = WebsocketEvent
  { weEvent     :: WebsocketEventType
  , weData      :: WEData
  , weBroadcast :: WEBroadcast
  , weSeq       :: Int64
  } deriving (Read, Show, Eq)

instance FromJSON WebsocketEvent where
  parseJSON = A.withObject "WebsocketEvent" $ \o -> do
    weEvent     <- o .: "event"
    weData      <- o .: "data"
    weBroadcast <- o .: "broadcast"
    weSeq       <- o .: "seq"
    return WebsocketEvent { .. }

instance ToJSON WebsocketEvent where
  toJSON WebsocketEvent { .. } = A.object
    [ "event"      .= weEvent
    , "data"       .= weData
    , "broadcast"  .= weBroadcast
    , "seq"        .= weSeq
    ]

instance WebSocketsData WebsocketEvent where
  fromDataMessage (WS.Text bs _) = fromLazyByteString bs
  fromDataMessage (WS.Binary bs) = fromLazyByteString bs
  fromLazyByteString s = case A.eitherDecode s of
    Left err -> throw (JSONDecodeException err (BC.unpack s))
    Right v  -> v
  toLazyByteString = A.encode

--

data WEData = WEData
  { wepChannelId          :: Maybe ChannelId
  , wepTeamId             :: Maybe TeamId
  , wepSenderName         :: Maybe Text
  , wepUserId             :: Maybe UserId
  , wepUser               :: Maybe User
  , wepChannelDisplayName :: Maybe Text
  , wepPost               :: Maybe Post
  , wepStatus             :: Maybe Text
  , wepReaction           :: Maybe Reaction
  , wepMentions           :: Maybe (Set UserId)
  , wepPreferences        :: Maybe (Seq Preference)
  } deriving (Read, Show, Eq)

instance FromJSON WEData where
  parseJSON = A.withObject "WebSocketEvent Data" $ \o -> do
    wepChannelId          <- nullable (o .: "channel_id")
    wepTeamId             <- maybeFail (o .: "team_id")
    wepSenderName         <- o .:? "sender_name"
    wepUserId             <- o .:? "user_id"
    wepUser               <- o .:? "user"
    wepChannelDisplayName <- o .:? "channel_name"
    wepPostRaw            <- o .:? "post"
    wepPost <- case wepPostRaw of
      Just str -> fromValueString str
      Nothing  -> return Nothing
    wepStatus <- o .:? "status"
    wepReactionRaw <- o .:? "reaction"
    wepReaction <- case wepReactionRaw of
      Just str -> fromValueString str
      Nothing  -> return Nothing
    wepMentionsRaw <- o .:? "mentions"
    wepMentions <- case wepMentionsRaw of
      Just str -> fromValueString str
      Nothing  -> return Nothing
    wepPreferencesRaw <- o .:? "preferences"
    wepPreferences <- case wepPreferencesRaw of
      Just str -> fromValueString str
      Nothing  -> return Nothing
    return WEData { .. }

instance ToJSON WEData where
  toJSON WEData { .. } = A.object
    [ "channel_id"   .= wepChannelId
    , "team_id"      .= wepTeamId
    , "sender_name"  .= wepSenderName
    , "user_id"      .= wepUserId
    , "channel_name" .= wepChannelDisplayName
    , "post"         .= toValueString wepPost
    , "reaction"     .= wepReaction
    , "mentions"     .= toValueString wepMentions
    , "preferences"  .= toValueString wepPreferences
    ]

--

data WEBroadcast = WEBroadcast
  { webChannelId :: Maybe ChannelId
  , webUserId    :: Maybe UserId
  , webTeamId    :: Maybe TeamId
  , webOmitUsers :: Maybe (HM.HashMap UserId Bool)
  } deriving (Read, Show, Eq)

nullable :: Alternative f => f a -> f (Maybe a)
nullable p = (Just <$> p) <|> pure Nothing

instance FromJSON WEBroadcast where
  parseJSON = A.withObject "WebSocketEvent Broadcast" $ \o -> do
    webChannelId <- nullable (o .: "channel_id")
    webTeamId    <- nullable (o .: "team_id")
    webUserId    <- nullable (o .: "user_id")
    webOmitUsers <- nullable (o .: "omit_users")
    return WEBroadcast { .. }

instance ToJSON WEBroadcast where
  toJSON WEBroadcast { .. } = A.object
    [ "channel_id" .= webChannelId
    , "team_id"    .= webTeamId
    , "user_id"    .= webUserId
    , "omit_users" .= webOmitUsers
    ]

--

data WebsocketAction =
    UserTyping { waSeq          :: Int64
               , waChannelId    :: ChannelId
               , waParentPostId :: Maybe PostId
               }
  -- --  | GetStatuses { waSeq :: Int64 }
  -- --  | GetStatusesByIds { waSeq :: Int64, waUserIds :: [UserId] }
  deriving (Read, Show, Eq, Ord)

instance ToJSON WebsocketAction where
  toJSON (UserTyping s cId pId) = A.object
    [ "seq"    .= s
    , "action" .= T.pack "user_typing"
    , "data"   .= A.object
                  [ "channel_id" .= unId (toId cId)
                  , "parent_id"  .= maybe "" (unId . toId) pId
                  ]
    ]

instance WebSocketsData WebsocketAction where
  fromDataMessage _ = error "Not implemented"
  fromLazyByteString _ = error "Not implemented"
  toLazyByteString = A.encode

data WebsocketActionStatus =
    WebsocketActionStatusOK
    deriving (Read, Show, Eq, Ord)

instance FromJSON WebsocketActionStatus where
    parseJSON = A.withText "WebsocketActionStatus" $ \t ->
        case t of
            "OK" -> return WebsocketActionStatusOK
            _ -> fail $ "Invalid WebsocketActionStatus: " <> show t

instance ToJSON WebsocketActionStatus where
    toJSON WebsocketActionStatusOK = "OK"

data WebsocketActionResponse =
    WebsocketActionResponse { warStatus :: WebsocketActionStatus
                            , warSeqReply :: Int64
                            }
    deriving (Read, Show, Eq, Ord)

instance FromJSON WebsocketActionResponse where
  parseJSON =
      A.withObject "WebsocketActionResponse" $ \o ->
          WebsocketActionResponse <$> o A..: "status"
                                  <*> o A..: "seq_reply"

instance ToJSON WebsocketActionResponse where
    toJSON (WebsocketActionResponse status s) =
        A.object [ "status" A..= A.toJSON status
                 , "seq" A..= A.toJSON s
                 ]

instance WebSocketsData WebsocketActionResponse where
  fromDataMessage (WS.Text bs _) = fromLazyByteString bs
  fromDataMessage (WS.Binary bs) = fromLazyByteString bs
  fromLazyByteString s = case A.eitherDecode s of
    Left err -> throw (JSONDecodeException err (BC.unpack s))
    Right v  -> v
  toLazyByteString = A.encode