{-# LANGUAGE ApplicativeDo #-}

-- | Internal module. Not part of the public API.
module Database.Bolty.Message.Request
  ( Request(..)
  , Hello(..)
  , Logon(..)
  , TelemetryApi(..)
  , RunExplicitTransaction(..)
  , RunAutoCommitTransaction(..), defaultRunAutoCommitTransaction, mkRunAutoCommit
  , Discard(..)
  , Begin(..)
  , Pull(..), defaultPull
  , Route(..)
  , RouteExtra(..)
  , RunExtra(..), defaultRunExtra
  ) where

import           Data.HashMap.Lazy              (HashMap)
import           Data.Int                      (Int64)
import           Data.Kind                     (Type)
import           GHC.Generics                  (Generic)
import qualified Data.HashMap.Lazy             as H
import qualified Data.Text                     as T
import qualified Data.Vector                   as V

import           Data.PackStream
import           Data.PackStream.Integer       (toPSInteger, fromPSInteger)
import           Database.Bolty.Connection.Instances ()
import           Database.Bolty.Connection.Type (UserAgent(..), Scheme(..), Routing(..))


-- | A BOLT client request message.
type Request :: Type
data Request
  = RHello Hello
  | RGoodbye
  | RReset
  | RRunExplicitTransaction RunExplicitTransaction
  | RRunAutoCommitTransaction RunAutoCommitTransaction
  | RDiscard Discard
  | RPull Pull
  | RBegin Begin
  | RCommit
  | RRollback
  | RRoute Route
  | RLogon Logon
  | RLogoff
  | RTelemetry TelemetryApi
  deriving stock ((forall x. Request -> Rep Request x)
-> (forall x. Rep Request x -> Request) -> Generic Request
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
$cfrom :: forall x. Request -> Rep Request x
from :: forall x. Request -> Rep Request x
$cto :: forall x. Rep Request x -> Request
to :: forall x. Rep Request x -> Request
Generic)


instance PackStream Request where
  toPs :: Request -> Ps
toPs (RHello Hello
hello) = Tag -> Ps -> Ps
structureSingleton Tag
0x01 (Ps -> Ps) -> Ps -> Ps
forall a b. (a -> b) -> a -> b
$ Hello -> Ps
forall a. PackStream a => a -> Ps
toPs Hello
hello
  toPs (Request
RGoodbye) = Tag -> Vector Ps -> Ps
PsStructure Tag
0x02 Vector Ps
forall a. Vector a
V.empty
  toPs (Request
RReset) = Tag -> Vector Ps -> Ps
PsStructure Tag
0x0F Vector Ps
forall a. Vector a
V.empty
  toPs (RRunExplicitTransaction RunExplicitTransaction
x) = RunExplicitTransaction -> Ps
runExplicitTransactionToPs RunExplicitTransaction
x
  toPs (RRunAutoCommitTransaction RunAutoCommitTransaction
x) = RunAutoCommitTransaction -> Ps
runAutoCommitTransactiontoPs RunAutoCommitTransaction
x
  toPs (RDiscard Discard
discard) = Tag -> Ps -> Ps
structureSingleton Tag
0x2F (Ps -> Ps) -> Ps -> Ps
forall a b. (a -> b) -> a -> b
$ Discard -> Ps
forall a. PackStream a => a -> Ps
toPs Discard
discard
  toPs (RPull Pull
pull) = Tag -> Ps -> Ps
structureSingleton Tag
0x3F (Ps -> Ps) -> Ps -> Ps
forall a b. (a -> b) -> a -> b
$ Pull -> Ps
forall a. PackStream a => a -> Ps
toPs Pull
pull
  toPs (RBegin Begin
begin) = Tag -> Ps -> Ps
structureSingleton Tag
0x11 (Ps -> Ps) -> Ps -> Ps
forall a b. (a -> b) -> a -> b
$ Begin -> Ps
forall a. PackStream a => a -> Ps
toPs Begin
begin
  toPs (Request
RCommit) = Tag -> Vector Ps -> Ps
PsStructure Tag
0x12 Vector Ps
forall a. Vector a
V.empty
  toPs (Request
RRollback) = Tag -> Vector Ps -> Ps
PsStructure Tag
0x13 Vector Ps
forall a. Vector a
V.empty
  toPs (RRoute Route
route) = Route -> Ps
routeToPs Route
route
  toPs (RLogon Logon
logon) = Tag -> Ps -> Ps
structureSingleton Tag
0x6A (Ps -> Ps) -> Ps -> Ps
forall a b. (a -> b) -> a -> b
$ Logon -> Ps
logonToPs Logon
logon
  toPs (Request
RLogoff) = Tag -> Vector Ps -> Ps
PsStructure Tag
0x6B Vector Ps
forall a. Vector a
V.empty
  toPs (RTelemetry TelemetryApi
api) = Tag -> Vector Ps -> Ps
PsStructure Tag
0x54 (Vector Ps -> Ps) -> Vector Ps -> Ps
forall a b. (a -> b) -> a -> b
$ Ps -> Vector Ps
forall a. a -> Vector a
V.singleton (Ps -> Vector Ps) -> Ps -> Vector Ps
forall a b. (a -> b) -> a -> b
$ PSInteger -> Ps
PsInteger (PSInteger -> Ps) -> PSInteger -> Ps
forall a b. (a -> b) -> a -> b
$ Int64 -> PSInteger
forall a. ToPSInteger a => a -> PSInteger
toPSInteger (Int64 -> PSInteger) -> Int64 -> PSInteger
forall a b. (a -> b) -> a -> b
$ TelemetryApi -> Int64
telemetryApiToInt TelemetryApi
api
  fromPs :: Ps -> Result Request
fromPs (PsStructure Tag
0x01 Vector Ps
fields) = Vector Ps -> (Hello -> Request) -> Text -> Result Request
forall a b.
PackStream a =>
Vector Ps -> (a -> b) -> Text -> Result b
fromOneField Vector Ps
fields Hello -> Request
RHello Text
"expected exactly one field for Hello"
  fromPs (PsStructure Tag
0x02 Vector Ps
fields) = if Vector Ps -> Bool
forall a. Vector a -> Bool
V.null Vector Ps
fields then Request -> Result Request
forall a. a -> Result a
Success Request
RGoodbye else Text -> Result Request
forall a. Text -> Result a
Error Text
"additional data on RGoodbye request is not allowed"
  fromPs (PsStructure Tag
0x0F Vector Ps
fields) = if Vector Ps -> Bool
forall a. Vector a -> Bool
V.null Vector Ps
fields then Request -> Result Request
forall a. a -> Result a
Success Request
RReset else Text -> Result Request
forall a. Text -> Result a
Error Text
"additional data on RReset request is not allowed"
  fromPs (PsStructure Tag
0x10 Vector Ps
fields) = Vector Ps -> Result Request
fromPsToRunRequest Vector Ps
fields
  fromPs (PsStructure Tag
0x2F Vector Ps
fields) = Vector Ps -> (Discard -> Request) -> Text -> Result Request
forall a b.
PackStream a =>
Vector Ps -> (a -> b) -> Text -> Result b
fromOneField Vector Ps
fields Discard -> Request
RDiscard Text
"expected exactly one field for Discard"
  fromPs (PsStructure Tag
0x3F Vector Ps
fields) = Vector Ps -> (Pull -> Request) -> Text -> Result Request
forall a b.
PackStream a =>
Vector Ps -> (a -> b) -> Text -> Result b
fromOneField Vector Ps
fields Pull -> Request
RPull Text
"expected exactly one field for Pull"
  fromPs (PsStructure Tag
0x11 Vector Ps
fields) = Vector Ps -> (Begin -> Request) -> Text -> Result Request
forall a b.
PackStream a =>
Vector Ps -> (a -> b) -> Text -> Result b
fromOneField Vector Ps
fields Begin -> Request
RBegin Text
"expected exactly one field for Begin"
  fromPs (PsStructure Tag
0x12 Vector Ps
fields) = if Vector Ps -> Bool
forall a. Vector a -> Bool
V.null Vector Ps
fields then Request -> Result Request
forall a. a -> Result a
Success Request
RCommit else Text -> Result Request
forall a. Text -> Result a
Error Text
"additional data on RCommit request is not allowed"
  fromPs (PsStructure Tag
0x13 Vector Ps
fields) = if Vector Ps -> Bool
forall a. Vector a -> Bool
V.null Vector Ps
fields then Request -> Result Request
forall a. a -> Result a
Success Request
RRollback else Text -> Result Request
forall a. Text -> Result a
Error Text
"additional data on RRollback request is not allowed"
  fromPs (PsStructure Tag
0x66 Vector Ps
fields) = Vector Ps -> Result Request
fromPsToRoute Vector Ps
fields
  fromPs (PsStructure Tag
0x6A Vector Ps
fields) = Vector Ps -> (Logon -> Request) -> Text -> Result Request
forall a b.
PackStream a =>
Vector Ps -> (a -> b) -> Text -> Result b
fromOneField Vector Ps
fields Logon -> Request
RLogon Text
"expected exactly one field for Logon"
  fromPs (PsStructure Tag
0x6B Vector Ps
fields) = if Vector Ps -> Bool
forall a. Vector a -> Bool
V.null Vector Ps
fields then Request -> Result Request
forall a. a -> Result a
Success Request
RLogoff else Text -> Result Request
forall a. Text -> Result a
Error Text
"additional data on RLogoff request is not allowed"
  fromPs (PsStructure Tag
0x54 Vector Ps
fields) = Vector Ps -> Result Request
fromPsToTelemetry Vector Ps
fields
  fromPs Ps
_                         = Text -> Result Request
forall a. Text -> Result a
Error Text
"Could not decode Request"


fromPsToRunRequest :: V.Vector Ps -> Result Request
fromPsToRunRequest :: Vector Ps -> Result Request
fromPsToRunRequest Vector Ps
fields =
    if Vector Ps -> Int
forall a. Vector a -> Int
V.length Vector Ps
fields Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1 then
      Text -> Result Request
forall a. Text -> Result a
Error Text
"expected exactly one field for Run"
    else do
      HashMap Text Ps
arg <- Ps -> Result (HashMap Text Ps)
forall a. PackStream a => Ps -> Result a
fromPs (Ps -> Result (HashMap Text Ps)) -> Ps -> Result (HashMap Text Ps)
forall a b. (a -> b) -> a -> b
$ Vector Ps -> Ps
forall a. Vector a -> a
V.unsafeHead Vector Ps
fields
      HashMap Text Ps -> Result Request
f HashMap Text Ps
arg
  where f :: H.HashMap T.Text Ps -> Result Request
        f :: HashMap Text Ps -> Result Request
f HashMap Text Ps
map = if (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Text
f -> Text -> HashMap Text Ps -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
H.member Text
f HashMap Text Ps
map) [Text
"bookmarks", Text
"tx_timeout", Text
"tx_metadata", Text
"mode", Text
"db", Text
"imp_user"] then do
                  Text
query       :: T.Text              <- Text -> HashMap Text Ps -> Text -> Result Text
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Text -> Result v
lookupWithError Text
"query" HashMap Text Ps
map Text
"\"query\" not found in Run Request"
                  HashMap Text Ps
parameters  :: H.HashMap T.Text Ps <- Text -> HashMap Text Ps -> Text -> Result (HashMap Text Ps)
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Text -> Result v
lookupWithError Text
"parameters" HashMap Text Ps
map Text
"\"parameters\" not found in Run Request"
                  RunExtra
extra       :: RunExtra            <- Text -> HashMap Text Ps -> Text -> Result RunExtra
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Text -> Result v
lookupWithError Text
"extra" HashMap Text Ps
map Text
"\"extra\" not found in Run Request"
                  Vector Text
bookmarks   :: V.Vector T.Text     <- Text -> HashMap Text Ps -> Text -> Result (Vector Text)
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Text -> Result v
lookupWithError Text
"bookmarks" HashMap Text Ps
map Text
"\"bookmarks\" not found in Run Request"
                  Maybe Int64
tx_timeout  :: Maybe Int64         <- Text -> HashMap Text Ps -> Result (Maybe Int64)
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Result (Maybe v)
lookupMaybe Text
"tx_timeout" HashMap Text Ps
map
                  HashMap Text Ps
tx_metadata :: H.HashMap T.Text Ps <- Text -> HashMap Text Ps -> Text -> Result (HashMap Text Ps)
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Text -> Result v
lookupWithError Text
"tx_metadata" HashMap Text Ps
map Text
"\"tx_metadata\" not found in Run Request"
                  Char
mode        :: Char                <- HashMap Text Ps -> Result Char
fromPsMode HashMap Text Ps
map
                  Maybe Text
db          :: Maybe T.Text        <- Text -> HashMap Text Ps -> Result (Maybe Text)
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Result (Maybe v)
lookupMaybe Text
"db" HashMap Text Ps
map
                  Maybe Text
imp_user    :: Maybe T.Text        <- Text -> HashMap Text Ps -> Result (Maybe Text)
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Result (Maybe v)
lookupMaybe Text
"imp_user" HashMap Text Ps
map
                  pure $ RunAutoCommitTransaction -> Request
RRunAutoCommitTransaction RunAutoCommitTransaction{Text
query :: Text
query :: Text
query, HashMap Text Ps
parameters :: HashMap Text Ps
parameters :: HashMap Text Ps
parameters, RunExtra
extra :: RunExtra
extra :: RunExtra
extra, Vector Text
bookmarks :: Vector Text
bookmarks :: Vector Text
bookmarks, Maybe Int64
tx_timeout :: Maybe Int64
tx_timeout :: Maybe Int64
tx_timeout, HashMap Text Ps
tx_metadata :: HashMap Text Ps
tx_metadata :: HashMap Text Ps
tx_metadata, Char
mode :: Char
mode :: Char
mode, Maybe Text
db :: Maybe Text
db :: Maybe Text
db, Maybe Text
imp_user :: Maybe Text
imp_user :: Maybe Text
imp_user}
                else do
                  Text
query       :: T.Text              <- Text -> HashMap Text Ps -> Text -> Result Text
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Text -> Result v
lookupWithError Text
"query" HashMap Text Ps
map Text
"\"query\" not found in Run Request"
                  HashMap Text Ps
parameters  :: H.HashMap T.Text Ps <- Text -> HashMap Text Ps -> Text -> Result (HashMap Text Ps)
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Text -> Result v
lookupWithError Text
"parameters" HashMap Text Ps
map Text
"\"parameters\" not found in Run Request"
                  RunExtra
extra       :: RunExtra            <- Text -> HashMap Text Ps -> Text -> Result RunExtra
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Text -> Result v
lookupWithError Text
"extra" HashMap Text Ps
map Text
"\"extra\" not found in Run Request"
                  pure $ RunExplicitTransaction -> Request
RRunExplicitTransaction RunExplicitTransaction{Text
query :: Text
query :: Text
query, HashMap Text Ps
parameters :: HashMap Text Ps
parameters :: HashMap Text Ps
parameters, RunExtra
extra :: RunExtra
extra :: RunExtra
extra}



-- | HELLO message payload for initial handshake authentication.
type Hello :: Type
data Hello =  Hello
  { Hello -> UserAgent
user_agent :: UserAgent
  , Hello -> Scheme
scheme     :: Scheme
  , Hello -> Routing
routing    :: Routing
  , Hello -> Bool
patchBolt  :: Bool
  -- ^ When True, include @"patch_bolt": ["utc"]@ in HELLO (BOLT 4.3\/4.4 only).
  }
  deriving stock ((forall x. Hello -> Rep Hello x)
-> (forall x. Rep Hello x -> Hello) -> Generic Hello
forall x. Rep Hello x -> Hello
forall x. Hello -> Rep Hello x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Hello -> Rep Hello x
from :: forall x. Hello -> Rep Hello x
$cto :: forall x. Rep Hello x -> Hello
to :: forall x. Rep Hello x -> Hello
Generic)

instance PackStream Hello where
  toPs :: Hello -> Ps
toPs = Hello -> Ps
helloToPs
  fromPs :: Ps -> Result Hello
fromPs = Ps -> Result Hello
helloFromPs


-- | RUN message payload within an explicit transaction.
type RunExplicitTransaction :: Type
data RunExplicitTransaction = RunExplicitTransaction
  { RunExplicitTransaction -> Text
query      :: !T.Text
  , RunExplicitTransaction -> HashMap Text Ps
parameters :: !(H.HashMap T.Text Ps)
  , RunExplicitTransaction -> RunExtra
extra      :: RunExtra
  }
  deriving stock ((forall x. RunExplicitTransaction -> Rep RunExplicitTransaction x)
-> (forall x.
    Rep RunExplicitTransaction x -> RunExplicitTransaction)
-> Generic RunExplicitTransaction
forall x. Rep RunExplicitTransaction x -> RunExplicitTransaction
forall x. RunExplicitTransaction -> Rep RunExplicitTransaction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RunExplicitTransaction -> Rep RunExplicitTransaction x
from :: forall x. RunExplicitTransaction -> Rep RunExplicitTransaction x
$cto :: forall x. Rep RunExplicitTransaction x -> RunExplicitTransaction
to :: forall x. Rep RunExplicitTransaction x -> RunExplicitTransaction
Generic)

runExplicitTransactionToPs :: RunExplicitTransaction -> Ps
runExplicitTransactionToPs :: RunExplicitTransaction -> Ps
runExplicitTransactionToPs RunExplicitTransaction{Text
query :: RunExplicitTransaction -> Text
query :: Text
query, HashMap Text Ps
parameters :: RunExplicitTransaction -> HashMap Text Ps
parameters :: HashMap Text Ps
parameters, RunExtra
extra :: RunExplicitTransaction -> RunExtra
extra :: RunExtra
extra} =
  Tag -> Vector Ps -> Ps
PsStructure Tag
0x10 (Vector Ps -> Ps) -> Vector Ps -> Ps
forall a b. (a -> b) -> a -> b
$ [Ps] -> Vector Ps
forall a. [a] -> Vector a
V.fromList
    [ Text -> Ps
forall a. PackStream a => a -> Ps
toPs Text
query
    , HashMap Text Ps -> Ps
forall a. PackStream a => a -> Ps
toPs HashMap Text Ps
parameters
    , RunExtra -> Ps
forall a. PackStream a => a -> Ps
toPs RunExtra
extra
    ]

-- | Default 'RunAutoCommitTransaction' with empty query, parameters, and bookmarks.
defaultRunAutoCommitTransaction :: RunAutoCommitTransaction
defaultRunAutoCommitTransaction :: RunAutoCommitTransaction
defaultRunAutoCommitTransaction = RunAutoCommitTransaction
  { query :: Text
query       = Text
""
  , parameters :: HashMap Text Ps
parameters  = HashMap Text Ps
forall k v. HashMap k v
H.empty
  , extra :: RunExtra
extra       = RunExtra
defaultRunExtra
  , bookmarks :: Vector Text
bookmarks   = Vector Text
forall a. Vector a
V.empty
  , tx_timeout :: Maybe Int64
tx_timeout  = Maybe Int64
forall a. Maybe a
Nothing
  , tx_metadata :: HashMap Text Ps
tx_metadata = HashMap Text Ps
forall k v. HashMap k v
H.empty
  , mode :: Char
mode        = Char
'w'
  , db :: Maybe Text
db          = Maybe Text
forall a. Maybe a
Nothing
  , imp_user :: Maybe Text
imp_user    = Maybe Text
forall a. Maybe a
Nothing
  }

-- | Build a 'RunAutoCommitTransaction' with the given query and parameters.
mkRunAutoCommit :: T.Text -> H.HashMap T.Text Ps -> RunAutoCommitTransaction
mkRunAutoCommit :: Text -> HashMap Text Ps -> RunAutoCommitTransaction
mkRunAutoCommit Text
q HashMap Text Ps
p = RunAutoCommitTransaction
  { query :: Text
query       = Text
q
  , parameters :: HashMap Text Ps
parameters  = HashMap Text Ps
p
  , extra :: RunExtra
extra       = RunExtra
defaultRunExtra
  , bookmarks :: Vector Text
bookmarks   = Vector Text
forall a. Vector a
V.empty
  , tx_timeout :: Maybe Int64
tx_timeout  = Maybe Int64
forall a. Maybe a
Nothing
  , tx_metadata :: HashMap Text Ps
tx_metadata = HashMap Text Ps
forall k v. HashMap k v
H.empty
  , mode :: Char
mode        = Char
'w'
  , db :: Maybe Text
db          = Maybe Text
forall a. Maybe a
Nothing
  , imp_user :: Maybe Text
imp_user    = Maybe Text
forall a. Maybe a
Nothing
  }

-- | RUN message payload for an auto-commit transaction.
type RunAutoCommitTransaction :: Type
data RunAutoCommitTransaction = RunAutoCommitTransaction
  { RunAutoCommitTransaction -> Text
query       :: !T.Text
  , RunAutoCommitTransaction -> HashMap Text Ps
parameters  :: !(H.HashMap T.Text Ps)
  , RunAutoCommitTransaction -> RunExtra
extra       :: RunExtra
  , RunAutoCommitTransaction -> Vector Text
bookmarks   :: V.Vector T.Text
  , RunAutoCommitTransaction -> Maybe Int64
tx_timeout  :: !(Maybe Int64)
  , RunAutoCommitTransaction -> HashMap Text Ps
tx_metadata :: !(H.HashMap T.Text Ps)
  , RunAutoCommitTransaction -> Char
mode        :: !Char
  , RunAutoCommitTransaction -> Maybe Text
db          :: !(Maybe T.Text)
  , RunAutoCommitTransaction -> Maybe Text
imp_user    :: !(Maybe T.Text)
  }
  deriving stock ((forall x.
 RunAutoCommitTransaction -> Rep RunAutoCommitTransaction x)
-> (forall x.
    Rep RunAutoCommitTransaction x -> RunAutoCommitTransaction)
-> Generic RunAutoCommitTransaction
forall x.
Rep RunAutoCommitTransaction x -> RunAutoCommitTransaction
forall x.
RunAutoCommitTransaction -> Rep RunAutoCommitTransaction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
RunAutoCommitTransaction -> Rep RunAutoCommitTransaction x
from :: forall x.
RunAutoCommitTransaction -> Rep RunAutoCommitTransaction x
$cto :: forall x.
Rep RunAutoCommitTransaction x -> RunAutoCommitTransaction
to :: forall x.
Rep RunAutoCommitTransaction x -> RunAutoCommitTransaction
Generic)

runAutoCommitTransactiontoPs :: RunAutoCommitTransaction -> Ps
runAutoCommitTransactiontoPs :: RunAutoCommitTransaction -> Ps
runAutoCommitTransactiontoPs RunAutoCommitTransaction{Text
query :: RunAutoCommitTransaction -> Text
query :: Text
query, HashMap Text Ps
parameters :: RunAutoCommitTransaction -> HashMap Text Ps
parameters :: HashMap Text Ps
parameters, Vector Text
bookmarks :: RunAutoCommitTransaction -> Vector Text
bookmarks :: Vector Text
bookmarks, Maybe Int64
tx_timeout :: RunAutoCommitTransaction -> Maybe Int64
tx_timeout :: Maybe Int64
tx_timeout, HashMap Text Ps
tx_metadata :: RunAutoCommitTransaction -> HashMap Text Ps
tx_metadata :: HashMap Text Ps
tx_metadata, Char
mode :: RunAutoCommitTransaction -> Char
mode :: Char
mode, Maybe Text
db :: RunAutoCommitTransaction -> Maybe Text
db :: Maybe Text
db, Maybe Text
imp_user :: RunAutoCommitTransaction -> Maybe Text
imp_user :: Maybe Text
imp_user} =
  Tag -> Vector Ps -> Ps
PsStructure Tag
0x10 (Vector Ps -> Ps) -> Vector Ps -> Ps
forall a b. (a -> b) -> a -> b
$ [Ps] -> Vector Ps
forall a. [a] -> Vector a
V.fromList
    [ Text -> Ps
forall a. PackStream a => a -> Ps
toPs Text
query
    , HashMap Text Ps -> Ps
forall a. PackStream a => a -> Ps
toPs HashMap Text Ps
parameters
    , HashMap Text Ps -> Ps
PsDictionary (HashMap Text Ps -> Ps) -> HashMap Text Ps -> Ps
forall a b. (a -> b) -> a -> b
$ [(Text, Ps)] -> HashMap Text Ps
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList ([(Text, Ps)] -> HashMap Text Ps)
-> [(Text, Ps)] -> HashMap Text Ps
forall a b. (a -> b) -> a -> b
$
        let tx_timeout_list :: [(Text, Ps)]
tx_timeout_list = case Maybe Int64
tx_timeout of
                                Maybe Int64
Nothing -> []
                                Just Int64
t  -> [(Text
"tx_timeout", Int64 -> Ps
forall a. PackStream a => a -> Ps
toPs Int64
t)]
            imp_user_list :: [(Text, Ps)]
imp_user_list = case Maybe Text
imp_user of
                              Maybe Text
Nothing -> []
                              Just Text
i  -> [(Text
"imp_user", Text -> Ps
forall a. PackStream a => a -> Ps
toPs Text
i)]
        in  [ (Text
"bookmarks", Vector Text -> Ps
forall a. PackStream a => a -> Ps
toPs Vector Text
bookmarks)
            , (Text
"tx_metadata", HashMap Text Ps -> Ps
forall a. PackStream a => a -> Ps
toPs HashMap Text Ps
tx_metadata)
            , (Text
"mode", Text -> Ps
forall a. PackStream a => a -> Ps
toPs (Text -> Ps) -> Text -> Ps
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
mode)
            , (Text
"db", Maybe Text -> Ps
forall a. PackStream a => a -> Ps
toPs Maybe Text
db)
            ] [(Text, Ps)] -> [(Text, Ps)] -> [(Text, Ps)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Ps)]
tx_timeout_list [(Text, Ps)] -> [(Text, Ps)] -> [(Text, Ps)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Ps)]
imp_user_list
    ]



