{-# LANGUAGE ApplicativeDo #-}

-- | Internal module. Not part of the public API.
module Database.Bolty.Message.Response
  ( Response(..)
  , Failure(..)
  , SuccessHello(..)
  , SuccessRun(..), successFields, successTFirst
  , SuccessRunAutoCommitTransaction(..)
  , SuccessRunExplicitTransaction(..)
  , makeResponseRunAutoCommitTransaction
  , SuccessDiscard(..), SuccessDiscardLast(..)
  , SuccessPull(..), QueryMeta(..)
  , makeSuccessPull, mapToSuccessPull
  , SuccessCommit(..)
  , RoutingTable(..)
  , parseRoutingTable
  , extractBookmark
  ) where

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

import qualified Data.PackStream               as PS
import           Data.PackStream.Ps            as PS
import           Data.PackStream.Integer       (fromPSInteger)
import           Database.Bolty.Notification   (Notification, parseNotifications)
import           Database.Bolty.Plan           (PlanNode, ProfileNode, parsePlan, parseProfile)
import           Database.Bolty.Stats          (QueryStats, parseStats)
import           Database.Bolty.Record         (Record)

-- | A BOLT server response message.
--
-- the server always responds with one summary message if the connection is still open
-- the server always responds with zero or more detail messages before sending a summary message
type Response :: Type
data Response
  = RSuccess !(H.HashMap T.Text Ps)
  -- ^ https://neo4j.com/docs/bolt/current/bolt/message/#messages-success
  | RIgnored
  -- ^ https://neo4j.com/docs/bolt/current/bolt/message/#messages-ignored
  | RFailure Failure
  -- ^ https://neo4j.com/docs/bolt/current/bolt/message/#messages-failure
  | RRecord !Record
  -- ^ https://neo4j.com/docs/bolt/current/bolt/message/#messages-record
instance PS.PackStream Response where
  toPs :: Response -> Ps
toPs (RSuccess HashMap Text Ps
success) = Tag -> Ps -> Ps
structureSingleton Tag
0x70 (Ps -> Ps) -> Ps -> Ps
forall a b. (a -> b) -> a -> b
$ HashMap Text Ps -> Ps
forall a. PackStream a => a -> Ps
toPs HashMap Text Ps
success
  toPs (Response
RIgnored) = Tag -> Vector Ps -> Ps
PsStructure Tag
0x7E Vector Ps
forall a. Vector a
V.empty
  toPs (RFailure Failure
failure) = Tag -> Ps -> Ps
structureSingleton Tag
0x7F (Ps -> Ps) -> Ps -> Ps
forall a b. (a -> b) -> a -> b
$ Failure -> Ps
forall a. PackStream a => a -> Ps
toPs Failure
failure
  toPs (RRecord Record
records) = Tag -> Ps -> Ps
structureSingleton Tag
0x71 (Ps -> Ps) -> Ps -> Ps
forall a b. (a -> b) -> a -> b
$ Record -> Ps
forall a. PackStream a => a -> Ps
toPs Record
records
  fromPs :: Ps -> Result Response
fromPs (PsStructure Tag
0x70 Vector Ps
fields) = Vector Ps
-> (HashMap Text Ps -> Response) -> Text -> Result Response
forall a b.
PackStream a =>
Vector Ps -> (a -> b) -> Text -> Result b
PS.fromOneField Vector Ps
fields HashMap Text Ps -> Response
RSuccess Text
"expected exactly one field for Success"
  fromPs (PsStructure Tag
0x7E Vector Ps
fields) = if Vector Ps -> Bool
forall a. Vector a -> Bool
V.null Vector Ps
fields then Response -> Result Response
forall a. a -> Result a
PS.Success Response
RIgnored else Text -> Result Response
forall a. Text -> Result a
PS.Error Text
"additional data on Ignored request is not allowed"
  fromPs (PsStructure Tag
0x7F Vector Ps
fields) = Vector Ps -> (Failure -> Response) -> Text -> Result Response
forall a b.
PackStream a =>
Vector Ps -> (a -> b) -> Text -> Result b
PS.fromOneField Vector Ps
fields Failure -> Response
RFailure Text
"expected exactly one field for Failure"
  fromPs (PsStructure Tag
0x71 Vector Ps
fields) = Vector Ps -> (Record -> Response) -> Text -> Result Response
forall a b.
PackStream a =>
Vector Ps -> (a -> b) -> Text -> Result b
PS.fromOneField Vector Ps
fields Record -> Response
RRecord Text
"expected exactly one field for Record"
  fromPs Ps
_                         = Text -> Result Response
forall a. Text -> Result a
PS.Error Text
"Could not decode Response"



-- | Parse a RUN SUCCESS response for an auto-commit transaction.
makeResponseRunAutoCommitTransaction :: H.HashMap T.Text Ps -> Either T.Text SuccessRun
makeResponseRunAutoCommitTransaction :: HashMap Text Ps -> Either Text SuccessRun
makeResponseRunAutoCommitTransaction HashMap Text Ps
map = do
  Vector Text
fields <- Text -> HashMap Text Ps -> Either Text (Vector Text)
forall v. PackStream v => Text -> HashMap Text Ps -> Either Text v
PS.lookupMaybeError Text
"fields" HashMap Text Ps
map
  Int64
t_first <- Text -> HashMap Text Ps -> Either Text Int64
forall v. PackStream v => Text -> HashMap Text Ps -> Either Text v
PS.lookupMaybeError Text
"t_first" HashMap Text Ps
map
  pure $ SuccessRunAutoCommitTransaction -> SuccessRun
AutoCommitTransaction (SuccessRunAutoCommitTransaction -> SuccessRun)
-> SuccessRunAutoCommitTransaction -> SuccessRun
forall a b. (a -> b) -> a -> b
$ Vector Text -> Int64 -> SuccessRunAutoCommitTransaction
SuccessRunAutoCommitTransaction Vector Text
fields Int64
t_first



-- | Build a 'SuccessPull' from collected records and PULL SUCCESS metadata (Either version).
makeSuccessPull :: V.Vector Record -> H.HashMap T.Text Ps -> Either T.Text SuccessPull
makeSuccessPull :: Vector Record -> HashMap Text Ps -> Either Text SuccessPull
makeSuccessPull Vector Record
records HashMap Text Ps
map = do
  let bookmark :: Maybe Text
bookmark = case Text -> HashMap Text Ps -> Either Text Text
forall v. PackStream v => Text -> HashMap Text Ps -> Either Text v
PS.lookupMaybeError Text
"bookmark" HashMap Text Ps
map of
                   Right Text
b -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
b
                   Left Text
_  -> Maybe Text
forall a. Maybe a
Nothing
  Int64
t_last <- Text -> HashMap Text Ps -> Either Text Int64
forall v. PackStream v => Text -> HashMap Text Ps -> Either Text v
PS.lookupMaybeError Text
"t_last" HashMap Text Ps
map
  Text
type_ <- Text -> HashMap Text Ps -> Either Text Text
forall v. PackStream v => Text -> HashMap Text Ps -> Either Text v
PS.lookupMaybeError Text
"type" HashMap Text Ps
map
  Text
db <- Text -> HashMap Text Ps -> Either Text Text
forall v. PackStream v => Text -> HashMap Text Ps -> Either Text v
PS.lookupMaybeError Text
"db" HashMap Text Ps
map
  let stats :: Maybe Ps
stats = Text -> HashMap Text Ps -> Maybe Ps
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
"stats" HashMap Text Ps
map
  let parsedStats :: Maybe QueryStats
parsedStats = Maybe Ps -> Maybe QueryStats
parseStats Maybe Ps
stats
  let plan :: Maybe Ps
plan = Text -> HashMap Text Ps -> Maybe Ps
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
"plan" HashMap Text Ps
map
  let profile :: Maybe Ps
profile = Text -> HashMap Text Ps -> Maybe Ps
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
"profile" HashMap Text Ps
map
  let notifications :: Maybe Ps
notifications = Text -> HashMap Text Ps -> Maybe Ps
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
"notifications" HashMap Text Ps
map
  let parsedNotifications :: Vector Notification
parsedNotifications = Maybe Ps -> Vector Notification
parseNotifications Maybe Ps
notifications
  let parsedPlan :: Maybe PlanNode
parsedPlan = Maybe Ps -> Maybe PlanNode
parsePlan Maybe Ps
plan
  let parsedProfile :: Maybe ProfileNode
parsedProfile = Maybe Ps -> Maybe ProfileNode
parseProfile Maybe Ps
profile
  let infos :: QueryMeta
infos = QueryMeta{Maybe Text
bookmark :: Maybe Text
bookmark :: Maybe Text
bookmark, Int64
t_last :: Int64
t_last :: Int64
t_last, Text
type_ :: Text
type_ :: Text
type_, Maybe Ps
stats :: Maybe Ps
stats :: Maybe Ps
stats, Maybe QueryStats
parsedStats :: Maybe QueryStats
parsedStats :: Maybe QueryStats
parsedStats, Maybe Ps
plan :: Maybe Ps
plan :: Maybe Ps
plan, Maybe Ps
profile :: Maybe Ps
profile :: Maybe Ps
profile, Maybe Ps
notifications :: Maybe Ps
notifications :: Maybe Ps
notifications, Vector Notification
parsedNotifications :: Vector Notification
parsedNotifications :: Vector Notification
parsedNotifications, Maybe PlanNode
parsedPlan :: Maybe PlanNode
parsedPlan :: Maybe PlanNode
parsedPlan, Maybe ProfileNode
parsedProfile :: Maybe ProfileNode
parsedProfile :: Maybe ProfileNode
parsedProfile, Text
db :: Text
db :: Text
db}
  SuccessPull -> Either Text SuccessPull
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SuccessPull -> Either Text SuccessPull)
-> SuccessPull -> Either Text SuccessPull
forall a b. (a -> b) -> a -> b
$ SuccessPull{Vector Record
records :: Vector Record
records :: Vector Record
records, QueryMeta
infos :: QueryMeta
infos :: QueryMeta
infos}





