{-# LANGUAGE    DeriveGeneric      #-}
{-# LANGUAGE    DataKinds          #-}
{-# OPTIONS_GHC -fcontext-stack=26 #-}
--------------------------------------------------------------------------------
-- |
-- Module : Database.EventStore.Internal.Operation.ReadEventOperation
-- Copyright : (C) 2014 Yorick Laupa
-- License : (see the file LICENSE)
--
-- Maintainer : Yorick Laupa <yo.eight@gmail.com>
-- Stability : provisional
-- Portability : non-portable
--
--------------------------------------------------------------------------------
module Database.EventStore.Internal.Operation.ReadEventOperation
    ( ReadResult(..)
    , ReadEventResult(..)
    , readEventOperation
    ) where

--------------------------------------------------------------------------------
import Control.Concurrent
import Data.Int
import GHC.Generics (Generic)

--------------------------------------------------------------------------------
import Data.ProtocolBuffers
import Data.Text

--------------------------------------------------------------------------------
import Database.EventStore.Internal.Manager.Operation
import Database.EventStore.Internal.Types

--------------------------------------------------------------------------------
data ReadEvent
    = ReadEvent
      { readEventStreamId       :: Required 1 (Value Text)
      , readEventNumber         :: Required 2 (Value Int32)
      , readEventResolveLinkTos :: Required 3 (Value Bool)
      , readEventRequireMaster  :: Required 4 (Value Bool)
      }
    deriving (Generic, Show)

--------------------------------------------------------------------------------
instance Encode ReadEvent

--------------------------------------------------------------------------------
newReadEvent :: Text -> Int32 -> Bool -> Bool -> ReadEvent
newReadEvent stream_id evt_num res_link_tos req_master =
    ReadEvent
    { readEventStreamId       = putField stream_id
    , readEventNumber         = putField evt_num
    , readEventResolveLinkTos = putField res_link_tos
    , readEventRequireMaster  = putField req_master
    }

--------------------------------------------------------------------------------
-- | Enumeration representing the status of a single event read operation.
data ReadEventResult
    = RE_SUCCESS
    | RE_NOT_FOUND
    | RE_NO_STREAM
    | RE_STREAM_DELETED
    | RE_ERROR
    | RE_ACCESS_DENIED
    deriving (Eq, Enum, Show)

--------------------------------------------------------------------------------
data ReadEventCompleted
    = ReadEventCompleted
      { readCompletedResult       :: Required 1 (Enumeration ReadEventResult)
      , readCompletedIndexedEvent :: Required 2 (Message ResolvedIndexedEvent)
      , readCompletedError        :: Optional 3 (Value Text)
      }
    deriving (Generic, Show)

--------------------------------------------------------------------------------
instance Decode ReadEventCompleted

--------------------------------------------------------------------------------
-- | Result of a single event read operation to the EventStore.
data ReadResult
    = ReadResult
      { readResultStatus        :: !ReadEventResult       -- ^ Attempt status
      , readResultStreamId      :: !Text                  -- ^ Stream name
      , readResultEventNumber   :: !Int32                 -- ^ Event number
      , readResultResolvedEvent :: !(Maybe ResolvedEvent)
      }
    deriving Show

--------------------------------------------------------------------------------
newReadResult :: ReadEventResult
              -> Text
              -> Int32
              -> ResolvedIndexedEvent
              -> ReadResult
newReadResult status stream_id evt_num rie = rr
  where
    may_re =
        case status of
            RE_SUCCESS -> Just $ newResolvedEvent rie
            _          -> Nothing

    rr = ReadResult
         { readResultStatus        = status
         , readResultStreamId      = stream_id
         , readResultEventNumber   = evt_num
         , readResultResolvedEvent = may_re
         }

--------------------------------------------------------------------------------
readEventOperation :: Settings
                   -> MVar (OperationExceptional ReadResult)
                   -> Text
                   -> Int32
                   -> Bool -- ^ Resolve link TOS
                   -> OperationParams
readEventOperation settings mvar stream_id evt_num res_link_tos =
    OperationParams
    { opSettings    = settings
    , opRequestCmd  = 0xB0
    , opResponseCmd = 0xB1

    , opRequest =
        let req_master = s_requireMaster settings
            request    = newReadEvent stream_id
                                      evt_num
                                      res_link_tos
                                      req_master in
         return request

    , opSuccess = inspect mvar stream_id evt_num
    , opFailure = failed mvar
    }

--------------------------------------------------------------------------------
inspect :: MVar (OperationExceptional ReadResult)
        -> Text
        -> Int32
        -> ReadEventCompleted
        -> IO Decision
inspect mvar stream_id evt_num reco = go (getField $ readCompletedResult reco)
  where
    may_err = getField $ readCompletedError reco

    go RE_ERROR         = failed mvar (ServerError may_err)
    go RE_ACCESS_DENIED = failed mvar (AccessDenied stream_id)
    go _                = succeed mvar stream_id evt_num reco

--------------------------------------------------------------------------------
succeed :: MVar (OperationExceptional ReadResult)
        -> Text
        -> Int32
        -> ReadEventCompleted
        -> IO Decision
succeed mvar stream_id evt_num reco = do
    putMVar mvar (Right rr)
    return EndOperation
  where
    status = getField $ readCompletedResult reco
    rie    = getField $ readCompletedIndexedEvent reco
    rr     = newReadResult status stream_id evt_num rie

--------------------------------------------------------------------------------
failed :: MVar (OperationExceptional ReadResult)
       -> OperationException
       -> IO Decision
failed mvar e = do
    putMVar mvar (Left e)
    return EndOperation