-- | DISCARD message payload with record count and query ID.
type Discard :: Type
data Discard = Discard
  { Discard -> Int64
n   :: Int64
  , Discard -> Int64
qid :: Int64
  }
  deriving stock ((forall x. Discard -> Rep Discard x)
-> (forall x. Rep Discard x -> Discard) -> Generic Discard
forall x. Rep Discard x -> Discard
forall x. Discard -> Rep Discard x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Discard -> Rep Discard x
from :: forall x. Discard -> Rep Discard x
$cto :: forall x. Rep Discard x -> Discard
to :: forall x. Rep Discard x -> Discard
Generic)
instance PackStream Discard where
  toPs :: Discard -> Ps
toPs Discard{Int64
n :: Discard -> Int64
n :: Int64
n, Int64
qid :: Discard -> Int64
qid :: Int64
qid} = HashMap Text Ps -> Ps
PsDictionary (HashMap Text Ps -> Ps) -> HashMap Text Ps -> Ps
forall a b. (a -> b) -> a -> b
$ [(Text, Ps)] -> HashMap Text Ps
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList
    [(Text
"n", Int64 -> Ps
forall a. PackStream a => a -> Ps
toPs Int64
n), (Text
"qid", Int64 -> Ps
forall a. PackStream a => a -> Ps
toPs Int64
qid)]
  fromPs :: Ps -> Result Discard