-- | A server-reported failure with a Neo4j error code and human-readable message.
type Failure :: Type
data Failure = Failure
  { Failure -> Text
code :: !T.Text
  , Failure -> Text
message :: !T.Text
  }
instance PS.PackStream Failure where
  toPs :: Failure -> Ps
toPs (Failure Text
code Text
message) = 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
"code", Text -> Ps
forall a. PackStream a => a -> Ps
toPs Text
code), (Text
"message", Text -> Ps
forall a. PackStream a => a -> Ps
toPs Text
message)]
  fromPs :: Ps -> Result Failure
fromPs (PsDictionary HashMap Text Ps
map) = do
    Text
code <- Text -> HashMap Text Ps -> Text -> Result Text
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Text -> Result v
PS.lookupWithError Text
"code" HashMap Text Ps
map Text
"expected \"code\" in Failure response"
    Text
message <- Text -> HashMap Text Ps -> Text -> Result Text
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Text -> Result v
PS.lookupWithError Text
"message" HashMap Text Ps
map Text
"expected \"message\" in Failure response"
    Failure -> Result Failure
forall a. a -> Result a
PS.Success (Failure -> Result Failure) -> Failure -> Result Failure
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Failure
Failure Text
code Text
message
  fromPs Ps
_ = Text -> Result Failure
forall a. Text -> Result a
PS.Error Text
"expected dictionary for Failure"




