--------------------------------------------------------------------------------
-- |
-- Module : Database.EventStore.Internal.Subscription.Command
-- Copyright : (C) 2016 Yorick Laupa
-- License : (see the file LICENSE)
--
-- Maintainer : Yorick Laupa <yo.eight@gmail.com>
-- Stability : provisional
-- Portability : non-portable
--
--------------------------------------------------------------------------------
module Database.EventStore.Internal.Subscription.Command where

--------------------------------------------------------------------------------
import Data.ProtocolBuffers
import Data.Serialize

--------------------------------------------------------------------------------
import Database.EventStore.Internal.Command
import Database.EventStore.Internal.Prelude
import Database.EventStore.Internal.Subscription.Message
import Database.EventStore.Internal.Subscription.Types
import Database.EventStore.Internal.Types

--------------------------------------------------------------------------------
data ServerMessage
    = LiveMsg !LiveMsg
    | ConfirmationMsg !ConfirmationMsg
    | ErrorMsg !ErrorMsg

--------------------------------------------------------------------------------
data LiveMsg
    = EventAppearedMsg !ResolvedEvent
    | PersistentEventAppearedMsg !ResolvedEvent
    | DroppedMsg !SubDropReason

--------------------------------------------------------------------------------
data ConfirmationMsg
    = RegularConfirmationMsg !Int64 !(Maybe Int64)
    | PersistentConfirmationMsg !Text !Int64 !(Maybe Int64)

--------------------------------------------------------------------------------
confirmationCommitPos :: ConfirmationMsg -> Int64
confirmationCommitPos :: ConfirmationMsg -> Int64
confirmationCommitPos (RegularConfirmationMsg Int64
pos Maybe Int64
_)       = Int64
pos
confirmationCommitPos  (PersistentConfirmationMsg Text
_ Int64
pos Maybe Int64
_) = Int64
pos

--------------------------------------------------------------------------------
confirmationLastEventNum :: ConfirmationMsg -> Maybe Int64
confirmationLastEventNum :: ConfirmationMsg -> Maybe Int64
confirmationLastEventNum (RegularConfirmationMsg Int64
_ Maybe Int64
num)      = Maybe Int64
num
confirmationLastEventNum (PersistentConfirmationMsg Text
_ Int64
_ Maybe Int64
num) = Maybe Int64
num

--------------------------------------------------------------------------------
confirmationPersistentSubId :: ConfirmationMsg -> Maybe Text
confirmationPersistentSubId :: ConfirmationMsg -> Maybe Text
confirmationPersistentSubId (PersistentConfirmationMsg Text
ident Int64
_ Maybe Int64
_) = forall a. a -> Maybe a
Just Text
ident
confirmationPersistentSubId ConfirmationMsg
_                                     = forall a. Maybe a
Nothing

--------------------------------------------------------------------------------
data ErrorMsg
    = BadRequestMsg !(Maybe Text)
    | NotHandledMsg !NotHandledReason !(Maybe MasterInfo)
    | NotAuthenticatedMsg !(Maybe Text)
    | UnknownMsg !(Maybe Command)

--------------------------------------------------------------------------------
decodeServerMessage :: Package -> ServerMessage
decodeServerMessage :: Package -> ServerMessage
decodeServerMessage Package
pkg = forall a. a -> Maybe a -> a
fromMaybe ServerMessage
err Maybe ServerMessage
go
  where
    err :: ServerMessage
err = ErrorMsg -> ServerMessage
ErrorMsg forall a b. (a -> b) -> a -> b
$ Maybe Command -> ErrorMsg
UnknownMsg forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Package -> Command
packageCmd Package
pkg
    go :: Maybe ServerMessage
go =
        case Package -> Command
packageCmd Package
pkg of
            Command
cmd | Command
cmd forall a. Eq a => a -> a -> Bool
== Command
streamEventAppearedCmd -> do
                StreamEventAppeared
msg <- forall a. Decode a => ByteString -> Maybe a
maybeDecodeMessage forall a b. (a -> b) -> a -> b
$ Package -> ByteString
packageData Package
pkg
                let evt :: ResolvedEvent