fromPs = Text -> (HashMap Text Ps -> Result Discard) -> Ps -> Result Discard
forall a. Text -> (HashMap Text Ps -> Result a) -> Ps -> Result a
withDictionary Text
"Discard" ((HashMap Text Ps -> Result Discard) -> Ps -> Result Discard)
-> (HashMap Text Ps -> Result Discard) -> Ps -> Result Discard
forall a b. (a -> b) -> a -> b
$ \HashMap Text Ps
m -> do
    Int64
n' <- Text -> HashMap Text Ps -> Text -> Result Int64
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Text -> Result v
lookupWithError Text
"n" HashMap Text Ps
m Text
"\"n\" not found in Discard"
    Int64
qid' <- Text -> HashMap Text Ps -> Text -> Result Int64
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Text -> Result v
lookupWithError Text
"qid" HashMap Text Ps
m Text
"\"qid\" not found in Discard"
    pure $ Discard{n :: Int64
n = Int64
n', qid :: Int64
qid = Int64
qid'}

-- | BEGIN message payload for starting an explicit transaction.
type Begin :: Type
data Begin = Begin
  { Begin -> Vector Text
bookmarks   :: !(V.Vector T.Text)
  , Begin -> Maybe Int64
tx_timeout  :: !(Maybe Int64)
  , Begin -> HashMap Text Ps
tx_metadata :: !(H.HashMap T.Text Ps)
  , Begin -> Char
mode        :: !Char
  , Begin -> Maybe Text
db          :: !(Maybe T.Text)
  , Begin -> Maybe Text
imp_user    :: !(Maybe T.Text)
  }
  deriving stock ((forall x. Begin -> Rep Begin x)
-> (forall x. Rep Begin x -> Begin) -> Generic Begin
forall x. Rep Begin x -> Begin
forall x. Begin -> Rep Begin x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Begin -> Rep Begin x
from :: forall x. Begin -> Rep Begin x
$cto :: forall x. Rep Begin x -> Begin
to :: forall x. Rep Begin x -> Begin
Generic)
instance PackStream Begin where
  toPs :: Begin -> Ps
toPs Begin{Vector Text
bookmarks :: Begin -> Vector Text
bookmarks :: Vector Text
bookmarks, Maybe Int64
tx_timeout :: Begin -> Maybe Int64
tx_timeout :: Maybe Int64
tx_timeout, HashMap Text Ps
tx_metadata :: Begin -> HashMap Text Ps
tx_metadata :: HashMap Text Ps
tx_metadata, Char
mode :: Begin -> Char
mode :: Char
mode, Maybe Text
db :: Begin -> Maybe Text
db :: Maybe Text
db, Maybe Text
imp_user :: Begin -> Maybe Text
imp_user :: Maybe Text
imp_user} = HashMap Text Ps -> Ps
PsDictionary (HashMap Text Ps -> Ps) -> HashMap Text Ps -> Ps
forall a b. (a -> b) -> a -> b
$ [(Text, Ps)] -> HashMap Text Ps
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList
    [ (Text
"bookmarks", Vector Text -> Ps
forall a. PackStream a => a -> Ps
toPs Vector Text
bookmarks)
    , (Text
"tx_timeout", Maybe Int64 -> Ps
forall a. PackStream a => a -> Ps
toPs Maybe Int64
tx_timeout)
    , (Text
"tx_metadata", HashMap Text Ps -> Ps
forall a. PackStream a => a -> Ps
toPs HashMap Text Ps
tx_metadata)
    , (Text
"mode", Text -> Ps
forall a. PackStream a => a -> Ps
toPs (Text -> Ps) -> Text -> Ps
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
mode)
    , (Text
"db", Maybe Text -> Ps
forall a. PackStream a => a -> Ps
toPs Maybe Text
db)
    , (Text
"imp_user", Maybe Text -> Ps
forall a. PackStream a => a -> Ps
toPs Maybe Text
imp_user)
    ]
  toBinary :: Begin -> Put
toBinary Begin
run_extra = Ps -> Put
putPs (Ps -> Put) -> Ps -> Put
forall a b. (a -> b) -> a -> b
$ Begin -> Ps
forall a. PackStream a => a -> Ps
toPs Begin
run_extra
  fromPs :: Ps -> Result Begin
fromPs = Text -> (HashMap Text Ps -> Result Begin) -> Ps -> Result Begin
forall a. Text -> (HashMap Text Ps -> Result a) -> Ps -> Result a
withDictionary Text
"Begin" HashMap Text Ps -> Result Begin
f
    where f :: HashMap Text Ps -> Result Begin
f HashMap Text Ps
map = do
            Vector Text
bookmarks :: V.Vector T.Text <- Text -> HashMap Text Ps -> Text -> Result (Vector Text)
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Text -> Result v
lookupWithError Text
"bookmarks" HashMap Text Ps
map Text
"\"bookmarks\" not found in Begin"
            Maybe Int64
tx_timeout :: Maybe Int64 <- Text -> HashMap Text Ps -> Result (Maybe Int64)
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Result (Maybe v)
lookupMaybe Text
"tx_timeout" HashMap Text Ps
map
            HashMap Text Ps
tx_metadata :: H.HashMap T.Text Ps <- Text -> HashMap Text Ps -> Text -> Result (HashMap Text Ps)
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Text -> Result v
lookupWithError Text
"tx_metadata" HashMap Text Ps
map Text
"\"tx_metadata\" not found in Begin"
            Char
mode :: Char <- HashMap Text Ps -> Result Char
fromPsMode HashMap Text Ps
map
            Maybe Text
db :: (Maybe T.Text) <- Text -> HashMap Text Ps -> Result (Maybe Text)
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Result (Maybe v)
lookupMaybe Text
"db" HashMap Text Ps
map
            Maybe Text
imp_user :: Maybe T.Text <- Text -> HashMap Text Ps -> Result (Maybe Text)
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Result (Maybe v)
lookupMaybe Text
"imp_user" HashMap Text Ps
map
            pure $ Begin{Vector Text
bookmarks :: Vector Text
bookmarks :: Vector Text
bookmarks, Maybe Int64
tx_timeout :: Maybe Int64
tx_timeout :: Maybe Int64
tx_timeout, HashMap Text Ps
tx_metadata :: HashMap Text Ps
tx_metadata :: HashMap Text Ps
tx_metadata, Char
mode :: Char
mode :: Char
mode, Maybe Text
db :: Maybe Text
db :: Maybe Text
db, Maybe Text
imp_user :: Maybe Text
imp_user :: Maybe Text
imp_user}



-- | ROUTE message payload for fetching routing tables.
type Route :: Type
data Route = Route
  { Route -> HashMap Text Ps
routing   :: !(H.HashMap T.Text Ps) -- Only "address" specified
  , Route -> Vector Text
bookmarks :: !(V.Vector T.Text)
  , Route -> RouteExtra
extra     :: RouteExtra
  }

routeToPs :: Route -> Ps
routeToPs :: Route -> Ps
routeToPs Route{HashMap Text Ps
routing :: Route -> HashMap Text Ps
routing :: HashMap Text Ps
routing, Vector Text
bookmarks :: Route -> Vector Text
bookmarks :: Vector Text
bookmarks, RouteExtra
extra :: Route -> RouteExtra
extra :: RouteExtra
extra} =
  Tag -> Vector Ps -> Ps
PsStructure Tag
0x66 (Vector Ps -> Ps) -> Vector Ps -> Ps
forall a b. (a -> b) -> a -> b
$ [Ps] -> Vector Ps
forall a. [a] -> Vector a
V.fromList
    [ HashMap Text Ps -> Ps
forall a. PackStream a => a -> Ps
toPs HashMap Text Ps
routing
    , Vector Text -> Ps
forall a. PackStream a => a -> Ps
toPs Vector Text
bookmarks
    , RouteExtra -> Ps
forall a. PackStream a => a -> Ps
toPs RouteExtra
extra
    ]

fromPsToRoute :: V.Vector Ps -> Result Request
fromPsToRoute :: Vector Ps -> Result Request
fromPsToRoute Vector Ps
fields
  | Vector Ps -> Int
forall a. Vector a -> Int
V.length Vector Ps
fields Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
3 = Text -> Result Request
forall a. Text -> Result a
Error Text
"expected exactly 3 fields for Route"
  | Bool
otherwise = do
      HashMap Text Ps
routing   <- Ps -> Result (HashMap Text Ps)
forall a. PackStream a => Ps -> Result a
fromPs (Vector Ps
fields Vector Ps -> Int -> Ps
forall a. Vector a -> Int -> a
V.! Int
0)
      Vector Text
bookmarks <- Ps -> Result (Vector Text)
forall a. PackStream a => Ps -> Result a
fromPs (Vector Ps
fields Vector Ps -> Int -> Ps
forall a. Vector a -> Int -> a
V.! Int
1)
      RouteExtra
extra     <- Ps -> Result RouteExtra
forall a. PackStream a => Ps -> Result a
fromPs (Vector Ps
fields Vector Ps -> Int -> Ps
forall a. Vector a -> Int -> a
V.! Int
2)
      Request -> Result Request
forall a. a -> Result a
Success (Request -> Result Request) -> Request -> Result Request
forall a b. (a -> b) -> a -> b
$ Route -> Request
RRoute Route{HashMap Text Ps
routing :: HashMap Text Ps
routing :: HashMap Text Ps
routing, Vector Text
bookmarks :: Vector Text
bookmarks :: Vector Text
bookmarks, RouteExtra
extra :: RouteExtra
extra :: RouteExtra
extra}

-- | Default 'Pull' requesting all records (@n = -1@) with no explicit query ID.
defaultPull :: Pull
defaultPull :: Pull
defaultPull = Pull{n :: Int64
n = -Int64
1, qid :: Maybe Int64
qid = Maybe Int64
forall a. Maybe a
Nothing}

-- | PULL message payload with record count and optional query ID.
type Pull :: Type
data Pull = Pull
  { Pull -> Int64
n   :: Int64
  , Pull -> Maybe Int64
qid :: Maybe Int64
  }
  deriving stock ((forall x. Pull -> Rep Pull x)
-> (forall x. Rep Pull x -> Pull) -> Generic Pull
forall x. Rep Pull x -> Pull
forall x. Pull -> Rep Pull x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Pull -> Rep Pull x
from :: forall x. Pull -> Rep Pull x
$cto :: forall x. Rep Pull x -> Pull
to :: forall x. Rep Pull x -> Pull
Generic)
instance PackStream Pull where
  toPs :: Pull -> Ps
toPs Pull{Int64
n :: Pull -> Int64
n :: Int64
n, Maybe Int64
qid :: Pull -> Maybe Int64
qid :: Maybe Int64
qid} = HashMap Text Ps -> Ps
PsDictionary (HashMap Text Ps -> Ps) -> HashMap Text Ps -> Ps
forall a b. (a -> b) -> a -> b
$ [(Text, Ps)] -> HashMap Text Ps
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList ([(Text, Ps)] -> HashMap Text Ps)
-> [(Text, Ps)] -> HashMap Text Ps
forall a b. (a -> b) -> a -> b
$
    [(Text
"n", Int64 -> Ps
forall a. PackStream a => a -> Ps
toPs Int64
n)] [(Text, Ps)] -> [(Text, Ps)] -> [(Text, Ps)]
forall a. Semigroup a => a -> a -> a
<>
    case Maybe Int64
qid of
      Maybe Int64
Nothing -> []
      Just Int64
q  -> [(Text
"qid", Int64 -> Ps
forall a. PackStream a => a -> Ps
toPs Int64
q)]
  fromPs :: Ps -> Result Pull
fromPs = Text -> (HashMap Text Ps -> Result Pull) -> Ps -> Result Pull
forall a. Text -> (HashMap Text Ps -> Result a) -> Ps -> Result a
withDictionary Text
"Pull" ((HashMap Text Ps -> Result Pull) -> Ps -> Result Pull)
-> (HashMap Text Ps -> Result Pull) -> Ps -> Result Pull
forall a b. (a -> b) -> a -> b
$ \HashMap Text Ps
m -> do
    Int64
n' <- Text -> HashMap Text Ps -> Text -> Result Int64
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Text -> Result v
lookupWithError Text
"n" HashMap Text Ps
m Text
"\"n\" not found in Pull"
    Maybe Int64
qid' <- Text -> HashMap Text Ps -> Result (Maybe Int64)
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Result (Maybe v)
lookupMaybe Text
"qid" HashMap Text Ps
m
    pure $ Pull{n :: Int64
n = Int64
n', qid :: Maybe Int64
qid = Maybe Int64
qid'}

-- | Extra parameters for the ROUTE message (database and impersonated user).
type RouteExtra :: Type
data RouteExtra = RouteExtra
  { RouteExtra -> Maybe Text
db       :: !(Maybe T.Text)
  , RouteExtra -> Maybe Text
imp_user :: !(Maybe T.Text)
  }
instance PackStream RouteExtra where
  toPs :: RouteExtra -> Ps
toPs RouteExtra{Maybe Text
db :: RouteExtra -> Maybe Text
db :: Maybe Text
db, Maybe Text
imp_user :: RouteExtra -> Maybe Text
imp_user :: Maybe Text
imp_user} = HashMap Text Ps -> Ps
PsDictionary (HashMap Text Ps -> Ps) -> HashMap Text Ps -> Ps
forall a b. (a -> b) -> a -> b
$ [(Text, Ps)] -> HashMap Text Ps
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList ([(Text, Ps)] -> HashMap Text Ps)
-> [(Text, Ps)] -> HashMap Text Ps
forall a b. (a -> b) -> a -> b
$
    [(Text, Ps)]
-> (Text -> [(Text, Ps)]) -> Maybe Text -> [(Text, Ps)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
d -> [(Text
"db", Text -> Ps
forall a. PackStream a => a -> Ps
toPs Text
d)]) Maybe Text
db [(Text, Ps)] -> [(Text, Ps)] -> [(Text, Ps)]
forall a. Semigroup a => a -> a -> a
<>
    [(Text, Ps)]
-> (Text -> [(Text, Ps)]) -> Maybe Text -> [(Text, Ps)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
i -> [(Text
"imp_user", Text -> Ps
forall a. PackStream a => a -> Ps
toPs Text
i)]) Maybe Text
imp_user
  toBinary :: RouteExtra -> Put
toBinary RouteExtra
route_extra = Ps -> Put
putPs (Ps -> Put) -> Ps -> Put
forall a b. (a -> b) -> a -> b
$ RouteExtra -> Ps
forall a. PackStream a => a -> Ps
toPs RouteExtra
route_extra
  fromPs :: Ps -> Result RouteExtra
fromPs = Text
-> (HashMap Text Ps -> Result RouteExtra)
-> Ps
-> Result RouteExtra
forall a. Text -> (HashMap Text Ps -> Result a) -> Ps -> Result a
withDictionary Text
"RouteExtra" HashMap Text Ps -> Result RouteExtra
f
    where f :: HashMap Text Ps -> Result RouteExtra
f HashMap Text Ps
map = do
            Maybe Text
db :: Maybe T.Text <- Text -> HashMap Text Ps -> Result (Maybe Text)
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Result (Maybe v)
lookupMaybe Text
"db" HashMap Text Ps
map
            Maybe Text
imp_user :: Maybe T.Text <- Text -> HashMap Text Ps -> Result (Maybe Text)
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Result (Maybe v)
lookupMaybe Text
"imp_user" HashMap Text Ps
map
            pure $ RouteExtra{Maybe Text
db :: Maybe Text
db :: Maybe Text
db, Maybe Text
imp_user :: Maybe Text
imp_user :: Maybe Text
imp_user}


-- | Extra parameters for the RUN message (bookmarks, timeout, metadata, mode, db, impersonation).
type RunExtra :: Type
data RunExtra = RunExtra
  { RunExtra -> Vector Text
bookmarks   :: !(V.Vector T.Text)
  , RunExtra -> Maybe Int64
tx_timeout  :: !(Maybe Int64)
  , RunExtra -> HashMap Text Ps
tx_metadata :: !(H.HashMap T.Text Ps)
  , RunExtra -> Char
mode        :: !Char
  , RunExtra -> Maybe Text
db          :: !(Maybe T.Text)
  , RunExtra -> Maybe Text
imp_user    :: !(Maybe T.Text)
  }

-- | Default 'RunExtra' with empty bookmarks, no timeout, write mode, and no database.
defaultRunExtra :: RunExtra
defaultRunExtra :: RunExtra
defaultRunExtra = RunExtra
  { bookmarks :: Vector Text
bookmarks   = Vector Text
forall a. Vector a
V.empty
  , tx_timeout :: Maybe Int64
tx_timeout  = Maybe Int64
forall a. Maybe a
Nothing
  , tx_metadata :: HashMap Text Ps
tx_metadata = HashMap Text Ps
forall k v. HashMap k v
H.empty
  , mode :: Char
mode        = Char
'w'
  , db :: Maybe Text
db          = Maybe Text
forall a. Maybe a
Nothing
  , imp_user :: Maybe Text
imp_user    = Maybe Text
forall a. Maybe a
Nothing
  }

instance PackStream RunExtra where
  toPs :: RunExtra -> Ps
toPs RunExtra{Vector Text
bookmarks :: RunExtra -> Vector Text
bookmarks :: Vector Text
bookmarks, Maybe Int64
tx_timeout :: RunExtra -> Maybe Int64
tx_timeout :: Maybe Int64
tx_timeout, HashMap Text Ps
tx_metadata :: RunExtra -> HashMap Text Ps
tx_metadata :: HashMap Text Ps
tx_metadata, Char
mode :: RunExtra -> Char
mode :: Char
mode, Maybe Text
db :: RunExtra -> Maybe Text
db :: Maybe Text
db, Maybe Text
imp_user :: RunExtra -> Maybe Text
imp_user :: Maybe Text
imp_user} = HashMap Text Ps -> Ps
PsDictionary (HashMap Text Ps -> Ps) -> HashMap Text Ps -> Ps
forall a b. (a -> b) -> a -> b
$ [(Text, Ps)] -> HashMap Text Ps
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList
    [ (Text
"bookmarks", Vector Text -> Ps
forall a. PackStream a => a -> Ps
toPs Vector Text
bookmarks)
    , (Text
"tx_timeout", Maybe Int64 -> Ps
forall a. PackStream a => a -> Ps
toPs Maybe Int64
tx_timeout)
    , (Text
"tx_metadata", HashMap Text Ps -> Ps
forall a. PackStream a => a -> Ps
toPs HashMap Text Ps
tx_metadata)
    , (Text
"mode", Text -> Ps
forall a. PackStream a => a -> Ps
toPs (Text -> Ps) -> Text -> Ps
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
mode)
    , (Text
"db", Maybe Text -> Ps
forall a. PackStream a => a -> Ps
toPs Maybe Text
db)
    , (Text
"imp_user", Maybe Text -> Ps
forall a. PackStream a => a -> Ps
toPs Maybe Text
imp_user)
    ]
  toBinary :: RunExtra -> Put
toBinary RunExtra
run_extra = Ps -> Put
putPs (Ps -> Put) -> Ps -> Put
forall a b. (a -> b) -> a -> b
$ RunExtra -> Ps
forall a. PackStream a => a -> Ps
toPs RunExtra
run_extra
  fromPs :: Ps -> Result RunExtra
fromPs = Text
-> (HashMap Text Ps -> Result RunExtra) -> Ps -> Result RunExtra
forall a. Text -> (HashMap Text Ps -> Result a) -> Ps -> Result a
withDictionary Text
"RunExtra" HashMap Text Ps -> Result RunExtra
f
    where f :: HashMap Text Ps -> Result RunExtra
f HashMap Text Ps
map = do
            Vector Text
bookmarks :: V.Vector T.Text <- Text -> HashMap Text Ps -> Text -> Result (Vector Text)
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Text -> Result v
lookupWithError Text
"bookmarks" HashMap Text Ps
map Text
"\"bookmarks\" not found in RunExtra"
            Maybe Int64
tx_timeout :: Maybe Int64 <- Text -> HashMap Text Ps -> Result (Maybe Int64)
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Result (Maybe v)
lookupMaybe Text
"tx_timeout" HashMap Text Ps
map
            HashMap Text Ps
tx_metadata :: H.HashMap T.Text Ps <- Text -> HashMap Text Ps -> Text -> Result (HashMap Text Ps)
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Text -> Result v
lookupWithError Text
"tx_metadata" HashMap Text Ps
map Text
"\"tx_metadata\" not found in RunExtra"
            Char
mode :: Char <- HashMap Text Ps -> Result Char
fromPsMode HashMap Text Ps
map
            Maybe Text
db :: Maybe T.Text <- Text -> HashMap Text Ps -> Result (Maybe Text)
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Result (Maybe v)
lookupMaybe Text
"db" HashMap Text Ps
map
            Maybe Text
imp_user :: Maybe T.Text <- Text -> HashMap Text Ps -> Result (Maybe Text)
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Result (Maybe v)
lookupMaybe Text
"imp_user" HashMap Text Ps
map
            pure $ RunExtra{Vector Text
bookmarks :: Vector Text
bookmarks :: Vector Text
bookmarks, Maybe Int64
tx_timeout :: Maybe Int64
tx_timeout :: Maybe Int64
tx_timeout, HashMap Text Ps
tx_metadata :: HashMap Text Ps
tx_metadata :: HashMap Text Ps
tx_metadata, Char
mode :: Char
mode :: Char
mode, Maybe Text
db :: Maybe Text
db :: Maybe Text
db, Maybe Text
imp_user :: Maybe Text
imp_user :: Maybe Text
imp_user}


fromPsMode :: HashMap T.Text Ps -> Result Char
fromPsMode :: HashMap Text Ps -> Result Char
fromPsMode HashMap Text Ps
map = do
  Text
mode :: T.Text <- Text -> HashMap Text Ps -> Text -> Result Text
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Text -> Result v
lookupWithError Text
"mode" HashMap Text Ps
map Text
"\"mode\" not found in RunExtra"
  if Text -> Int
T.length Text
mode Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then
    Char -> Result Char
forall a. a -> Result a
Success (Char -> Result Char) -> Char -> Result Char
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Char
Text -> Char
T.head Text
mode
  else
    Text -> Result Char
forall a. Text -> Result a
Error Text
"\"mode\" in RunExtra should be a single character of either 'r' or 'w'"


helloToPs :: Hello -> Ps
helloToPs :: Hello -> Ps
helloToPs Hello{UserAgent
user_agent :: Hello -> UserAgent
user_agent :: UserAgent
user_agent, Scheme
scheme :: Hello -> Scheme
scheme :: Scheme
scheme, Routing
routing :: Hello -> Routing
routing :: Routing
routing, Bool
patchBolt :: Hello -> Bool
patchBolt :: Bool
patchBolt} =
    HashMap Text Ps -> Ps
PsDictionary (HashMap Text Ps -> Ps) -> HashMap Text Ps -> Ps
forall a b. (a -> b) -> a -> b
$ [(Text, Ps)] -> HashMap Text Ps
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList ([(Text, Ps)] -> HashMap Text Ps)
-> [(Text, Ps)] -> HashMap Text Ps
forall a b. (a -> b) -> a -> b
$
      [ (Text
"user_agent", UserAgent -> Ps
forall a. PackStream a => a -> Ps
toPs UserAgent
user_agent)
      , (Text
"scheme"    , Text -> Ps
forall a. PackStream a => a -> Ps
toPs Text
scheme')
      ] [(Text, Ps)] -> [(Text, Ps)] -> [(Text, Ps)]
forall a. Semigroup a => a -> a -> a
<>
        ( case Scheme
scheme of
            Scheme
None                        -> []
            Basic Text
principal Text
credentials -> [(Text
"principal", Text -> Ps
forall a. PackStream a => a -> Ps
toPs Text
principal), (Text
"credentials", Text -> Ps
forall a. PackStream a => a -> Ps
toPs Text
credentials)]
            Scheme
Kerberos                    -> []
            Bearer Text
credentials          -> [(Text
"credentials", Text -> Ps
forall a. PackStream a => a -> Ps
toPs Text
credentials)]
        ) [(Text, Ps)] -> [(Text, Ps)] -> [(Text, Ps)]
forall a. Semigroup a => a -> a -> a
<>
        ( case Routing
routing of
            Routing
NoRouting                          -> []
            Routing
Routing                            -> [(Text
"routing", HashMap Text Ps -> Ps
PsDictionary HashMap Text Ps
forall k v. HashMap k v
H.empty)]
            RoutingSpec Text
address HashMap Text Text
urlQueryParams -> [(Text
"routing", HashMap Text Ps -> Ps
PsDictionary (HashMap Text Ps -> Ps) -> HashMap Text Ps -> Ps
forall a b. (a -> b) -> a -> b
$ [(Text, Ps)] -> HashMap Text Ps
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList ([(Text, Ps)] -> HashMap Text Ps)
-> [(Text, Ps)] -> HashMap Text Ps
forall a b. (a -> b) -> a -> b
$
                (Text
"address", Text -> Ps
forall a. PackStream a => a -> Ps
toPs Text
address) (Text, Ps) -> [(Text, Ps)] -> [(Text, Ps)]
forall a. a -> [a] -> [a]
: [(Text
k, Text -> Ps
forall a. PackStream a => a -> Ps
toPs Text
v) | (Text
k, Text
v) <- HashMap Text Text -> [(Text, Text)]
forall k v. HashMap k v -> [(k, v)]
H.toList HashMap Text Text
urlQueryParams])]
        ) [(Text, Ps)] -> [(Text, Ps)] -> [(Text, Ps)]
forall a. Semigroup a => a -> a -> a
<>
        ( if Bool
patchBolt then [(Text
"patch_bolt", Vector Ps -> Ps
PsList (Vector Ps -> Ps) -> Vector Ps -> Ps
forall a b. (a -> b) -> a -> b
$ Ps -> Vector Ps
forall a. a -> Vector a
V.singleton (Ps -> Vector Ps) -> Ps -> Vector Ps
forall a b. (a -> b) -> a -> b
$ Text -> Ps
PsString Text
"utc")] else [] )
  where
    scheme' :: T.Text
    scheme' :: Text
scheme' = case Scheme
scheme of
                Scheme
None      -> Text
"none"
                Basic Text
_ Text
_ -> Text
"basic"
                Scheme
Kerberos  -> Text
"kerberos"
                Bearer Text
_  -> Text
"bearer"

helloFromPs :: Ps -> Result Hello
helloFromPs :: Ps -> Result Hello
helloFromPs = Text -> (HashMap Text Ps -> Result Hello) -> Ps -> Result Hello
forall a. Text -> (HashMap Text Ps -> Result a) -> Ps -> Result a
withDictionary Text
"Request:Hello" HashMap Text Ps -> Result Hello
f
  where f :: H.HashMap T.Text Ps -> Result Hello
        f :: HashMap Text Ps -> Result Hello
f HashMap Text Ps
map = do
          UserAgent
user_agent :: UserAgent <- Text -> HashMap Text Ps -> Text -> Result UserAgent
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Text -> Result v
lookupWithError Text
"user_agent" HashMap Text Ps
map Text
"\"user_agent\" not found in hello request"
          Text
scheme :: T.Text <- Text -> HashMap Text Ps -> Text -> Result Text
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Text -> Result v
lookupWithError Text
"scheme" HashMap Text Ps
map Text
"\"scheme\" not found in hello request"
          Routing
routing <- case Text -> HashMap Text Ps -> Maybe Ps
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
"routing" HashMap Text Ps
map of
                       Maybe Ps
Nothing -> Routing -> Result Routing
forall a. a -> Result a
Success Routing
NoRouting
                       Just (PsDictionary HashMap Text Ps
m)
                         | HashMap Text Ps -> Bool
forall k v. HashMap k v -> Bool
H.null HashMap Text Ps
m  -> Routing -> Result Routing
forall a. a -> Result a
Success Routing
Routing
                         | Bool
otherwise -> case Text -> HashMap Text Ps -> Maybe Ps
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
"address" HashMap Text Ps
m of
                             Just Ps
addr -> do
                               Text
a <- Ps -> Result Text
forall a. PackStream a => Ps -> Result a
fromPs Ps
addr
                               let params :: HashMap Text Ps
params = Text -> HashMap Text Ps -> HashMap Text Ps
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
H.delete Text
"address" HashMap Text Ps
m
                               HashMap Text Text
ps <- (Ps -> Result Text)
-> HashMap Text Ps -> Result (HashMap Text Text)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HashMap Text a -> f (HashMap Text b)
traverse Ps -> Result Text
forall a. PackStream a => Ps -> Result a
fromPs HashMap Text Ps
params
                               Routing -> Result Routing
forall a. a -> Result a
Success (Routing -> Result Routing) -> Routing -> Result Routing
forall a b. (a -> b) -> a -> b
$ Text -> HashMap Text Text -> Routing
RoutingSpec Text
a HashMap Text Text
ps
                             Maybe Ps
Nothing -> Text -> Result Routing
forall a. Text -> Result a
Error Text
"\"routing\" dictionary missing \"address\" key"
                       Just Ps
_ -> Text -> Result Routing
forall a. Text -> Result a
Error Text
"\"routing\" field should be a dictionary"
          let credentials :: Maybe Ps
credentials = Text -> HashMap Text Ps -> Maybe Ps
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
"credentials" HashMap Text Ps
map
          let principal :: Maybe Ps
principal   = Text -> HashMap Text Ps -> Maybe Ps
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
"principal" HashMap Text Ps
map
          let pb :: Bool
pb = case Text -> HashMap Text Ps -> Maybe Ps
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
"patch_bolt" HashMap Text Ps
map of
                     Just (PsList Vector Ps
v) -> Ps -> Vector Ps -> Bool
forall a. Eq a => a -> Vector a -> Bool
V.elem (Text -> Ps
PsString Text
"utc") Vector Ps
v
                     Maybe Ps
_               -> Bool
False
          case Text
scheme of
            Text
"none"     -> Hello -> Result Hello
forall a. a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Hello -> Result Hello) -> Hello -> Result Hello
forall a b. (a -> b) -> a -> b
$ Hello {UserAgent
user_agent :: UserAgent
user_agent :: UserAgent
user_agent, scheme :: Scheme
scheme = Scheme
None, Routing
routing :: Routing
routing :: Routing
routing, patchBolt :: Bool
patchBolt = Bool
pb}
            Text
"basic"    -> case (Maybe Ps
principal, Maybe Ps
credentials) of
              (Just Ps
p, Just Ps
c) -> do
                Text
p2 <- Ps -> Result Text
forall a. PackStream a => Ps -> Result a
fromPs Ps
p
                Text
c2 <- Ps -> Result Text
forall a. PackStream a => Ps -> Result a
fromPs Ps
c
                pure $ Hello {UserAgent
user_agent :: UserAgent
user_agent :: UserAgent
user_agent, scheme :: Scheme
scheme = Text -> Text -> Scheme
Basic Text
p2 Text
c2, Routing
routing :: Routing
routing :: Routing
routing, patchBolt :: Bool
patchBolt = Bool
pb}
              (Maybe Ps, Maybe Ps)
_ -> Text -> Result Hello
forall a. Text -> Result a
Error Text
"\"principal\" and \"credentials\" required for scheme \"basic\""
            Text
"kerberos" -> Hello -> Result Hello
forall a. a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Hello -> Result Hello) -> Hello -> Result Hello
forall a b. (a -> b) -> a -> b
$ Hello {UserAgent
user_agent :: UserAgent
user_agent :: UserAgent
user_agent, scheme :: Scheme
scheme = Scheme
Kerberos, Routing
routing :: Routing
routing :: Routing
routing, patchBolt :: Bool
patchBolt = Bool
pb}
            Text
"bearer"   -> case Maybe Ps
credentials of
              Just Ps
c  -> do
                Text
c2 <- Ps -> Result Text
forall a. PackStream a => Ps -> Result a
fromPs Ps
c
                pure $ Hello {UserAgent
user_agent :: UserAgent
user_agent :: UserAgent
user_agent, scheme :: Scheme
scheme = Text -> Scheme
Bearer Text
c2, Routing
routing :: Routing
routing :: Routing
routing, patchBolt :: Bool
patchBolt = Bool
pb}
              Maybe Ps
Nothing -> Text -> Result Hello
forall a. Text -> Result a
Error Text
"\"credentials\" required for scheme \"bearer\""
            Text
_          -> Text -> Result Hello
forall a. Text -> Result a
Error (Text -> Result Hello) -> Text -> Result Hello
forall a b. (a -> b) -> a -> b
$ Text
"unknown scheme: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
scheme


-- | LOGON message carries authentication credentials (Bolt 5.1+).
-- In 5.1+ HELLO no longer carries credentials; auth moves to LOGON.
type Logon :: Type
data Logon = Logon
  { Logon -> Scheme
scheme :: Scheme
  }
  deriving stock ((forall x. Logon -> Rep Logon x)
-> (forall x. Rep Logon x -> Logon) -> Generic Logon
forall x. Rep Logon x -> Logon
forall x. Logon -> Rep Logon x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Logon -> Rep Logon x
from :: forall x. Logon -> Rep Logon x
$cto :: forall x. Rep Logon x -> Logon
to :: forall x. Rep Logon x -> Logon
Generic)

instance PackStream Logon where
  toPs :: Logon -> Ps
toPs = Logon -> Ps
logonToPs
  fromPs :: Ps -> Result Logon
fromPs = Ps -> Result Logon
logonFromPs

logonToPs :: Logon -> Ps
logonToPs :: Logon -> Ps
logonToPs Logon{Scheme
scheme :: Logon -> Scheme
scheme :: Scheme
scheme} =
    HashMap Text Ps -> Ps
PsDictionary (HashMap Text Ps -> Ps) -> HashMap Text Ps -> Ps
forall a b. (a -> b) -> a -> b
$ [(Text, Ps)] -> HashMap Text Ps
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList ([(Text, Ps)] -> HashMap Text Ps)
-> [(Text, Ps)] -> HashMap Text Ps
forall a b. (a -> b) -> a -> b
$
      [ (Text
"scheme", Text -> Ps
forall a. PackStream a => a -> Ps
toPs Text
scheme')
      ] [(Text, Ps)] -> [(Text, Ps)] -> [(Text, Ps)]
forall a. Semigroup a => a -> a -> a
<>
        ( case Scheme
scheme of
            Scheme
None                        -> []
            Basic Text
principal Text
credentials -> [(Text
"principal", Text -> Ps
forall a. PackStream a => a -> Ps
toPs Text
principal), (Text
"credentials", Text -> Ps
forall a. PackStream a => a -> Ps
toPs Text
credentials)]
            Scheme
Kerberos                    -> []
            Bearer Text
credentials          -> [(Text
"credentials", Text -> Ps
forall a. PackStream a => a -> Ps
toPs Text
credentials)]
        )
  where
    scheme' :: T.Text
    scheme' :: Text
scheme' = case Scheme
scheme of
                Scheme
None      -> Text
"none"
                Basic Text
_ Text
_ -> Text
"basic"
                Scheme
Kerberos  -> Text
"kerberos"
                Bearer Text
_  -> Text
"bearer"

logonFromPs :: Ps -> Result Logon
logonFromPs :: Ps -> Result Logon
logonFromPs = Text -> (HashMap Text Ps -> Result Logon) -> Ps -> Result Logon
forall a. Text -> (HashMap Text Ps -> Result a) -> Ps -> Result a
withDictionary Text
"Request:Logon" HashMap Text Ps -> Result Logon
f
  where f :: H.HashMap T.Text Ps -> Result Logon
        f :: HashMap Text Ps -> Result Logon
f HashMap Text Ps
map = do
          Text
schemeTxt :: T.Text <- Text -> HashMap Text Ps -> Text -> Result Text
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Text -> Result v
lookupWithError Text
"scheme" HashMap Text Ps
map Text
"\"scheme\" not found in logon request"
          let credentials :: Maybe Ps
credentials = Text -> HashMap Text Ps -> Maybe Ps
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
"credentials" HashMap Text Ps
map
          let principal :: Maybe Ps
principal   = Text -> HashMap Text Ps -> Maybe Ps
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
"principal" HashMap Text Ps
map
          case Text
schemeTxt of
            Text
"none"     -> Logon -> Result Logon
forall a. a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Logon -> Result Logon) -> Logon -> Result Logon
forall a b. (a -> b) -> a -> b
$ Logon{scheme :: Scheme
scheme = Scheme
None}
            Text
"basic"    -> case (Maybe Ps
principal, Maybe Ps
credentials) of
              (Just Ps
p, Just Ps
c) -> do
                Text
p2 <- Ps -> Result Text
forall a. PackStream a => Ps -> Result a
fromPs Ps
p
                Text
c2 <- Ps -> Result Text
forall a. PackStream a => Ps -> Result a
fromPs Ps
c
                pure $ Logon{scheme :: Scheme
scheme = Text -> Text -> Scheme
Basic Text
p2 Text
c2}
              (Maybe Ps, Maybe Ps)
_ -> Text -> Result Logon
forall a. Text -> Result a
Error Text
"\"principal\" and \"credentials\" required for scheme \"basic\""
            Text
"kerberos" -> Logon -> Result Logon
forall a. a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Logon -> Result Logon) -> Logon -> Result Logon
forall a b. (a -> b) -> a -> b
$ Logon{scheme :: Scheme
scheme = Scheme
Kerberos}
            Text
