{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

{-# HLINT ignore "Unused LANGUAGE pragma" #-}

{- |
Module: Temporal.SearchAttributes
Description: Annotate Workflow Executions with key-value pairs for filtering and searching.

A Search Attribute is an indexed field used in a List Filter to filter a list of Workflow Executions that have the Search Attribute in their metadata.

Each Search Attribute is a key-value pair metadata object included in a Workflow Execution's Visibility information. This information is available in the Visibility store.

Note: Search Attribute values are not encrypted because the Temporal Server must be able to read these values from the Visibility store when retrieving Workflow Execution details.

Temporal provides some default Search Attributes, such as ExecutionStatus, the current state of your Workflow Executions. You can also create custom Search Attribute keys in your Visibility store and assign values when starting a Workflow Execution or in Workflow code.

When using Continue-As-New or a Temporal Cron Job, Search Attribute keys are carried over to the new Workflow Run by default. Search Attribute values are only available for as long as the Workflow is.

Search Attributes are most effective for search purposes or tasks requiring collection-based result sets. For business logic in which you need to get information about a Workflow Execution, consider one of the following:

* Storing state in a local variable and exposing it with a Query.
* Storing state in an external datastore through Activities and fetching it directly from the store.

If your business logic requires high throughput or low latency, store and fetch the data through Activities. You might experience lag due to time passing between the Workflow's state change and the Activity updating the Visibility store.

= Default Search Attributes

A Temporal Cluster has a set of default Search Attributes already available. Default Search Attributes are set globally in any Namespace. These Search Attributes are created when the initial index is created.

+--------------------------+--------------+--------------------------+
| NAME                     | TYPE         | DEFINITION               |
+==========================+==============+==========================+
| BatcherUser              | Keyword      | Used by internal batcher |
|                          |              | Workflow that runs in    |
|                          |              | @TemporalBatcher@        |
|                          |              | Namespace division to    |
|                          |              | indicate the user who    |
|                          |              | started the batch        |
|                          |              | operation.               |
+--------------------------+--------------+--------------------------+
| BinaryChecksums          | Keyword List | List of binary Ids of    |
|                          |              | Workers that run the     |
|                          |              | Workflow Execution.      |
|                          |              | Deprecated since server  |
|                          |              | version 1.21 in favor of |
|                          |              | the @BuildIds@ search    |
|                          |              | attribute.               |
+--------------------------+--------------+--------------------------+
| BuildIds                 | Keyword List | List of Worker Build Ids |
|                          |              | that have processed the  |
|                          |              | Workflow Execution,      |
|                          |              | formatted as             |
|                          |              | @versioned:{BuildId}@ or |
|                          |              | @unversioned:{BuildId}@, |
|                          |              | or the sentinel          |
|                          |              | @unversioned@ value.     |
|                          |              | Available from server    |
|                          |              | version 1.21.            |
+--------------------------+--------------+--------------------------+
| CloseTime                | Datetime     | The time at which the    |
|                          |              | Workflow Execution       |
|                          |              | completed.               |
+--------------------------+--------------+--------------------------+
| ExecutionDuration        | Int          | The time needed to run   |
|                          |              | the Workflow Execution   |
|                          |              | (in nanoseconds).        |
|                          |              | Available only for       |
|                          |              | closed Workflows.        |
+--------------------------+--------------+--------------------------+
| ExecutionStatus          | Keyword      | The current state of the |
|                          |              | Workflow Execution.      |
+--------------------------+--------------+--------------------------+
| ExecutionTime            | Datetime     | The time at which the    |
|                          |              | Workflow Execution       |
|                          |              | actually begins running; |
|                          |              | same as @StartTime@ for  |
|                          |              | most cases but different |
|                          |              | for Cron Workflows and   |
|                          |              | retried Workflows.       |
+--------------------------+--------------+--------------------------+
| HistoryLength            | Int          | The number of events in  |
|                          |              | the history of Workflow  |
|                          |              | Execution. Available     |
|                          |              | only for closed          |
|                          |              | Workflows.               |
+--------------------------+--------------+--------------------------+
| HistorySizeBytes         | Long         | The size of the Event    |
|                          |              | History.                 |
+--------------------------+--------------+--------------------------+
| RunId                    | Keyword      | Identifies the current   |
|                          |              | Workflow Execution Run.  |
+--------------------------+--------------+--------------------------+
| StartTime                | Datetime     | The time at which the    |
|                          |              | Workflow Execution       |
|                          |              | started.                 |
+--------------------------+--------------+--------------------------+
| StateTransitionCount     | Int          | The number of times that |
|                          |              | Workflow Execution has   |
|                          |              | persisted its state.     |
|                          |              | Available only for       |
|                          |              | closed Workflows.        |
+--------------------------+--------------+--------------------------+
| TaskQueue                | Keyword      | Task Queue used by       |
|                          |              | Workflow Execution.      |
+--------------------------+--------------+--------------------------+
| TemporalChangeVersion    | Keyword List | Stores change\/version   |
|                          |              | pairs if the GetVersion  |
|                          |              | API is enabled.          |
+--------------------------+--------------+--------------------------+
| Te                       | Datetime     | The time that the        |
| mporalScheduledStartTime |              | Workflow is schedule to  |
|                          |              | start according to the   |
|                          |              | Schedule Spec. Can be    |
|                          |              | manually triggered. Set  |
|                          |              | on Schedules.            |
+--------------------------+--------------+--------------------------+
| TemporalScheduledById    | Keyword      | The Id of the Schedule   |
|                          |              | that started the         |
|                          |              | Workflow.                |
+--------------------------+--------------+--------------------------+
| TemporalSchedulePaused   | Boolean      | Indicates whether the    |
|                          |              | Schedule has been        |
|                          |              | paused. Set on           |
|                          |              | Schedules.               |
+--------------------------+--------------+--------------------------+
| WorkflowId               | Keyword      | Identifies the Workflow  |
|                          |              | Execution.               |
+--------------------------+--------------+--------------------------+
| WorkflowType             | Keyword      | The type of Workflow.    |
+--------------------------+--------------+--------------------------+
-}
module Temporal.SearchAttributes where

import qualified Data.Aeson as A
import Data.Data
import Data.Int
import Data.Scientific (floatingOrInteger)
import Data.String (IsString)
import Data.Text (Text)
import Data.Time
import Data.Time.Clock
import Data.Vector (Vector)
import Data.Word
import GHC.TypeLits
import Instances.TH.Lift ()
import Language.Haskell.TH.Syntax (Lift (..))


class ToSearchAttribute a where
  toSearchAttribute :: a -> SearchAttributeType


instance ToSearchAttribute Bool where
  toSearchAttribute :: Bool -> SearchAttributeType
toSearchAttribute = Bool -> SearchAttributeType
Bool


instance ToSearchAttribute UTCTime where
  toSearchAttribute :: UTCTime -> SearchAttributeType
toSearchAttribute = UTCTime -> SearchAttributeType
Datetime


instance ToSearchAttribute Double where
  toSearchAttribute :: Double -> SearchAttributeType
toSearchAttribute = Double -> SearchAttributeType
Double


instance ToSearchAttribute Float where
  toSearchAttribute :: Float -> SearchAttributeType
toSearchAttribute = Double -> SearchAttributeType
Double (Double -> SearchAttributeType)
-> (Float -> Double) -> Float -> SearchAttributeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac


instance ToSearchAttribute Int where
  toSearchAttribute :: Int -> SearchAttributeType
toSearchAttribute = Int64 -> SearchAttributeType
Int (Int64 -> SearchAttributeType)
-> (Int -> Int64) -> Int -> SearchAttributeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral


instance ToSearchAttribute Int64 where
  toSearchAttribute :: Int64 -> SearchAttributeType
toSearchAttribute = Int64 -> SearchAttributeType
Int


instance ToSearchAttribute Int32 where
  toSearchAttribute :: Int32 -> SearchAttributeType
toSearchAttribute = Int64 -> SearchAttributeType
Int (Int64 -> SearchAttributeType)
-> (Int32 -> Int64) -> Int32 -> SearchAttributeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral


instance ToSearchAttribute Int16 where
  toSearchAttribute :: Int16 -> SearchAttributeType
toSearchAttribute = Int64 -> SearchAttributeType
Int (Int64 -> SearchAttributeType)
-> (Int16 -> Int64) -> Int16 -> SearchAttributeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral


instance ToSearchAttribute Int8 where
  toSearchAttribute :: Int8 -> SearchAttributeType
toSearchAttribute = Int64 -> SearchAttributeType
Int (Int64 -> SearchAttributeType)
-> (Int8 -> Int64) -> Int8 -> SearchAttributeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral


instance (TypeError ('Text "Converting a Word to a search attribute can cause a signed value overflow")) => ToSearchAttribute Word where
  toSearchAttribute :: Word -> SearchAttributeType
toSearchAttribute = [Char] -> Word -> SearchAttributeType
forall a. HasCallStack => [Char] -> a
error [Char]
"Converting a Word to a search attribute can cause a signed value overflow"


instance (TypeError ('Text "Converting a Word64 to a search attribute can cause a signed value overflow")) => ToSearchAttribute Word64 where
  toSearchAttribute :: Word64 -> SearchAttributeType
toSearchAttribute = [Char] -> Word64 -> SearchAttributeType
forall a. HasCallStack => [Char] -> a
error [Char]
"Converting a Word64 to a search attribute can cause a signed value overflow"


instance ToSearchAttribute Word32 where
  toSearchAttribute :: Word32 -> SearchAttributeType
toSearchAttribute = Int64 -> SearchAttributeType
Int (Int64 -> SearchAttributeType)
-> (Word32 -> Int64) -> Word32 -> SearchAttributeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral


instance ToSearchAttribute Word16 where
  toSearchAttribute :: Word16 -> SearchAttributeType
toSearchAttribute = Int64 -> SearchAttributeType
Int (Int64 -> SearchAttributeType)
-> (Word16 -> Int64) -> Word16 -> SearchAttributeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral


instance ToSearchAttribute Word8 where
  toSearchAttribute :: Word8 -> SearchAttributeType
toSearchAttribute = Int64 -> SearchAttributeType
Int (Int64 -> SearchAttributeType)
-> (Word8 -> Int64) -> Word8 -> SearchAttributeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral


instance ToSearchAttribute Text where
  toSearchAttribute :: Text -> SearchAttributeType
toSearchAttribute = Text -> SearchAttributeType
KeywordOrText


newtype SearchAttributeKey = SearchAttributeKey {SearchAttributeKey -> Text
unSearchAttributeKey :: Text}
  deriving stock (Typeable SearchAttributeKey
Typeable SearchAttributeKey =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> SearchAttributeKey
 -> c SearchAttributeKey)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SearchAttributeKey)
-> (SearchAttributeKey -> Constr)
-> (SearchAttributeKey -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SearchAttributeKey))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SearchAttributeKey))
-> ((forall b. Data b => b -> b)
    -> SearchAttributeKey -> SearchAttributeKey)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SearchAttributeKey -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SearchAttributeKey -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> SearchAttributeKey -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SearchAttributeKey -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SearchAttributeKey -> m SearchAttributeKey)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SearchAttributeKey -> m SearchAttributeKey)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SearchAttributeKey -> m SearchAttributeKey)