-- | Parsed HELLO SUCCESS metadata.
type SuccessHello :: Type
data SuccessHello = SuccessHello
  { SuccessHello -> Text
server :: !T.Text
  -- ^ server agent string, example "Neo4j/4.1.0"
  , SuccessHello -> Text
connection_id :: !T.Text
  -- ^ unique identifier of the bolt connection used on the server side, example: "bolt-61"
  , SuccessHello -> HashMap Text Ps
hints :: !(H.HashMap T.Text Ps)
  -- ^ set of optional configuration hints to be considered by the driver
  }

-- | Parsed RUN SUCCESS metadata, either auto-commit or explicit transaction.
type SuccessRun :: Type
data SuccessRun
  = AutoCommitTransaction SuccessRunAutoCommitTransaction
  | ExplicitTransaction SuccessRunExplicitTransaction

-- | Extract the result field names from a 'SuccessRun'.
successFields :: SuccessRun -> V.Vector T.Text
successFields :: SuccessRun -> Vector Text
successFields (AutoCommitTransaction (SuccessRunAutoCommitTransaction Vector Text
fields Int64
_)) = Vector Text
fields
successFields (ExplicitTransaction (SuccessRunExplicitTransaction Vector Text
fields Int64
_ Int64
_)) = Vector Text
fields