evt = ResolvedEventBuf -> ResolvedEvent
newResolvedEventFromBuf forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
getField
                                                  forall a b. (a -> b) -> a -> b
$ StreamEventAppeared -> Required 1 (Message ResolvedEventBuf)
streamResolvedEvent StreamEventAppeared
msg
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ LiveMsg -> ServerMessage
LiveMsg forall a b. (a -> b) -> a -> b
$ ResolvedEvent -> LiveMsg
EventAppearedMsg ResolvedEvent
evt
                | Command
cmd forall a. Eq a => a -> a -> Bool
== Command
persistentSubscriptionStreamEventAppearedCmd -> do
                PersistentSubscriptionStreamEventAppeared
msg <- forall a. Decode a => ByteString -> Maybe a
maybeDecodeMessage forall a b. (a -> b) -> a -> b
$ Package -> ByteString
packageData Package
pkg
                let evt :: ResolvedEvent
evt = ResolvedIndexedEvent -> ResolvedEvent
newResolvedEvent forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
getField forall a b. (a -> b) -> a -> b
$ PersistentSubscriptionStreamEventAppeared
-> Required 1 (Message ResolvedIndexedEvent)
psseaEvt PersistentSubscriptionStreamEventAppeared
msg
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ LiveMsg -> ServerMessage
LiveMsg forall a b. (a -> b) -> a -> b
$ ResolvedEvent -> LiveMsg
PersistentEventAppearedMsg ResolvedEvent
evt
                | Command
cmd forall a. Eq a => a -> a -> Bool
== Command
subscriptionConfirmationCmd -> do
                SubscriptionConfirmation
msg <- forall a. Decode a => ByteString -> Maybe a
maybeDecodeMessage forall a b. (a -> b) -> a -> b
$ Package -> ByteString
packageData Package
pkg
                let lcp :: FieldType (Required 1 (Value Int64))
lcp = forall a. HasField a => a -> FieldType a
getField forall a b. (a -> b) -> a -> b
$ SubscriptionConfirmation -> Required 1 (Value Int64)
subscribeLastCommitPos SubscriptionConfirmation
msg
                    len :: FieldType (Optional 2 (Value Int64))
len = forall a. HasField a => a -> FieldType a
getField forall a b. (a -> b) -> a -> b
$ SubscriptionConfirmation -> Optional 2 (Value Int64)
subscribeLastEventNumber SubscriptionConfirmation
msg
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ConfirmationMsg -> ServerMessage
ConfirmationMsg forall a b. (a -> b) -> a -> b
$ Int64 -> Maybe Int64 -> ConfirmationMsg
RegularConfirmationMsg FieldType (Required 1 (Value Int64))
lcp FieldType (Optional 2 (Value Int64))
len
                | Command
cmd forall a. Eq a => a -> a -> Bool
== Command
persistentSubscriptionConfirmationCmd -> do
                PersistentSubscriptionConfirmation
msg <- forall a. Decode a => ByteString -> Maybe a
maybeDecodeMessage forall a b. (a -> b) -> a -> b
$ Package -> ByteString
packageData Package
pkg
                let lcp :: FieldType (Required 1 (Value Int64))
lcp = forall a. HasField a => a -> FieldType a
getField forall a b. (a -> b) -> a -> b
$ PersistentSubscriptionConfirmation -> Required 1 (Value Int64)
pscLastCommitPos PersistentSubscriptionConfirmation
msg
                    sid :: FieldType (Required 2 (Value Text))
sid = forall a. HasField a => a -> FieldType a
getField forall a b. (a -> b) -> a -> b
$ PersistentSubscriptionConfirmation -> Required 2 (Value Text)
pscId PersistentSubscriptionConfirmation
msg
                    len :: FieldType (Optional 3 (Value Int64))