-> Data SearchAttributeKey
SearchAttributeKey -> Constr
SearchAttributeKey -> DataType
(forall b. Data b => b -> b)
-> SearchAttributeKey -> SearchAttributeKey
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> SearchAttributeKey -> u
forall u. (forall d. Data d => d -> u) -> SearchAttributeKey -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SearchAttributeKey -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SearchAttributeKey -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SearchAttributeKey -> m SearchAttributeKey
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SearchAttributeKey -> m SearchAttributeKey
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SearchAttributeKey
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SearchAttributeKey
-> c SearchAttributeKey
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SearchAttributeKey)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SearchAttributeKey)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SearchAttributeKey
-> c SearchAttributeKey
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SearchAttributeKey
-> c SearchAttributeKey
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SearchAttributeKey
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SearchAttributeKey
$ctoConstr :: SearchAttributeKey -> Constr
toConstr :: SearchAttributeKey -> Constr
$cdataTypeOf :: SearchAttributeKey -> DataType
dataTypeOf :: SearchAttributeKey -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SearchAttributeKey)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SearchAttributeKey)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SearchAttributeKey)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SearchAttributeKey)
$cgmapT :: (forall b. Data b => b -> b)
-> SearchAttributeKey -> SearchAttributeKey
gmapT :: (forall b. Data b => b -> b)
-> SearchAttributeKey -> SearchAttributeKey
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SearchAttributeKey -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SearchAttributeKey -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SearchAttributeKey -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SearchAttributeKey -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SearchAttributeKey -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SearchAttributeKey -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SearchAttributeKey -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SearchAttributeKey -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SearchAttributeKey -> m SearchAttributeKey
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SearchAttributeKey -> m SearchAttributeKey
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SearchAttributeKey -> m SearchAttributeKey
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SearchAttributeKey -> m SearchAttributeKey
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SearchAttributeKey -> m SearchAttributeKey
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SearchAttributeKey -> m SearchAttributeKey
Data, Int -> SearchAttributeKey -> ShowS
[SearchAttributeKey] -> ShowS
SearchAttributeKey -> [Char]
(Int -> SearchAttributeKey -> ShowS)
-> (SearchAttributeKey -> [Char])
-> ([SearchAttributeKey] -> ShowS)
-> Show SearchAttributeKey
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SearchAttributeKey -> ShowS
showsPrec :: Int -> SearchAttributeKey -> ShowS
$cshow :: SearchAttributeKey -> [Char]
show :: SearchAttributeKey -> [Char]
$cshowList :: [SearchAttributeKey] -> ShowS
showList :: [SearchAttributeKey] -> ShowS
Show, (forall (m :: * -> *). Quote m => SearchAttributeKey -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    SearchAttributeKey -> Code m SearchAttributeKey)
-> Lift SearchAttributeKey
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => SearchAttributeKey -> m Exp
forall (m :: * -> *).
Quote m =>
SearchAttributeKey -> Code m SearchAttributeKey
$clift :: forall (m :: * -> *). Quote m => SearchAttributeKey -> m Exp
lift :: forall (m :: * -> *). Quote m => SearchAttributeKey -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
SearchAttributeKey -> Code m SearchAttributeKey
liftTyped :: forall (m :: * -> *).
Quote m =>
SearchAttributeKey -> Code m SearchAttributeKey
Lift)
  deriving newtype (SearchAttributeKey -> SearchAttributeKey -> Bool
(SearchAttributeKey -> SearchAttributeKey -> Bool)
-> (SearchAttributeKey -> SearchAttributeKey -> Bool)
-> Eq SearchAttributeKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SearchAttributeKey -> SearchAttributeKey -> Bool
== :: SearchAttributeKey -> SearchAttributeKey -> Bool
$c/= :: SearchAttributeKey -> SearchAttributeKey -> Bool
/= :: SearchAttributeKey -> SearchAttributeKey -> Bool
Eq, Eq SearchAttributeKey
Eq SearchAttributeKey =>
(SearchAttributeKey -> SearchAttributeKey -> Ordering)
-> (SearchAttributeKey -> SearchAttributeKey -> Bool)
-> (SearchAttributeKey -> SearchAttributeKey -> Bool)
-> (SearchAttributeKey -> SearchAttributeKey -> Bool)
-> (SearchAttributeKey -> SearchAttributeKey -> Bool)
-> (SearchAttributeKey -> SearchAttributeKey -> SearchAttributeKey)
-> (SearchAttributeKey -> SearchAttributeKey -> SearchAttributeKey)
-> Ord SearchAttributeKey
SearchAttributeKey -> SearchAttributeKey -> Bool
SearchAttributeKey -> SearchAttributeKey -> Ordering
SearchAttributeKey -> SearchAttributeKey -> SearchAttributeKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SearchAttributeKey -> SearchAttributeKey -> Ordering
compare :: SearchAttributeKey -> SearchAttributeKey -> Ordering
$c< :: SearchAttributeKey -> SearchAttributeKey -> Bool
< :: SearchAttributeKey -> SearchAttributeKey -> Bool
$c<= :: SearchAttributeKey -> SearchAttributeKey -> Bool
<= :: SearchAttributeKey -> SearchAttributeKey -> Bool
$c> :: SearchAttributeKey -> SearchAttributeKey -> Bool
> :: SearchAttributeKey -> SearchAttributeKey -> Bool
$c>= :: SearchAttributeKey -> SearchAttributeKey -> Bool
>= :: SearchAttributeKey -> SearchAttributeKey -> Bool
$cmax :: SearchAttributeKey -> SearchAttributeKey -> SearchAttributeKey
max :: SearchAttributeKey -> SearchAttributeKey -> SearchAttributeKey
$cmin :: SearchAttributeKey -> SearchAttributeKey -> SearchAttributeKey
min :: SearchAttributeKey -> SearchAttributeKey -> SearchAttributeKey
Ord, Maybe SearchAttributeKey
Value -> Parser [SearchAttributeKey]
Value -> Parser SearchAttributeKey
(Value -> Parser SearchAttributeKey)
-> (Value -> Parser [SearchAttributeKey])
-> Maybe SearchAttributeKey
-> FromJSON SearchAttributeKey
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser SearchAttributeKey
parseJSON :: Value -> Parser SearchAttributeKey
$cparseJSONList :: Value -> Parser [SearchAttributeKey]
parseJSONList :: Value -> Parser [SearchAttributeKey]
$comittedField :: Maybe SearchAttributeKey
omittedField :: Maybe SearchAttributeKey
A.FromJSON, FromJSONKeyFunction [SearchAttributeKey]
FromJSONKeyFunction SearchAttributeKey
FromJSONKeyFunction SearchAttributeKey
-> FromJSONKeyFunction [SearchAttributeKey]
-> FromJSONKey SearchAttributeKey
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
$cfromJSONKey :: FromJSONKeyFunction SearchAttributeKey
fromJSONKey :: FromJSONKeyFunction SearchAttributeKey
$cfromJSONKeyList :: FromJSONKeyFunction [SearchAttributeKey]
fromJSONKeyList :: FromJSONKeyFunction [SearchAttributeKey]
A.FromJSONKey, [SearchAttributeKey] -> Value
[SearchAttributeKey] -> Encoding
SearchAttributeKey -> Bool
SearchAttributeKey -> Value
SearchAttributeKey -> Encoding
(SearchAttributeKey -> Value)
-> (SearchAttributeKey -> Encoding)
-> ([SearchAttributeKey] -> Value)
-> ([SearchAttributeKey] -> Encoding)
-> (SearchAttributeKey -> Bool)
-> ToJSON SearchAttributeKey
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: SearchAttributeKey -> Value
toJSON :: SearchAttributeKey -> Value
$ctoEncoding :: SearchAttributeKey -> Encoding
toEncoding :: SearchAttributeKey -> Encoding
$ctoJSONList :: [SearchAttributeKey] -> Value
toJSONList :: [SearchAttributeKey] -> Value
$ctoEncodingList :: [SearchAttributeKey] -> Encoding
toEncodingList :: [SearchAttributeKey] -> Encoding
$comitField :: SearchAttributeKey -> Bool
omitField :: SearchAttributeKey -> Bool
A.ToJSON, ToJSONKeyFunction [SearchAttributeKey]
ToJSONKeyFunction SearchAttributeKey
ToJSONKeyFunction SearchAttributeKey
-> ToJSONKeyFunction [SearchAttributeKey]
-> ToJSONKey SearchAttributeKey
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction SearchAttributeKey
toJSONKey :: ToJSONKeyFunction SearchAttributeKey
$ctoJSONKeyList :: ToJSONKeyFunction [SearchAttributeKey]
toJSONKeyList :: ToJSONKeyFunction [SearchAttributeKey]
A.ToJSONKey, [Char] -> SearchAttributeKey
([Char] -> SearchAttributeKey) -> IsString SearchAttributeKey
forall a. ([Char] -> a) -> IsString a
$cfromString :: [Char] -> SearchAttributeKey
fromString :: [Char] -> SearchAttributeKey
IsString)