"bearer"   -> case Maybe Ps
credentials of
              Just Ps
c  -> do
                Text
c2 <- Ps -> Result Text
forall a. PackStream a => Ps -> Result a
fromPs Ps
c
                pure $ Logon{scheme :: Scheme
scheme = Text -> Scheme
Bearer Text
c2}
              Maybe Ps
Nothing -> Text -> Result Logon
forall a. Text -> Result a
Error Text
"\"credentials\" required for scheme \"bearer\""
            Text
_          -> Text -> Result Logon
forall a. Text -> Result a
Error (Text -> Result Logon) -> Text -> Result Logon
forall a b. (a -> b) -> a -> b
$ Text
"unknown scheme: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
schemeTxt


-- | Telemetry API type indicators (Bolt 5.4+).
type TelemetryApi :: Type
data TelemetryApi
  = ManagedTransactions
  | ExplicitTransactions
  | ImplicitTransactions
  | ExecuteQuery
  deriving stock (Int -> TelemetryApi -> ShowS
[TelemetryApi] -> ShowS
TelemetryApi -> String
(Int -> TelemetryApi -> ShowS)
-> (TelemetryApi -> String)
-> ([TelemetryApi] -> ShowS)
-> Show TelemetryApi
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TelemetryApi -> ShowS
showsPrec :: Int -> TelemetryApi -> ShowS
$cshow :: TelemetryApi -> String
show :: TelemetryApi -> String
$cshowList :: [TelemetryApi] -> ShowS
showList :: [TelemetryApi] -> ShowS
Show, TelemetryApi -> TelemetryApi -> Bool
(TelemetryApi -> TelemetryApi -> Bool)
-> (TelemetryApi -> TelemetryApi -> Bool) -> Eq TelemetryApi
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TelemetryApi -> TelemetryApi -> Bool
== :: TelemetryApi -> TelemetryApi -> Bool
$c/= :: TelemetryApi -> TelemetryApi -> Bool
/= :: TelemetryApi -> TelemetryApi -> Bool
Eq)

