eventstore 0.1.1.0 → 0.1.2.0

raw patch · 15 files changed

+124/−57 lines, 15 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Database/EventStore.hs +11/−1
• Database/EventStore/Internal/Manager/Operation.hs +10/−9
• Database/EventStore/Internal/Manager/Subscription.hs +14/−12
• Database/EventStore/Internal/Operation/DeleteStreamOperation.hs +1/−1
• Database/EventStore/Internal/Operation/ReadAllEventsOperation.hs +2/−1
• Database/EventStore/Internal/Operation/ReadEventOperation.hs +2/−1
• Database/EventStore/Internal/Operation/ReadStreamEventsOperation.hs +2/−1
• Database/EventStore/Internal/Operation/TransactionStartOperation.hs +3/−3
• Database/EventStore/Internal/Operation/WriteEventsOperation.hs +1/−1
• Database/EventStore/Internal/Packages.hs +21/−9
• Database/EventStore/Internal/Processor.hs +9/−7
• Database/EventStore/Internal/Reader.hs +20/−1
• Database/EventStore/Internal/Types.hs +25/−7
• README.md +2/−2
• eventstore.cabal +1/−1

@@ -14,10 +14,13 @@     ( Event     , EventData     , Connection+    , Credentials     , ExpectedVersion(..)     , HostName     , Port+    , Settings(..)     , Subscription(..)+    , credentials       -- * Result     , AllEventsSlice(..)     , DeleteResult(..)@@ -25,6 +28,13 @@     , ReadResult(..)     , RecordedEvent(..)     , StreamEventsSlice(..)+    , Position(..)+    , ReadDirection(..)+    , ReadAllResult(..)+    , ReadEventResult(..)+    , ResolvedEvent(..)+    , ReadStreamResult(..)+    , DropReason(..)     , eventResolved     , resolvedEventOriginal     , resolvedEventOriginalStreamId@@ -101,7 +111,7 @@ --   this way connect :: Settings -> HostName -> Port -> IO Connection connect settings host port = do-    processor <- newProcessor 3+    processor <- newProcessor settings     processorConnect processor host port      return $ Connection processor settings

@@ -71,23 +71,23 @@       }  ---------------------------------------------------------------------------------createOperation :: OperationParams -> Operation-createOperation params =+createOperation :: Settings -> OperationParams -> Operation+createOperation sett params =     Operation-    { operationCreatePackage = createPackage params+    { operationCreatePackage = createPackage sett params     , operationInspect       = inspection params     }  ---------------------------------------------------------------------------------createPackage :: OperationParams -> UUID -> IO Package-createPackage OperationParams{..} uuid = do+createPackage :: Settings -> OperationParams -> UUID -> IO Package+createPackage Settings{..} OperationParams{..} uuid = do     req <- opRequest      let pack = Package                { packageCmd         = opRequestCmd                , packageCorrelation = uuid-               , packageFlag        = None                , packageData        = runPut $ encodeMessage req+               , packageCred        = s_credentials                }      return pack@@ -123,11 +123,12 @@ data Response = Response !Package !Operation  ---------------------------------------------------------------------------------operationNetwork :: (Package -> Reactive ())+operationNetwork :: Settings+                 -> (Package -> Reactive ())                  -> Reactive ()                  -> Event Package                  -> Reactive (OperationParams -> Reactive ())-operationNetwork push_pkg push_reco e_pkg = do+operationNetwork sett push_pkg push_reco e_pkg = do     (on_new, push_new) <- newEvent     (on_reg, push_reg) <- newEvent     (on_rem, push_rem) <- newEvent@@ -140,7 +141,7 @@      let resp_e = filterJust $ snapshot response e_pkg mgr_b -        on_new_op = fmap createOperation on_new <> on_ret+        on_new_op = fmap (createOperation sett) on_new <> on_ret          push_reg_io   = pushAsync2 $ \uuid op -> push_reg $ Register uuid op         push_rem_io   = pushAsync (push_rem . Remove)

@@ -15,7 +15,8 @@ -- -------------------------------------------------------------------------------- module Database.EventStore.Internal.Manager.Subscription-    ( Subscription(..)+    ( DropReason (..)+    , Subscription(..)     , subscriptionNetwork     ) where @@ -85,10 +86,10 @@  -------------------------------------------------------------------------------- data DropReason-    = Unsubscribed-    | AccessDenied-    | NotFound-    | PersistentSubscriptionDeleted+    = D_Unsubscribed+    | D_AccessDenied+    | D_NotFound+    | D_PersistentSubscriptionDeleted     deriving (Enum, Eq, Show)  --------------------------------------------------------------------------------@@ -215,10 +216,11 @@ type NewSubscription = (Subscription -> IO ()) -> Text -> Bool -> IO ()  ---------------------------------------------------------------------------------subscriptionNetwork :: (Package -> Reactive ())+subscriptionNetwork :: Settings+                    -> (Package -> Reactive ())                     -> Event Package                     -> Reactive NewSubscription-subscriptionNetwork push_pkg e_pkg = do+subscriptionNetwork sett push_pkg e_pkg = do     (on_sub, push_sub) <- newEvent     (on_rem, push_rem) <- newEvent @@ -247,7 +249,7 @@                      , _subResolveLinkTos = res_lnk_tos                      } -    _ <- listen on_sub (push_pkg_io . createSubscribePackage)+    _ <- listen on_sub (push_pkg_io . createSubscribePackage sett)      _ <- listen on_app $ \(Appeared sub evt) ->         atomically $ writeTChan (subEventChan sub) (Right evt)@@ -258,13 +260,13 @@     return push_sub_io  ---------------------------------------------------------------------------------createSubscribePackage :: Subscribe -> Package-createSubscribePackage Subscribe{..} =+createSubscribePackage :: Settings -> Subscribe -> Package+createSubscribePackage Settings{..} Subscribe{..} =     Package     { packageCmd         = 0xC0-    , packageFlag        = None     , packageCorrelation = _subId     , packageData        = runPut $ encodeMessage msg+    , packageCred        = s_credentials     }   where     msg = subscribeToStream _subStream _subResolveLinkTos@@ -290,7 +292,7 @@     go | packageCmd == subscriptionDropped = do              sub <- M.lookup packageCorrelation _subscriptions              msg <- maybeDecodeMessage packageData-             let reason  = fromMaybe Unsubscribed $ getField $ dropReason msg+             let reason  = fromMaybe D_Unsubscribed $ getField $ dropReason msg                  dropped = Dropped                            { droppedReason = reason                            , droppedSub    = sub

@@ -82,7 +82,7 @@     , opResponseCmd = 0x8B      , opRequest =-        let req_master  = _requireMaster settings+        let req_master  = s_requireMaster settings             exp_ver_int = expVersionInt32 exp_ver             request     = newDeleteStream stream_id                                           exp_ver_int

@@ -14,6 +14,7 @@ -------------------------------------------------------------------------------- module Database.EventStore.Internal.Operation.ReadAllEventsOperation     ( AllEventsSlice(..)+    , ReadAllResult(..)     , readAllEventsOperation     ) where @@ -135,7 +136,7 @@     , opResponseCmd = resp      , opRequest =-        let req_master = _requireMaster settings+        let req_master = s_requireMaster settings             request    = newReadAllEvents c_pos                                           p_pos                                           max_c

@@ -14,6 +14,7 @@ -------------------------------------------------------------------------------- module Database.EventStore.Internal.Operation.ReadEventOperation     ( ReadResult(..)+    , ReadEventResult(..)     , readEventOperation     ) where @@ -119,7 +120,7 @@     , opResponseCmd = 0xB1      , opRequest =-        let req_master = _requireMaster settings+        let req_master = s_requireMaster settings             request    = newReadEvent stream_id                                       evt_num                                       res_link_tos

@@ -13,6 +13,7 @@ -------------------------------------------------------------------------------- module Database.EventStore.Internal.Operation.ReadStreamEventsOperation     ( StreamEventsSlice(..)+    , ReadStreamResult(..)     , readStreamEventsOperation     ) where @@ -136,7 +137,7 @@     , opResponseCmd = resp      , opRequest =-        let req_master = _requireMaster settings+        let req_master = s_requireMaster settings             request    = newReadStreamEvents stream_id                                              start                                              cnt

@@ -52,7 +52,7 @@     , opResponseCmd = 0x85      , opRequest =-        let req_master  = _requireMaster settings+        let req_master  = s_requireMaster settings             exp_ver_int = expVersionInt32 exp_ver             request     = newTransactionStart stream_id                                               exp_ver_int@@ -164,7 +164,7 @@     }   where     settings   = _transSettings env-    req_master = _requireMaster settings+    req_master = s_requireMaster settings  -------------------------------------------------------------------------------- transactionCommitOperation :: TransactionEnv@@ -187,7 +187,7 @@     }   where     settings   = _transSettings env-    req_master = _requireMaster settings+    req_master = s_requireMaster settings  -------------------------------------------------------------------------------- inspectWrite :: TransactionEnv