-- | Extract the @t_first@ timing value from a 'SuccessRun'.
successTFirst :: SuccessRun -> Int64
successTFirst :: SuccessRun -> Int64
successTFirst (AutoCommitTransaction (SuccessRunAutoCommitTransaction Vector Text
_ Int64
tf)) = Int64
tf
successTFirst (ExplicitTransaction (SuccessRunExplicitTransaction Vector Text
_ Int64
tf Int64
_)) = Int64
tf

-- | RUN SUCCESS metadata for an auto-commit transaction.
type SuccessRunAutoCommitTransaction :: Type
data SuccessRunAutoCommitTransaction = SuccessRunAutoCommitTransaction
  { SuccessRunAutoCommitTransaction -> Vector Text
fields :: !(V.Vector T.Text)
  -- ^ the fields of the return result. e.g. [“name”, “age”, …]
  , SuccessRunAutoCommitTransaction -> Int64
t_first :: !Int64
  -- ^ the time, specified in ms, which the first record in the result stream is available after
  }

-- | RUN SUCCESS metadata for an explicit transaction.
type SuccessRunExplicitTransaction :: Type
data SuccessRunExplicitTransaction = SuccessRunExplicitTransaction
  { SuccessRunExplicitTransaction -> Vector Text
fields :: !(V.Vector T.Text)
  -- ^ the fields of the return result. e.g. [“name”, “age”, …]
  , SuccessRunExplicitTransaction -> Int64
t_first :: !Int64
  -- ^ the time, specified in ms, which the first record in the result stream is available after
  , SuccessRunExplicitTransaction -> Int64
qid :: !Int64
  -- ^ specifies the server assigned statement ID to reference the server side result-set with commencing BEGIN+RUN+PULL and BEGIN+RUN+DISCARD messages.
  }

-- | Parsed DISCARD SUCCESS response.
type SuccessDiscard :: Type
data SuccessDiscard
  = DiscardMore
  | DiscardLast SuccessDiscardLast

-- | Final DISCARD SUCCESS metadata with bookmark and database.
type SuccessDiscardLast :: Type
data SuccessDiscardLast = SuccessDiscardLast
  { SuccessDiscardLast -> Text
bookmark :: !T.Text
  -- ^ the bookmark after committing this transaction (Auto-commit Transaction only)
  , SuccessDiscardLast -> Text
db :: !T.Text
  -- ^ the database name where the query is executed.
  }

-- | Build a 'SuccessPull' from collected records and PULL SUCCESS metadata (Result version).
mapToSuccessPull :: V.Vector Record -> H.HashMap T.Text Ps -> PS.Result SuccessPull
mapToSuccessPull :: Vector Record -> HashMap Text Ps -> Result SuccessPull
mapToSuccessPull Vector Record
records HashMap Text Ps
map = do
  Maybe Text
