{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DataKinds     #-}
--------------------------------------------------------------------------------
-- |
-- Module    :  Database.EventStore.Internal.Operation.Identify
-- Copyright :  (C) 2017 Yorick Laupa
-- License   :  (see the file LICENSE)
-- Maintainer:  Yorick Laupa <yo.eight@gmail.com>
-- Stability :  experimental
-- Portability: non-portable
--
--------------------------------------------------------------------------------
module Database.EventStore.Internal.Operation.Identify ( newIdentifyPkg ) where

--------------------------------------------------------------------------------
import Data.ProtocolBuffers
import Data.Serialize (runPut)

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

--------------------------------------------------------------------------------
data Request =
  Request { Request -> Required 1 (Value Int32)
_version :: Required 1 (Value Int32)
          , Request -> Optional 2 (Value Text)
_name    :: Optional 2 (Value Text)
          } deriving (forall x. Rep Request x -> Request
forall x. Request -> Rep Request x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Request x -> Request
$cfrom :: forall x. Request -> Rep Request x
Generic, Int -> Request -> ShowS
[Request] -> ShowS
Request -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Request] -> ShowS
$cshowList :: [Request] -> ShowS
show :: Request -> String
$cshow :: Request -> String
showsPrec :: Int -> Request -> ShowS
$cshowsPrec :: Int -> Request -> ShowS
Show)

--------------------------------------------------------------------------------
newRequest :: Int32 -> Text -> Request
newRequest :: Int32 -> Text -> Request
newRequest Int32
ver Text
name =
  Request { _version :: Required 1 (Value Int32)
_version = forall a. HasField a => FieldType a -> a
putField Int32
ver
          , _name :: Optional 2 (Value Text)
_name    = forall a. HasField a => FieldType a -> a
putField forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
name
          }

--------------------------------------------------------------------------------
newIdentifyPkg :: MonadBase IO m => Int32 -> Text -> m Package
newIdentifyPkg :: forall (m :: * -> *). MonadBase IO m => Int32 -> Text -> m Package
newIdentifyPkg Int32
version Text
name = do
  UUID
uuid <- forall (m :: * -> *). MonadBase IO m => m UUID
newUUID
  let msg :: Request
msg = Int32 -> Text -> Request
newRequest Int32
version Text
name
      pkg :: Package
pkg = Package { packageCmd :: Command
packageCmd         = Command
identifyClientCmd
                    , packageCorrelation :: UUID
packageCorrelation = UUID
uuid
                    , packageData :: ByteString
packageData        = Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ forall a. Encode a => a -> Put
encodeMessage Request
msg
                    , packageCred :: Maybe Credentials
packageCred        = forall a. Maybe a
Nothing
                    }

  forall (f :: * -> *) a. Applicative f => a -> f a
pure Package
pkg

--------------------------------------------------------------------------------
instance Encode Request