len = forall a. HasField a => a -> FieldType a
getField forall a b. (a -> b) -> a -> b
$ PersistentSubscriptionConfirmation -> Optional 3 (Value Int64)
pscLastEvtNumber PersistentSubscriptionConfirmation
msg
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ConfirmationMsg -> ServerMessage
ConfirmationMsg forall a b. (a -> b) -> a -> b
$ Text -> Int64 -> Maybe Int64 -> ConfirmationMsg
PersistentConfirmationMsg FieldType (Required 2 (Value Text))
sid FieldType (Required 1 (Value Int64))
lcp FieldType (Optional 3 (Value Int64))
len
                | Command
cmd forall a. Eq a => a -> a -> Bool
== Command
subscriptionDroppedCmd -> do
                SubscriptionDropped
msg <- forall a. Decode a => ByteString -> Maybe a
maybeDecodeMessage forall a b. (a -> b) -> a -> b
$ Package -> ByteString
packageData Package
pkg
                let reason :: DropReason
reason = forall a. a -> Maybe a -> a
fromMaybe DropReason
D_Unsubscribed forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
getField
                                                      forall a b. (a -> b) -> a -> b
$ SubscriptionDropped -> Optional 1 (Enumeration DropReason)
dropReason SubscriptionDropped
msg
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ LiveMsg -> ServerMessage
LiveMsg forall a b. (a -> b) -> a -> b
$ SubDropReason -> LiveMsg
DroppedMsg forall a b. (a -> b) -> a -> b
$ DropReason -> SubDropReason
toSubDropReason DropReason
reason
                | Command
cmd forall a. Eq a => a -> a -> Bool
== Command
badRequestCmd ->
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ServerMessage
ErrorMsg forall a b. (a -> b) -> a -> b
$ Maybe Text -> ErrorMsg
BadRequestMsg forall a b. (a -> b) -> a -> b
$ Package -> Maybe Text
packageDataAsText Package
pkg
                | Command
cmd forall a. Eq a => a -> a -> Bool
== Command
notAuthenticatedCmd ->
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ServerMessage
ErrorMsg forall a b. (a -> b) -> a -> b
$ Maybe Text -> ErrorMsg
NotAuthenticatedMsg forall a b. (a -> b) -> a -> b
$ Package -> Maybe Text
packageDataAsText Package
pkg
                | Command
cmd forall a. Eq a => a -> a -> Bool
== Command
notHandledCmd -> do
                NotHandledBuf
msg <- forall a. Decode a => ByteString -> Maybe a
maybeDecodeMessage forall a b. (a -> b) -> a -> b
$ Package -> ByteString
packageData Package
pkg
                let info :: Maybe MasterInfo
info = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MasterInfoBuf -> MasterInfo
masterInfo forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
getField
                                           forall a b. (a -> b) -> a -> b
$ NotHandledBuf -> Optional 2 (Message MasterInfoBuf)
notHandledAdditionalInfo NotHandledBuf
msg
                    reason :: FieldType (Required 1 (Enumeration NotHandledReason))
reason = forall a. HasField a => a -> FieldType a
getField forall a b. (a -> b) -> a -> b
$ NotHandledBuf -> Required 1 (Enumeration NotHandledReason)
notHandledReason NotHandledBuf
msg
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ErrorMsg -> ServerMessage
ErrorMsg forall a b. (a -> b) -> a -> b
$ NotHandledReason -> Maybe MasterInfo -> ErrorMsg
NotHandledMsg FieldType (Required 1 (Enumeration NotHandledReason))
reason Maybe MasterInfo
info
                | Bool
otherwise -> forall a. Maybe a
Nothing

--------------------------------------------------------------------------------
maybeDecodeMessage :: Decode a => ByteString -> Maybe a
maybeDecodeMessage :: forall a. Decode a => ByteString -> Maybe a
maybeDecodeMessage ByteString
bytes =
    case forall a. Get a -> ByteString -> Either String a
runGet forall a. Decode a => Get a
decodeMessage ByteString
bytes of
        Right a
a -> forall a. a -> Maybe a
Just a
a
        Either String a
_       -> forall a. Maybe a
Nothing