bookmark :: Maybe T.Text <- Text -> HashMap Text Ps -> Result (Maybe Text)
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Result (Maybe v)
PS.lookupMaybe Text
"bookmark" HashMap Text Ps
map
  Int64
t_last :: Int64    <- Text -> HashMap Text Ps -> Text -> Result Int64
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Text -> Result v
PS.lookupWithError Text
"t_last" HashMap Text Ps
map Text
"could not find \"t_last\" in Pull response"
  Text
type_ :: T.Text    <- Text -> HashMap Text Ps -> Text -> Result Text
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Text -> Result v
PS.lookupWithError Text
"type" HashMap Text Ps
map Text
"could not find \"type\" in Pull response"
  Text
db :: T.Text       <- Text -> HashMap Text Ps -> Text -> Result Text
forall v.
PackStream v =>
Text -> HashMap Text Ps -> Text -> Result v
PS.lookupWithError Text
"db" HashMap Text Ps
map Text
"could not find \"db\" in Pull response"
  let stats :: Maybe Ps
stats         = Text -> HashMap Text Ps -> Maybe Ps
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
"stats" HashMap Text Ps
map
  let parsedStats :: Maybe QueryStats
parsedStats   = Maybe Ps -> Maybe QueryStats
parseStats Maybe Ps
stats
  let plan :: Maybe Ps
plan          = Text -> HashMap Text Ps -> Maybe Ps
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
"plan" HashMap Text Ps
map
  let profile :: Maybe Ps
profile       = Text -> HashMap Text Ps -> Maybe Ps
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
"profile" HashMap Text Ps
map
  let notifications :: Maybe Ps
notifications = Text -> HashMap Text Ps -> Maybe Ps
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
"notifications" HashMap Text Ps
map
  let parsedNotifications :: Vector Notification
parsedNotifications = Maybe Ps -> Vector Notification
parseNotifications Maybe Ps
notifications
  let parsedPlan :: Maybe PlanNode
parsedPlan    = Maybe Ps -> Maybe PlanNode
parsePlan Maybe Ps
plan
  let parsedProfile :: Maybe ProfileNode
parsedProfile = Maybe Ps -> Maybe ProfileNode
parseProfile Maybe Ps
profile
  let infos :: QueryMeta
infos = QueryMeta{Maybe Text
bookmark :: Maybe Text
bookmark :: Maybe Text
bookmark, Int64
t_last :: Int64
t_last :: Int64
t_last, Text
type_ :: Text
type_ :: Text
type_, Maybe Ps
stats :: Maybe Ps
stats :: Maybe Ps
stats, Maybe QueryStats
parsedStats :: Maybe QueryStats
parsedStats :: Maybe QueryStats
parsedStats, Maybe Ps
plan :: Maybe Ps
plan :: Maybe Ps
plan, Maybe Ps
profile :: Maybe Ps
profile :: Maybe Ps
profile, Maybe Ps
notifications :: Maybe Ps
notifications :: Maybe Ps
notifications, Vector Notification
parsedNotifications :: Vector Notification
parsedNotifications :: Vector Notification
parsedNotifications, Maybe PlanNode
parsedPlan :: Maybe PlanNode
parsedPlan :: Maybe PlanNode
parsedPlan, Maybe ProfileNode
parsedProfile :: Maybe ProfileNode
parsedProfile :: Maybe ProfileNode
parsedProfile, Text
db :: Text
db :: Text
db}
  SuccessPull -> Result SuccessPull
forall a. a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SuccessPull -> Result SuccessPull)
-> SuccessPull -> Result SuccessPull
forall a b. (a -> b) -> a -> b
$ SuccessPull{Vector Record
records :: Vector Record
records :: Vector Record
records, QueryMeta
infos :: QueryMeta
infos :: QueryMeta
infos}