telemetryApiToInt :: TelemetryApi -> Int64
telemetryApiToInt :: TelemetryApi -> Int64
telemetryApiToInt TelemetryApi
ManagedTransactions  = Int64
0
telemetryApiToInt TelemetryApi
ExplicitTransactions = Int64
1
telemetryApiToInt TelemetryApi
ImplicitTransactions = Int64
2
telemetryApiToInt TelemetryApi
ExecuteQuery         = Int64
3

telemetryApiFromInt :: Int64 -> Result TelemetryApi
telemetryApiFromInt :: Int64 -> Result TelemetryApi
telemetryApiFromInt Int64
0 = TelemetryApi -> Result TelemetryApi
forall a. a -> Result a
Success TelemetryApi
ManagedTransactions
telemetryApiFromInt Int64
1 = TelemetryApi -> Result TelemetryApi
forall a. a -> Result a
Success TelemetryApi
ExplicitTransactions
telemetryApiFromInt Int64
2 = TelemetryApi -> Result TelemetryApi
forall a. a -> Result a
Success TelemetryApi
ImplicitTransactions
telemetryApiFromInt Int64
3 = TelemetryApi -> Result TelemetryApi
forall a. a -> Result a
Success TelemetryApi
ExecuteQuery
telemetryApiFromInt Int64
n = Text -> Result TelemetryApi
forall a. Text -> Result a
Error (Text -> Result TelemetryApi) -> Text -> Result TelemetryApi
forall a b. (a -> b) -> a -> b
$ Text
"unknown telemetry api value: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int64 -> String
forall a. Show a => a -> String
show Int64
n)

