{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
module Database.EventStore.Internal.Command where
import Database.EventStore.Internal.Prelude
import Database.EventStore.Internal.Utils
data Command =
Command { Command -> Word8
cmdWord8 :: !Word8
, Command -> Text
cmdDesc :: !Text
}
instance Show Command where
show :: Command -> String
show Command
c = String
"(" forall a. Semigroup a => a -> a -> a
<> Word8 -> String
prettyWord8 (Command -> Word8
cmdWord8 Command
c) forall a. Semigroup a => a -> a -> a
<> String
")" forall a. Semigroup a => a -> a -> a
<> forall mono. MonoFoldable mono => mono -> [Element mono]
unpack (Command -> Text
cmdDesc Command
c)
instance Eq Command where
Command
c1 == :: Command -> Command -> Bool
== Command
c2 = Command -> Word8
cmdWord8 Command
c1 forall a. Eq a => a -> a -> Bool
== Command -> Word8
cmdWord8 Command
c2
instance Ord Command where
compare :: Command -> Command -> Ordering
compare Command
c1 Command
c2 = forall a. Ord a => a -> a -> Ordering
compare (Command -> Word8
cmdWord8 Command
c1) (Command -> Word8
cmdWord8 Command
c2)
heartbeatRequestCmd :: Command
heartbeatRequestCmd :: Command
heartbeatRequestCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0x01
, cmdDesc :: Text
cmdDesc = Text
"[heartbeat-request]"
}
heartbeatResponseCmd :: Command
heartbeatResponseCmd :: Command
heartbeatResponseCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0x02
, cmdDesc :: Text
cmdDesc = Text
"[heartbeat-response]"
}
writeEventsCmd :: Command
writeEventsCmd :: Command
writeEventsCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0x82
, cmdDesc :: Text
cmdDesc = Text
"[write-events]"
}
writeEventsCompletedCmd :: Command
writeEventsCompletedCmd :: Command
writeEventsCompletedCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0x83
, cmdDesc :: Text
cmdDesc = Text
"[write-events-completed]"
}
transactionStartCmd :: Command
transactionStartCmd :: Command
transactionStartCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0x84
, cmdDesc :: Text
cmdDesc = Text
"[transaction-start]"
}
transactionStartCompletedCmd :: Command
transactionStartCompletedCmd :: Command
transactionStartCompletedCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0x85
, cmdDesc :: Text
cmdDesc = Text
"[transaction-start-completed]"
}
transactionWriteCmd :: Command
transactionWriteCmd :: Command
transactionWriteCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0x86
, cmdDesc :: Text
cmdDesc = Text
"[transaction-write]"
}
transactionWriteCompletedCmd :: Command
transactionWriteCompletedCmd :: Command
transactionWriteCompletedCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0x87
, cmdDesc :: Text
cmdDesc = Text
"[transaction-write-completed]"
}
transactionCommitCmd :: Command
transactionCommitCmd :: Command
transactionCommitCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0x88
, cmdDesc :: Text
cmdDesc = Text
"[transaction-commit]"
}
transactionCommitCompletedCmd :: Command
transactionCommitCompletedCmd :: Command
transactionCommitCompletedCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0x89
, cmdDesc :: Text
cmdDesc = Text
"[transaction-commit-completed]"
}
deleteStreamCmd :: Command
deleteStreamCmd :: Command
deleteStreamCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0x8A
, cmdDesc :: Text
cmdDesc = Text
"[delete-stream]"
}
deleteStreamCompletedCmd :: Command
deleteStreamCompletedCmd :: Command
deleteStreamCompletedCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0x8B
, cmdDesc :: Text
cmdDesc = Text
"[delete-stream-completed]"
}
readEventCmd :: Command
readEventCmd :: Command
readEventCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0xB0
, cmdDesc :: Text
cmdDesc = Text
"[read-event]"
}
readEventCompletedCmd :: Command
readEventCompletedCmd :: Command
readEventCompletedCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0xB1
, cmdDesc :: Text
cmdDesc = Text
"[read-event-completed]"
}
readStreamEventsForwardCmd :: Command
readStreamEventsForwardCmd :: Command
readStreamEventsForwardCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0xB2
, cmdDesc :: Text
cmdDesc = Text
"[read-stream-events-forward]"
}
readStreamEventsForwardCompletedCmd :: Command
readStreamEventsForwardCompletedCmd :: Command
readStreamEventsForwardCompletedCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0xB3
, cmdDesc :: Text
cmdDesc = Text
"[read-stream-events-forward-completed]"
}
readStreamEventsBackwardCmd :: Command
readStreamEventsBackwardCmd :: Command
readStreamEventsBackwardCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0xB4
, cmdDesc :: Text
cmdDesc = Text
"[read-stream-events-backward]"
}
readStreamEventsBackwardCompletedCmd :: Command
readStreamEventsBackwardCompletedCmd :: Command
readStreamEventsBackwardCompletedCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0xB5
, cmdDesc :: Text
cmdDesc = Text
"[read-stream-events-backward]"
}
readAllEventsForwardCmd :: Command
readAllEventsForwardCmd :: Command
readAllEventsForwardCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0xB6
, cmdDesc :: Text
cmdDesc = Text
"[read-all-events-forward]"
}
readAllEventsForwardCompletedCmd :: Command
readAllEventsForwardCompletedCmd :: Command
readAllEventsForwardCompletedCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0xB7
, cmdDesc :: Text
cmdDesc = Text
"[read-all-events-forward-completed]"
}
readAllEventsBackwardCmd :: Command
readAllEventsBackwardCmd :: Command
readAllEventsBackwardCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0xB8
, cmdDesc :: Text
cmdDesc = Text
"[read-all-events-backward]"
}
readAllEventsBackwardCompletedCmd :: Command
readAllEventsBackwardCompletedCmd :: Command
readAllEventsBackwardCompletedCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0xB9
, cmdDesc :: Text
cmdDesc = Text
"[read-all-events-backward-completed]"
}
subscribeToStreamCmd :: Command
subscribeToStreamCmd :: Command
subscribeToStreamCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0xC0
, cmdDesc :: Text
cmdDesc = Text
"[subscribe-to-stream]"
}
subscriptionConfirmationCmd :: Command
subscriptionConfirmationCmd :: Command
subscriptionConfirmationCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0xC1
, cmdDesc :: Text
cmdDesc = Text
"[subscription-confirmation]"
}
streamEventAppearedCmd :: Command
streamEventAppearedCmd :: Command
streamEventAppearedCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0xC2
, cmdDesc :: Text
cmdDesc = Text
"[stream-event-appeared]"
}
unsubscribeFromStreamCmd :: Command
unsubscribeFromStreamCmd :: Command
unsubscribeFromStreamCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0xC3
, cmdDesc :: Text
cmdDesc = Text
"[unsubscribe-from-stream]"
}
subscriptionDroppedCmd :: Command
subscriptionDroppedCmd :: Command
subscriptionDroppedCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0xC4
, cmdDesc :: Text
cmdDesc = Text
"[subscription-dropped]"
}
connectToPersistentSubscriptionCmd :: Command
connectToPersistentSubscriptionCmd :: Command
connectToPersistentSubscriptionCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0xC5
, cmdDesc :: Text
cmdDesc = Text
"[connect-to-persistent-subscription]"
}
persistentSubscriptionConfirmationCmd :: Command
persistentSubscriptionConfirmationCmd :: Command
persistentSubscriptionConfirmationCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0xC6
, cmdDesc :: Text
cmdDesc = Text
"[persistent-subscription-confirmation]"
}
persistentSubscriptionStreamEventAppearedCmd :: Command
persistentSubscriptionStreamEventAppearedCmd :: Command
persistentSubscriptionStreamEventAppearedCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0xC7
, cmdDesc :: Text
cmdDesc = Text
"[persistent-subscription-stream-event-appeared]"
}
createPersistentSubscriptionCmd :: Command
createPersistentSubscriptionCmd :: Command
createPersistentSubscriptionCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0xC8
, cmdDesc :: Text
cmdDesc = Text
"[create-persistent-subscription]"
}
createPersistentSubscriptionCompletedCmd :: Command
createPersistentSubscriptionCompletedCmd :: Command
createPersistentSubscriptionCompletedCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0xC9
, cmdDesc :: Text
cmdDesc = Text
"[create-persistent-subscription-completed]"
}
deletePersistentSubscriptionCmd :: Command
deletePersistentSubscriptionCmd :: Command
deletePersistentSubscriptionCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0xCA
, cmdDesc :: Text
cmdDesc = Text
"[delete-persistent-subscription]"
}
deletePersistentSubscriptionCompletedCmd :: Command
deletePersistentSubscriptionCompletedCmd :: Command
deletePersistentSubscriptionCompletedCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0xCB
, cmdDesc :: Text
cmdDesc = Text
"[delete-persistent-subscription-completed]"
}
persistentSubscriptionAckEventsCmd :: Command
persistentSubscriptionAckEventsCmd :: Command
persistentSubscriptionAckEventsCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0xCC
, cmdDesc :: Text
cmdDesc = Text
"[persistent-subscription-ack-events]"
}
persistentSubscriptionNakEventsCmd :: Command
persistentSubscriptionNakEventsCmd :: Command
persistentSubscriptionNakEventsCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0xCD
, cmdDesc :: Text
cmdDesc = Text
"[persistent-subscription-nak-events]"
}
updatePersistentSubscriptionCmd :: Command
updatePersistentSubscriptionCmd :: Command
updatePersistentSubscriptionCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0xCE
, cmdDesc :: Text
cmdDesc = Text
"[update-persistent-subscription]"
}
updatePersistentSubscriptionCompletedCmd :: Command
updatePersistentSubscriptionCompletedCmd :: Command
updatePersistentSubscriptionCompletedCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0xCF
, cmdDesc :: Text
cmdDesc = Text
"[update-persistent-subscription-completed]"
}
badRequestCmd :: Command
badRequestCmd :: Command
badRequestCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0xF0
, cmdDesc :: Text
cmdDesc = Text
"[bad-request]"
}
notHandledCmd :: Command
notHandledCmd :: Command
notHandledCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0xF1
, cmdDesc :: Text
cmdDesc = Text
"[not-handled]"
}
authenticateCmd :: Command
authenticateCmd :: Command
authenticateCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0xF2
, cmdDesc :: Text
cmdDesc = Text
"[authenticate]"
}
authenticatedCmd :: Command
authenticatedCmd :: Command
authenticatedCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0xF3
, cmdDesc :: Text
cmdDesc = Text
"[authenticated]"
}
notAuthenticatedCmd :: Command
notAuthenticatedCmd :: Command
notAuthenticatedCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0xF4
, cmdDesc :: Text
cmdDesc = Text
"[not-authenticated]"
}
identifyClientCmd :: Command
identifyClientCmd :: Command
identifyClientCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0xF5
, cmdDesc :: Text
cmdDesc = Text
"[identify-client]"
}
clientIdentifiedCmd :: Command
clientIdentifiedCmd :: Command
clientIdentifiedCmd =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
0xF6
, cmdDesc :: Text
cmdDesc = Text
"[client-identified]"
}
unknownCmd :: Word8 -> Command
unknownCmd :: Word8 -> Command
unknownCmd Word8
w =
Command { cmdWord8 :: Word8
cmdWord8 = Word8
w
, cmdDesc :: Text
cmdDesc = Text
"[unknown: "forall a. Semigroup a => a -> a -> a
<> forall seq. IsSequence seq => [Element seq] -> seq
pack (Word8 -> String
prettyWord8 Word8
w) forall a. Semigroup a => a -> a -> a
<> Text
"]"
}
getCommand :: Word8 -> Command
getCommand :: Word8 -> Command
getCommand Word8
w =
case forall map.
IsMap map =>
ContainerKey map -> map -> Maybe (MapValue map)
lookup Word8
w HashMap Word8 Command
_cmdDict of
Just MapValue (HashMap Word8 Command)
cmd -> MapValue (HashMap Word8 Command)
cmd
Maybe (MapValue (HashMap Word8 Command))
Nothing -> Word8 -> Command
unknownCmd Word8
w
_cmdDict :: HashMap Word8 Command
_cmdDict :: HashMap Word8 Command
_cmdDict = forall map. IsMap map => [(ContainerKey map, MapValue map)] -> map
mapFromList
[ (Word8
0x01, Command
heartbeatRequestCmd)
, (Word8
0x02, Command
heartbeatResponseCmd)
, (Word8
0x82, Command
writeEventsCmd)
, (Word8
0x83, Command
writeEventsCompletedCmd)
, (Word8
0x84, Command
transactionStartCmd)
, (Word8
0x85, Command
transactionStartCompletedCmd)
, (Word8
0x86, Command
transactionWriteCmd)
, (Word8
0x87, Command
transactionWriteCompletedCmd)
, (Word8
0x88, Command
transactionCommitCmd)
, (Word8
0x89, Command
transactionCommitCompletedCmd)
, (Word8
0x8A, Command
deleteStreamCmd)
, (Word8
0x8B, Command
deleteStreamCompletedCmd)
, (Word8
0xB0, Command
readEventCmd)
, (Word8
0xB1, Command
readEventCompletedCmd)
, (Word8
0xB2, Command
readStreamEventsForwardCmd)
, (Word8
0xB3, Command
readStreamEventsForwardCompletedCmd)
, (Word8
0xB4, Command
readStreamEventsBackwardCmd)
, (Word8
0xB5, Command
readStreamEventsBackwardCompletedCmd)
, (Word8
0xB6, Command
readAllEventsForwardCmd)
, (Word8
0xB7, Command
readAllEventsForwardCompletedCmd)
, (Word8
0xB8, Command
readAllEventsBackwardCmd)
, (Word8
0xB9, Command
readAllEventsBackwardCompletedCmd)
, (Word8
0xC0, Command
subscribeToStreamCmd)
, (Word8
0xC1, Command
subscriptionConfirmationCmd)
, (Word8
0xC2, Command
streamEventAppearedCmd)
, (Word8
0xC3, Command
unsubscribeFromStreamCmd)
, (Word8
0xC4, Command
subscriptionDroppedCmd)
, (Word8
0xC5, Command
connectToPersistentSubscriptionCmd)
, (Word8
0xC6, Command
persistentSubscriptionConfirmationCmd)
, (Word8
0xC7, Command
persistentSubscriptionStreamEventAppearedCmd)
, (Word8
0xC8, Command
createPersistentSubscriptionCmd)
, (Word8
0xC9, Command
createPersistentSubscriptionCompletedCmd)
, (Word8
0xCA, Command
deletePersistentSubscriptionCmd)
, (Word8
0xCB, Command
deletePersistentSubscriptionCompletedCmd)
, (Word8
0xCC, Command
persistentSubscriptionAckEventsCmd)
, (Word8
0xCD, Command
persistentSubscriptionNakEventsCmd)
, (Word8
0xCE, Command
updatePersistentSubscriptionCmd)
, (Word8
0xCF, Command
updatePersistentSubscriptionCompletedCmd)
, (Word8
0xF0, Command
badRequestCmd)
, (Word8
0xF1, Command
notHandledCmd)
, (Word8
0xF2, Command
authenticateCmd)
, (Word8
0xF3, Command
authenticatedCmd)
, (Word8
0xF4, Command
notAuthenticatedCmd)
, (Word8
0xF5, Command
identifyClientCmd)
, (Word8
0xF6, Command
clientIdentifiedCmd)
]