-- | Full query result: records plus server metadata.
type SuccessPull :: Type
data SuccessPull = SuccessPull
  { SuccessPull -> Vector Record
records :: !(V.Vector Record)
  , SuccessPull -> QueryMeta
infos   :: !QueryMeta
  }

-- | Server metadata from a PULL SUCCESS response.
type QueryMeta :: Type
data QueryMeta = QueryMeta
  { QueryMeta -> Maybe Text
bookmark :: !(Maybe T.Text)
  -- ^ the bookmark after committing this transaction (Autocommit Transaction only, absent in explicit transactions).
  , QueryMeta -> Int64
t_last :: !Int64
  -- ^ the time, specified in ms, which the last record in the result stream is consumed after.
  , QueryMeta -> Text
type_ :: !T.Text
  -- ^ the type of the statement, e.g. "r" for read-only statement, "w" for write-only statement, "rw" for read-and-write, and "s" for schema only.
  , QueryMeta -> Maybe Ps
stats :: !(Maybe Ps)
  -- ^ counter information, such as db-hits etc. May be omitted.
  , QueryMeta -> Maybe QueryStats
parsedStats :: !(Maybe QueryStats)
  -- ^ parsed stats from the raw field above.
  , QueryMeta -> Maybe Ps
plan :: !(Maybe Ps)
  -- ^ plan result. May be omitted.
  , QueryMeta -> Maybe Ps
profile :: !(Maybe Ps)
  -- ^ profile result. May be omitted.
  , QueryMeta -> Maybe Ps
notifications :: !(Maybe Ps)
  -- ^ a list of all notifications generated during execution of this statement. May be omitted.
  , QueryMeta -> Vector Notification
parsedNotifications :: !(V.Vector Notification)
  -- ^ parsed notifications from the raw field above.
  , QueryMeta -> Maybe PlanNode
parsedPlan :: !(Maybe PlanNode)
  -- ^ parsed plan tree from the raw @plan@ field above.
  , QueryMeta -> Maybe ProfileNode
parsedProfile :: !(Maybe ProfileNode)
  -- ^ parsed profile tree from the raw @profile@ field above.
  , QueryMeta -> Text
db :: !T.Text
  -- ^ the database name where the query was executed (v4.0+).
  }

-- | Parsed COMMIT SUCCESS metadata.
type SuccessCommit :: Type
data SuccessCommit = SuccessCommit
  { SuccessCommit -> Text
bookmark :: !T.Text
  -- ^ the bookmark after committing this transaction.
  }


-- | A parsed routing table returned by the ROUTE message.
type RoutingTable :: Type
data RoutingTable = RoutingTable
  { RoutingTable -> Int64
ttl     :: !Int64
  -- ^ Seconds to cache this routing table.
  , RoutingTable -> Text
db      :: !T.Text
  -- ^ Database name this routing table is for.
  , RoutingTable -> Vector Text
routers :: !(V.Vector T.Text)
  -- ^ "host:port" addresses for ROUTE role.
  , RoutingTable -> Vector Text
readers :: !(V.Vector T.Text)
  -- ^ "host:port" addresses for READ role.
  , RoutingTable -> Vector Text
writers :: !(V.Vector T.Text)
  -- ^ "host:port" addresses for WRITE role.
  }
  deriving stock (Int -> RoutingTable -> ShowS
[RoutingTable] -> ShowS
RoutingTable -> String
(Int -> RoutingTable -> ShowS)
-> (RoutingTable -> String)
-> ([RoutingTable] -> ShowS)
-> Show RoutingTable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RoutingTable -> ShowS
showsPrec :: Int -> RoutingTable -> ShowS
$cshow :: RoutingTable -> String
show :: RoutingTable -> String
$cshowList :: [RoutingTable] -> ShowS
showList :: [RoutingTable] -> ShowS
Show, RoutingTable -> RoutingTable -> Bool
(RoutingTable -> RoutingTable -> Bool)
-> (RoutingTable -> RoutingTable -> Bool) -> Eq RoutingTable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RoutingTable -> RoutingTable -> Bool
== :: RoutingTable -> RoutingTable -> Bool
$c/= :: RoutingTable -> RoutingTable -> Bool
/= :: RoutingTable -> RoutingTable -> Bool
Eq)