@@ -87,7 +87,7 @@     , opRequest = do         new_evts <- traverse eventToNewEvent evts -        let require_master = _requireMaster settings+        let require_master = s_requireMaster settings             exp_ver_int32  = expVersionInt32 exp_ver             request        = newWriteEvents evt_stream                                                   exp_ver_int32

@@ -19,6 +19,7 @@  -------------------------------------------------------------------------------- import qualified Data.ByteString as B+import           Data.Foldable (for_)  -------------------------------------------------------------------------------- import Data.Serialize.Put@@ -36,9 +37,9 @@     uuid <- randomIO     let pack = Package                { packageCmd         = 0x01-               , packageFlag        = None                , packageCorrelation = uuid                , packageData        = B.empty+               , packageCred        = Nothing                }      return pack@@ -48,24 +49,35 @@ heartbeatResponsePackage uuid =     Package     { packageCmd         = 0x02-    , packageFlag        = None     , packageCorrelation = uuid     , packageData        = B.empty+    , packageCred        = Nothing     }  -------------------------------------------------------------------------------- putPackage :: Package -> Put-putPackage pack =-    putWord32le length_prefix    >>-    putWord8 (packageCmd pack)   >>-    putWord8 flag_word8          >>-    putLazyByteString corr_bytes >>+putPackage pack = do+    putWord32le length_prefix+    putWord8 (packageCmd pack)+    putWord8 flag_word8+    putLazyByteString corr_bytes+    for_ cred_m $ \(Credentials login passw) -> do+        putWord8 $ fromIntegral $ B.length login+        putByteString login+        putWord8 $ fromIntegral $ B.length passw+        putByteString passw     putByteString pack_data   where     pack_data     = packageData pack-    length_prefix = fromIntegral (B.length pack_data + mandatorySize)-    flag_word8    = flagWord8 $ packageFlag pack+    cred_len      = maybe 0 credSize cred_m+    length_prefix = fromIntegral (B.length pack_data + mandatorySize + cred_len)+    cred_m        = packageCred pack+    flag_word8    = maybe 0x00 (const 0x01) cred_m     corr_bytes    = toByteString $ packageCorrelation pack++--------------------------------------------------------------------------------+credSize :: Credentials -> Int+credSize (Credentials login passw) = B.length login + B.length passw + 2  -------------------------------------------------------------------------------- mandatorySize :: Int