fromPsToTelemetry :: V.Vector Ps -> Result Request
fromPsToTelemetry :: Vector Ps -> Result Request
fromPsToTelemetry Vector Ps
fields
  | Vector Ps -> Int
forall a. Vector a -> Int
V.length Vector Ps
fields Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1 = Text -> Result Request
forall a. Text -> Result a
Error Text
"expected exactly one field for Telemetry"
  | Bool
otherwise = case Vector Ps -> Ps
forall a. Vector a -> a
V.unsafeHead Vector Ps
fields of
      PsInteger PSInteger
n -> case PSInteger -> Maybe Int64
forall a. FromPSInteger a => PSInteger -> Maybe a
fromPSInteger PSInteger
n of
        Just Int64
i  -> (TelemetryApi -> Request) -> Result TelemetryApi -> Result Request
forall a b. (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TelemetryApi -> Request
RTelemetry (Result TelemetryApi -> Result Request)
-> Result TelemetryApi -> Result Request
forall a b. (a -> b) -> a -> b
$ Int64 -> Result TelemetryApi
telemetryApiFromInt Int64
i
        Maybe Int64
Nothing -> Text -> Result Request
forall a. Text -> Result a
Error Text
"telemetry api integer out of Int64 range"
      Ps
_           -> Text -> Result Request
forall a. Text -> Result a
Error Text
"expected integer field for Telemetry"