-- | Parse a routing table from the SUCCESS response metadata of a ROUTE message.
-- The expected wire format is:
-- @{"rt": {"ttl": N, "db": "name", "servers": [{"addresses": [...], "role": "WRITE"}, ...]}}@
parseRoutingTable :: H.HashMap T.Text Ps -> Either T.Text RoutingTable
parseRoutingTable :: HashMap Text Ps -> Either Text RoutingTable
parseRoutingTable HashMap Text Ps
meta = do
  HashMap Text Ps
rtPs <- case Text -> HashMap Text Ps -> Maybe Ps
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
"rt" HashMap Text Ps
meta of
    Just (PsDictionary HashMap Text Ps
m) -> HashMap Text Ps -> Either Text (HashMap Text Ps)
forall a b. b -> Either a b
Right HashMap Text Ps
m
    Just Ps
_  -> Text -> Either Text (HashMap Text Ps)
forall a b. a -> Either a b
Left Text
"\"rt\" field should be a dictionary"
    Maybe Ps
Nothing -> Text -> Either Text (HashMap Text Ps)
forall a b. a -> Either a b
Left Text
"\"rt\" key not found in ROUTE response"
  Int64
ttl <- case Text -> HashMap Text Ps -> Maybe Ps
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
"ttl" HashMap Text Ps
rtPs of
    Just (PsInteger PSInteger
n) -> case PSInteger -> Maybe Int64
forall a. FromPSInteger a => PSInteger -> Maybe a
fromPSInteger PSInteger
n of
      Just Int64
i  -> Int64 -> Either Text Int64
forall a b. b -> Either a b
Right Int64
i
      Maybe Int64
Nothing -> Text -> Either Text Int64
forall a b. a -> Either a b
Left Text
"\"ttl\" integer out of Int64 range"
    Just Ps
_  -> Text -> Either Text Int64
forall a b. a -> Either a b
Left Text
"\"ttl\" should be an integer"
    Maybe Ps
Nothing -> Text -> Either Text Int64
forall a b. a -> Either a b
Left Text
"\"ttl\" not found in routing table"
  Text
db <- case Text -> HashMap Text Ps -> Maybe Ps
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
"db" HashMap Text Ps
rtPs of
    Just (PsString Text
s) -> Text -> Either Text Text
forall a b. b -> Either a b
Right Text
s
    Just Ps
_  -> Text -> Either Text Text
forall a b. a -> Either a b
Left Text
"\"db\" should be a string"
    Maybe Ps
Nothing -> Text -> Either Text Text
forall a b. a -> Either a b
Left Text
"\"db\" not found in routing table"
  Vector Ps
serversPs <- case Text -> HashMap Text Ps -> Maybe Ps
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
"servers" HashMap Text Ps
rtPs of
    Just (PsList Vector Ps
v) -> Vector Ps -> Either Text (Vector Ps)
forall a b. b -> Either a b
Right Vector Ps
v
    Just Ps
_  -> Text -> Either Text (Vector Ps)
forall a b. a -> Either a b
Left Text
"\"servers\" should be a list"
    Maybe Ps
Nothing -> Text -> Either Text (Vector Ps)
forall a b. a -> Either a b
Left Text
"\"servers\" not found in routing table"
  let (Vector Text
routers, Vector Text
readers, Vector Text
writers) = ((Vector Text, Vector Text, Vector Text)
 -> Ps -> (Vector Text, Vector Text, Vector Text))