@@ -15,6 +15,7 @@ module Database.EventStore.Internal.Processor     ( InternalException(..)     , Processor(..)+    , DropReason(..)     , Subscription(..)     , newProcessor     ) where@@ -61,8 +62,8 @@       }  ---------------------------------------------------------------------------------newProcessor :: Int -> IO Processor-newProcessor max_at = sync $ network max_at+newProcessor :: Settings -> IO Processor+newProcessor sett = sync $ network sett  -------------------------------------------------------------------------------- -- Exception@@ -108,8 +109,8 @@ heartbeatRequestCmd = 0x01  ---------------------------------------------------------------------------------network :: Int -> Reactive Processor-network max_at = do+network :: Settings -> Reactive Processor+network sett = do     (onConnect, pushConnect)         <- newEvent     (onConnected, pushConnected)     <- newEvent     (onCleanup, pushCleanup)         <- newEvent@@ -118,17 +119,18 @@     (onReceived, pushReceived)       <- newEvent     (onSend, pushSend)               <- newEvent -    push_new_op <- operationNetwork pushSend+    push_new_op <- operationNetwork sett+                                    pushSend                                     (pushReconnect Reconnect)                                     onReceived -    push_sub <- subscriptionNetwork pushSend onReceived+    push_sub <- subscriptionNetwork sett pushSend onReceived      let stateE = fmap connected  onConnected    <>                  fmap reconnected onReconnected <>                  fmap received onReceived -    stateB <- accum (initState max_at) stateE+    stateB <- accum (initState $ s_maxRetries sett) stateE      let heartbeatP pkg = packageCmd pkg == heartbeatRequestCmd         onlyHeartbeats = filterE heartbeatP onReceived