{- | A search attribute is a key-value pair that can be used to filter workflows.

Search attributes are indexed by the Temporal server

See <https://docs.temporal.io/visibility#types> for more information about search attributes.
-}
data SearchAttributeType
  = Bool Bool
  | Datetime UTCTime
  | Double Double
  | Int Int64
  | -- | Keyword and Text types are concepts taken from Elasticsearch.
    -- Each word in a Text is considered a searchable keyword.
    -- For a UUID, that can be problematic because Elasticsearch
    -- indexes each portion of the UUID separately. To have the whole string
    -- considered as a searchable keyword, use the Keyword type.
    --
    -- For example, if the key ProductId has the value of 2dd29ab7-2dd8-4668-83e0-89cae261cfb1:
    --
    -- - As a Keyword it would be matched only by ProductId = "2dd29ab7-2dd8-4668-83e0-89cae261cfb1"
    -- - As a Text it would be matched by ProductId = 2dd8, which could cause unwanted matches.
    KeywordOrText Text
  | KeywordList (Vector Text)
  deriving stock (Int -> SearchAttributeType -> ShowS
[SearchAttributeType] -> ShowS
SearchAttributeType -> [Char]
(Int -> SearchAttributeType -> ShowS)
-> (SearchAttributeType -> [Char])
-> ([SearchAttributeType] -> ShowS)
-> Show SearchAttributeType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SearchAttributeType -> ShowS
showsPrec :: Int -> SearchAttributeType -> ShowS
$cshow :: SearchAttributeType -> [Char]
show :: SearchAttributeType -> [Char]
$cshowList :: [SearchAttributeType] -> ShowS
showList :: [SearchAttributeType] -> ShowS
Show, SearchAttributeType -> SearchAttributeType -> Bool
(SearchAttributeType -> SearchAttributeType -> Bool)
-> (SearchAttributeType -> SearchAttributeType -> Bool)
-> Eq SearchAttributeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SearchAttributeType -> SearchAttributeType -> Bool
== :: SearchAttributeType -> SearchAttributeType -> Bool
$c/= :: SearchAttributeType -> SearchAttributeType -> Bool
/= :: SearchAttributeType -> SearchAttributeType -> Bool
Eq, Eq SearchAttributeType
Eq SearchAttributeType =>
(SearchAttributeType -> SearchAttributeType -> Ordering)
-> (SearchAttributeType -> SearchAttributeType -> Bool)
-> (SearchAttributeType -> SearchAttributeType -> Bool)
-> (SearchAttributeType -> SearchAttributeType -> Bool)
-> (SearchAttributeType -> SearchAttributeType -> Bool)
-> (SearchAttributeType
    -> SearchAttributeType -> SearchAttributeType)
-> (SearchAttributeType
    -> SearchAttributeType -> SearchAttributeType)
-> Ord SearchAttributeType
SearchAttributeType -> SearchAttributeType -> Bool
SearchAttributeType -> SearchAttributeType -> Ordering
SearchAttributeType -> SearchAttributeType -> SearchAttributeType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SearchAttributeType -> SearchAttributeType -> Ordering
compare :: SearchAttributeType -> SearchAttributeType -> Ordering
$c< :: SearchAttributeType -> SearchAttributeType -> Bool
< :: SearchAttributeType -> SearchAttributeType -> Bool
$c<= :: SearchAttributeType -> SearchAttributeType -> Bool
<= :: SearchAttributeType -> SearchAttributeType -> Bool
$c> :: SearchAttributeType -> SearchAttributeType -> Bool
> :: SearchAttributeType -> SearchAttributeType -> Bool
$c>= :: SearchAttributeType -> SearchAttributeType -> Bool
>= :: SearchAttributeType -> SearchAttributeType -> Bool
$cmax :: SearchAttributeType -> SearchAttributeType -> SearchAttributeType
max :: SearchAttributeType -> SearchAttributeType -> SearchAttributeType
$cmin :: SearchAttributeType -> SearchAttributeType -> SearchAttributeType
min :: SearchAttributeType -> SearchAttributeType -> SearchAttributeType
Ord, (forall (m :: * -> *). Quote m => SearchAttributeType -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    SearchAttributeType -> Code m SearchAttributeType)
-> Lift SearchAttributeType
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => SearchAttributeType -> m Exp
forall (m :: * -> *).
Quote m =>
SearchAttributeType -> Code m SearchAttributeType
$clift :: forall (m :: * -> *). Quote m => SearchAttributeType -> m Exp
lift :: forall (m :: * -> *). Quote m => SearchAttributeType -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
SearchAttributeType -> Code m SearchAttributeType
liftTyped :: forall (m :: * -> *).
Quote m =>
SearchAttributeType -> Code m SearchAttributeType
Lift, Typeable SearchAttributeType
Typeable SearchAttributeType =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> SearchAttributeType
 -> c SearchAttributeType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SearchAttributeType)