-> (Vector Text, Vector Text, Vector Text)
-> Vector Ps
-> (Vector Text, Vector Text, Vector Text)
forall a b. (a -> b -> a) -> a -> Vector b -> a
V.foldl' (Vector Text, Vector Text, Vector Text)
-> Ps -> (Vector Text, Vector Text, Vector Text)
classifyServer (Vector Text
forall a. Vector a
V.empty, Vector Text
forall a. Vector a
V.empty, Vector Text
forall a. Vector a
V.empty) Vector Ps
serversPs
  RoutingTable -> Either Text RoutingTable
forall a b. b -> Either a b
Right RoutingTable{Int64
ttl :: Int64
ttl :: Int64
ttl, Text
db :: Text
db :: Text
db, Vector Text
routers :: Vector Text
routers :: Vector Text
routers, Vector Text
readers :: Vector Text
readers :: Vector Text
readers, Vector Text
writers :: Vector Text
writers :: Vector Text
writers}


-- | Classify a single server entry from the routing table by its role.
classifyServer :: (V.Vector T.Text, V.Vector T.Text, V.Vector T.Text)
               -> Ps
               -> (V.Vector T.Text, V.Vector T.Text, V.Vector T.Text)
classifyServer :: (Vector Text, Vector Text, Vector Text)
-> Ps -> (Vector Text, Vector Text, Vector Text)
classifyServer (Vector Text
rout, Vector Text
rd, Vector Text
wr) (PsDictionary HashMap Text Ps
m) =
  case (Text -> HashMap Text Ps -> Maybe Ps
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
"role" HashMap Text Ps
m, Text -> HashMap Text Ps -> Maybe Ps
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
"addresses" HashMap Text Ps
m) of
    (Just (PsString Text
role), Just (PsList Vector Ps
addrs)) ->
      let addrTexts :: Vector Text
addrTexts = (Ps -> Maybe Text) -> Vector Ps -> Vector Text
forall a b. (a -> Maybe b) -> Vector a -> Vector b
V.mapMaybe Ps -> Maybe Text
extractText Vector Ps
addrs
      in case Text
role of
           Text
"ROUTE" -> (Vector Text
rout Vector Text -> Vector Text -> Vector Text
forall a. Semigroup a => a -> a -> a
<> Vector Text
addrTexts, Vector Text
rd, Vector Text
wr)
           Text
"READ"  -> (Vector Text
rout, Vector Text
rd Vector Text -> Vector Text -> Vector Text
forall a. Semigroup a => a -> a -> a
<> Vector Text
addrTexts, Vector Text
wr)
           Text
"WRITE" -> (Vector Text
rout, Vector Text
rd, Vector Text
wr Vector Text -> Vector Text -> Vector Text
forall a. Semigroup a => a -> a -> a
<> Vector Text
addrTexts)
           Text
_       -> (Vector Text
rout, Vector Text
rd, Vector Text
wr)
    (Maybe Ps, Maybe Ps)
_ -> (Vector Text
rout, Vector Text
rd, Vector Text
wr)
classifyServer (Vector Text, Vector Text, Vector Text)
acc Ps
_ = (Vector Text, Vector Text, Vector Text)
acc


extractText :: Ps -> Maybe T.Text
extractText :: Ps -> Maybe Text
extractText (PsString Text
t) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
extractText Ps
_            = Maybe Text
forall a. Maybe a
Nothing


-- | Extract the bookmark from a SUCCESS response metadata (e.g. from COMMIT).
-- Returns 'Nothing' if the @bookmark@ key is absent or not a text value.
extractBookmark :: H.HashMap T.Text Ps -> Maybe T.Text
extractBookmark :: HashMap Text Ps -> Maybe Text
extractBookmark HashMap Text Ps
meta = case Text -> HashMap Text Ps -> Maybe Ps
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
"bookmark" HashMap Text Ps
meta of
  Just (PsString Text
t) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
  Maybe Ps
_                 -> Maybe Text
forall a. Maybe a
Nothing