@@ -47,19 +47,24 @@ getLengthPrefix = fmap fromIntegral getWord32le  --------------------------------------------------------------------------------+authOffset :: Int+authOffset = 18++-------------------------------------------------------------------------------- getPackage :: Get Package getPackage = do     cmd  <- getWord8     flg  <- getFlag     col  <- getUUID+    cred <- getCredentials flg     rest <- remaining     dta  <- getBytes rest      let pack = Package                { packageCmd         = cmd-               , packageFlag        = flg                , packageCorrelation = col                , packageData        = dta+               , packageCred        = cred                }      return pack@@ -72,6 +77,20 @@         0x00 -> return None         0x01 -> return Authenticated         _    -> fail $ printf "TCP: Unhandled flag value 0x%x" wd++--------------------------------------------------------------------------------+getCredEntryLength :: Get Int+getCredEntryLength = fmap fromIntegral getWord8++--------------------------------------------------------------------------------+getCredentials :: Flag -> Get (Maybe Credentials)+getCredentials None = return Nothing+getCredentials _ = do+    loginLen <- getCredEntryLength+    login    <- getBytes loginLen+    passwLen <- getCredEntryLength+    passw    <- getBytes passwLen+    return $ Just $ credentials login passw  -------------------------------------------------------------------------------- getUUID :: Get UUID

@@ -454,14 +454,28 @@ flagWord8 Authenticated = 0x01  --------------------------------------------------------------------------------+-- Credentials+--------------------------------------------------------------------------------+data Credentials+    = Credentials+      { credLogin    :: !ByteString+      , credPassword :: !ByteString+      }+    deriving Show++--------------------------------------------------------------------------------+credentials :: ByteString -> ByteString -> Credentials+credentials = Credentials++-------------------------------------------------------------------------------- -- Package -------------------------------------------------------------------------------- data Package     = Package       { packageCmd         :: !Word8-      , packageFlag        :: !Flag       , packageCorrelation :: !UUID       , packageData        :: !ByteString+      , packageCred        :: !(Maybe Credentials)       }     deriving Show @@ -471,17 +485,21 @@ -- | Global @ConnectionManager@ settings data Settings     = Settings-      { _heartbeatInterval :: NominalDiffTime-      , _heartbeatTimeout  :: NominalDiffTime-      , _requireMaster     :: Bool+      { s_heartbeatInterval :: NominalDiffTime+      , s_heartbeatTimeout  :: NominalDiffTime+      , s_requireMaster     :: Bool+      , s_credentials       :: Maybe Credentials+      , s_maxRetries        :: Int       }  -------------------------------------------------------------------------------- defaultSettings :: Settings defaultSettings = Settings-                  { _heartbeatInterval = msDiffTime 750  -- 750ms-                  , _heartbeatTimeout  = msDiffTime 1500 -- 1500ms-                  , _requireMaster     = True+                  { s_heartbeatInterval = msDiffTime 750  -- 750ms+                  , s_heartbeatTimeout  = msDiffTime 1500 -- 1500ms+                  , s_requireMaster     = True+                  , s_credentials       = Nothing+                  , s_maxRetries        = 3                   }  --------------------------------------------------------------------------------

@@ -10,13 +10,13 @@   5. ReadStreamEvents (Forward and Backward)   6. ReadAllEvents (Forward and Backward)   7. Volatile subscriptions+  8. Authentication  TODO ====    1. All kind of Subscriptions-  2. Authentication-  3. SSL+  2. SSL  Requirements ============

@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.1.1.0+version:             0.1.2.0  -- A short (one-line) description of the package. synopsis: EventStore Haskell TCP Client