-> (SearchAttributeType -> Constr)
-> (SearchAttributeType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SearchAttributeType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SearchAttributeType))
-> ((forall b. Data b => b -> b)
    -> SearchAttributeType -> SearchAttributeType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SearchAttributeType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SearchAttributeType -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> SearchAttributeType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SearchAttributeType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SearchAttributeType -> m SearchAttributeType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SearchAttributeType -> m SearchAttributeType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SearchAttributeType -> m SearchAttributeType)
-> Data SearchAttributeType
SearchAttributeType -> Constr
SearchAttributeType -> DataType
(forall b. Data b => b -> b)
-> SearchAttributeType -> SearchAttributeType
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> SearchAttributeType -> u
forall u.
(forall d. Data d => d -> u) -> SearchAttributeType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SearchAttributeType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SearchAttributeType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SearchAttributeType -> m SearchAttributeType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SearchAttributeType -> m SearchAttributeType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SearchAttributeType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SearchAttributeType
-> c SearchAttributeType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SearchAttributeType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SearchAttributeType)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SearchAttributeType
-> c SearchAttributeType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SearchAttributeType
-> c SearchAttributeType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SearchAttributeType
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SearchAttributeType
$ctoConstr :: SearchAttributeType -> Constr
toConstr :: SearchAttributeType -> Constr
$cdataTypeOf :: SearchAttributeType -> DataType
dataTypeOf :: SearchAttributeType -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SearchAttributeType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SearchAttributeType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SearchAttributeType)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SearchAttributeType)
$cgmapT :: (forall b. Data b => b -> b)
-> SearchAttributeType -> SearchAttributeType
gmapT :: (forall b. Data b => b -> b)
-> SearchAttributeType -> SearchAttributeType
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SearchAttributeType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SearchAttributeType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SearchAttributeType -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SearchAttributeType -> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> SearchAttributeType -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> SearchAttributeType -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SearchAttributeType -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SearchAttributeType -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SearchAttributeType -> m SearchAttributeType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SearchAttributeType -> m SearchAttributeType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SearchAttributeType -> m SearchAttributeType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SearchAttributeType -> m SearchAttributeType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SearchAttributeType -> m SearchAttributeType
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SearchAttributeType -> m SearchAttributeType
Data)

