{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE GADTs             #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types        #-}
{-# LANGUAGE RecordWildCards   #-}
--------------------------------------------------------------------------------
-- |
-- Module : Database.EventStore.Internal.Operation.StreamMetadata
-- Copyright : (C) 2015 Yorick Laupa
-- License : (see the file LICENSE)
--
-- Maintainer : Yorick Laupa <yo.eight@gmail.com>
-- Stability : provisional
-- Portability : non-portable
--
--------------------------------------------------------------------------------
module Database.EventStore.Internal.Operation.StreamMetadata
    ( readMetaStream
    , setMetaStream
    ) where

--------------------------------------------------------------------------------
import Data.Int

--------------------------------------------------------------------------------
import Data.Aeson (decode)

--------------------------------------------------------------------------------
import Database.EventStore.Internal.Exec (Exec)
import Database.EventStore.Internal.Operation
import Database.EventStore.Internal.Operation.Read.Common
import Database.EventStore.Internal.Operation.ReadEvent
import Database.EventStore.Internal.Operation.Write.Common
import Database.EventStore.Internal.Operation.WriteEvents
import Database.EventStore.Internal.Prelude
import Database.EventStore.Internal.Settings
import Database.EventStore.Internal.Types

--------------------------------------------------------------------------------
metaStream :: Text -> Text
metaStream :: Text -> Text
metaStream Text
s = Text
"$$" forall a. Semigroup a => a -> a -> a
<> Text
s

--------------------------------------------------------------------------------
-- | Read stream metadata operation.
readMetaStream
  :: Settings
  -> Exec
  -> Text
  -> Maybe Credentials
  -> IO (Async StreamMetadataResult)
readMetaStream :: Settings
-> Exec
-> Text
-> Maybe Credentials
-> IO (Async StreamMetadataResult)
readMetaStream Settings
setts Exec
exec Text
s Maybe Credentials
cred
  = forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> m (Async (StM m a))
async forall a b. (a -> b) -> a -> b
$
      do Async (ReadResult EventNumber ReadEvent)
as <- Settings
-> Exec
-> Text
-> Int64
-> Bool
-> Maybe Credentials
-> IO (Async (ReadResult EventNumber ReadEvent))
readEvent Settings
setts Exec
exec (Text -> Text
metaStream Text
s) (-Int64
1) Bool
False Maybe Credentials
cred
         ReadResult EventNumber ReadEvent
tmp <- forall (m :: * -> *) a.
MonadBaseControl IO m =>
Async (StM m a) -> m a
wait Async (ReadResult EventNumber ReadEvent)
as
         forall a.
ReadResult EventNumber ReadEvent
-> (Text -> Int64 -> ResolvedEvent -> IO a) -> IO a
onReadResult ReadResult EventNumber ReadEvent
tmp forall a b. (a -> b) -> a -> b
$ \Text
n Int64
evtNum ResolvedEvent
evt ->
           do let bytes :: ByteString
bytes = RecordedEvent -> ByteString
recordedEventData forall a b. (a -> b) -> a -> b
$ ResolvedEvent -> RecordedEvent
resolvedEventOriginal ResolvedEvent
evt
              case forall a. FromJSON a => ByteString -> Maybe a
decode forall a b. (a -> b) -> a -> b
$ forall lazy strict. LazySequence lazy strict => strict -> lazy
fromStrict ByteString
bytes of
                Just StreamMetadata
pv -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Int64 -> StreamMetadata -> StreamMetadataResult
StreamMetadataResult Text
n Int64
evtNum StreamMetadata
pv
                Maybe StreamMetadata
Nothing -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw OperationError
invalidFormat

--------------------------------------------------------------------------------
-- | Set stream metadata operation.
setMetaStream
  :: Settings
  -> Exec
  -> Text
  -> ExpectedVersion
  -> Maybe Credentials
  -> StreamMetadata
  -> IO (Async WriteResult)
setMetaStream :: Settings
-> Exec
-> Text
-> ExpectedVersion
-> Maybe Credentials
-> StreamMetadata
-> IO (Async WriteResult)
setMetaStream Settings
setts Exec
exec Text
s ExpectedVersion
v Maybe Credentials
cred StreamMetadata
meta
  = let stream :: Text
stream = Text -> Text
metaStream Text
s
        json :: Value
json   = StreamMetadata -> Value
streamMetadataJSON StreamMetadata
meta
        evt :: Event
evt    = EventType -> Maybe UUID -> EventData -> Event
createEvent EventType
StreamMetadataType forall a. Maybe a
Nothing (forall a. ToJSON a => a -> EventData
withJson Value
json) in
    Settings
-> Exec
-> Text
-> ExpectedVersion
-> Maybe Credentials
-> [Event]
-> IO (Async WriteResult)
writeEvents Settings
setts Exec
exec Text
stream ExpectedVersion
v Maybe Credentials
cred [Event
evt]

--------------------------------------------------------------------------------
invalidFormat :: OperationError
invalidFormat :: OperationError
invalidFormat = Text -> OperationError
InvalidOperation Text
"Invalid metadata format"

--------------------------------------------------------------------------------
streamNotFound :: OperationError
streamNotFound :: OperationError
streamNotFound = Text -> OperationError
InvalidOperation Text
"Read metadata on an inexistant stream"

--------------------------------------------------------------------------------
onReadResult :: ReadResult EventNumber ReadEvent
             -> (Text -> Int64 -> ResolvedEvent -> IO a)
             -> IO a
onReadResult :: forall a.
ReadResult EventNumber ReadEvent
-> (Text -> Int64 -> ResolvedEvent -> IO a) -> IO a
onReadResult (ReadSuccess ReadEvent
r) Text -> Int64 -> ResolvedEvent -> IO a
k =
    case ReadEvent
r of
      ReadEvent Text
s Int64
n ResolvedEvent
e -> Text -> Int64 -> ResolvedEvent -> IO a
k Text
s Int64
n ResolvedEvent
e
      ReadEvent
_ -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw OperationError
streamNotFound

onReadResult ReadResult EventNumber ReadEvent
ReadNoStream Text -> Int64 -> ResolvedEvent -> IO a
_          = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw OperationError
streamNotFound
onReadResult (ReadStreamDeleted StreamName
s) Text -> Int64 -> ResolvedEvent -> IO a
_ = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw forall a b. (a -> b) -> a -> b
$ StreamName -> OperationError
StreamDeleted StreamName
s
onReadResult ReadResult EventNumber ReadEvent
ReadNotModified Text -> Int64 -> ResolvedEvent -> IO a
_       = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw forall a b. (a -> b) -> a -> b
$ Maybe Text -> OperationError
ServerError forall a. Maybe a
Nothing
onReadResult (ReadError Maybe Text
e) Text -> Int64 -> ResolvedEvent -> IO a
_         = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw forall a b. (a -> b) -> a -> b
$ Maybe Text -> OperationError
ServerError Maybe Text
e
onReadResult (ReadAccessDenied StreamName
s) Text -> Int64 -> ResolvedEvent -> IO a
_  = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw forall a b. (a -> b) -> a -> b
$ forall t. StreamId t -> OperationError
AccessDenied StreamName
s