#if MIN_VERSION_time(1,14,0)
#else
deriving stock instance Lift UTCTime
instance Lift DiffTime where
  lift :: forall (m :: * -> *). Quote m => DiffTime -> m Exp
lift DiffTime
t = let t' :: Rational
t' = DiffTime -> Rational
forall a. Real a => a -> Rational
toRational DiffTime
t in [| fromRational t' |]
  liftTyped :: forall (m :: * -> *). Quote m => DiffTime -> Code m DiffTime
liftTyped DiffTime
t = let t' :: Rational
t' = DiffTime -> Rational
forall a. Real a => a -> Rational
toRational DiffTime
t in [|| (Rational -> a
forall a. Fractional a => Rational -> a
fromRational Rational
t' :: DiffTime) ||]
instance Lift NominalDiffTime where
  lift :: forall (m :: * -> *). Quote m => NominalDiffTime -> m Exp
lift NominalDiffTime
t = let t' :: Rational
t' = NominalDiffTime -> Rational
forall a. Real a => a -> Rational
toRational NominalDiffTime
t in [| fromRational t' |]
  liftTyped :: forall (m :: * -> *).
Quote m =>
NominalDiffTime -> Code m NominalDiffTime
liftTyped NominalDiffTime
t = let t' :: Rational
t' = NominalDiffTime -> Rational
forall a. Real a => a -> Rational
toRational NominalDiffTime
t in [|| (Rational -> a
forall a. Fractional a => Rational -> a
fromRational Rational
t' :: NominalDiffTime) ||]
instance Lift Day where
  lift :: forall (m :: * -> *). Quote m => Day -> m Exp
lift Day
t = let t' :: Integer
t' = Day -> Integer
toModifiedJulianDay Day
t in [| ModifiedJulianDay t' |]
  liftTyped :: forall (m :: * -> *). Quote m => Day -> Code m Day
liftTyped Day
t = let t' :: Integer
t' = Day -> Integer
toModifiedJulianDay Day
t in [|| Integer -> Day
ModifiedJulianDay Integer
t' ||]
#endif


instance A.ToJSON SearchAttributeType where
  toJSON :: SearchAttributeType -> Value
toJSON (Bool Bool
b) = Bool -> Value
forall a. ToJSON a => a -> Value
A.toJSON Bool
b
  toJSON (Datetime UTCTime
t) = UTCTime -> Value
forall a. ToJSON a => a -> Value
A.toJSON UTCTime
t
  toJSON (Double Double
d) = Double -> Value
forall a. ToJSON a => a -> Value
A.toJSON Double
d
  toJSON (Int Int64
i) = Int64 -> Value
forall a. ToJSON a => a -> Value
A.toJSON Int64
i
  toJSON (KeywordOrText Text
t) = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON Text
t
  toJSON (KeywordList Vector Text
ts) = Vector Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON Vector Text
ts


instance A.FromJSON SearchAttributeType where
  parseJSON :: Value -> Parser SearchAttributeType
parseJSON Value
x = case Value
x of
    A.Bool Bool
b -> SearchAttributeType -> Parser SearchAttributeType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SearchAttributeType -> Parser SearchAttributeType)
-> SearchAttributeType -> Parser SearchAttributeType
forall a b. (a -> b) -> a -> b
$ Bool -> SearchAttributeType
Bool Bool
b
    A.String Text
t -> SearchAttributeType -> Parser SearchAttributeType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SearchAttributeType -> Parser SearchAttributeType)
-> SearchAttributeType -> Parser SearchAttributeType
forall a b. (a -> b) -> a -> b
$ Text -> SearchAttributeType
KeywordOrText Text
t
    A.Number Scientific
n -> case Scientific -> Either Double Int64
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger Scientific
n of
      Left Double
d -> SearchAttributeType -> Parser SearchAttributeType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SearchAttributeType -> Parser SearchAttributeType)
-> SearchAttributeType -> Parser SearchAttributeType
forall a b. (a -> b) -> a -> b
$ Double -> SearchAttributeType
Double Double
d
      Right Int64
i -> SearchAttributeType -> Parser SearchAttributeType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SearchAttributeType -> Parser SearchAttributeType)
-> SearchAttributeType -> Parser SearchAttributeType
forall a b. (a -> b) -> a -> b
$ Int64 -> SearchAttributeType
Int Int64
i
    A.Array Array
arr -> Vector Text -> SearchAttributeType
KeywordList (Vector Text -> SearchAttributeType)
-> Parser (Vector Text) -> Parser SearchAttributeType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser Text) -> Array -> Parser (Vector Text)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
mapM Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Array
arr
    Value
_ -> [Char] -> Parser SearchAttributeType
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Invalid search attribute type"