Request.hs

{-# LANGUAGE OverloadedStrings #-}

module Database.Bolt.Protocol.Ver1.Request (
  init,
  reset,
  discardAll,
  pullAll,
  run,
  exec,
) where

import Prelude hiding (init)

import Database.Bolt.Exception
import Database.Bolt.Protocol.Ver1.Message (AuthToken, Message)
import Database.Bolt.Protocol.Ver1.Message qualified as Msg
import Database.Bolt.Protocol.Ver1.Types
import Database.Bolt.Transport
import Database.Bolt.Transport.Message

data Response
  = Success Metadata [Record]
  | Failed Metadata
  | Ignored Metadata

request :: (Transport t) => t -> Message -> IO Response
request conn msg = do
  -- print ("send", msg)
  sendmsg conn msg
  gather []
 where
  gather vals = do
    reply <- recvmsg conn
    -- print ("recv", reply)
    case reply of
      Msg.Success meta -> return $ Success meta (reverse vals)
      Msg.Failure meta -> return $ Failed meta
      Msg.Ignored meta -> return $ Ignored meta
      Msg.Record val -> gather (val : vals)
      _ -> protocolErr "Unexpected message in response"

simple :: (Transport t) => t -> Message -> IO ()
simple conn msg = do
  resp <- request conn msg
  case resp of
    Success _ [] -> return ()
    Success meta _ -> reqFail meta "Request not expecting records"
    Failed meta -> reqFail meta "Request failed"
    Ignored meta -> reqIgnore meta "Request ignored"

detail :: (Transport t) => t -> Message -> IO [Record]
detail conn msg = do
  resp <- request conn msg
  case resp of
    Success _ rs -> return rs
    Failed meta -> reqFail meta "Request failed"
    Ignored meta -> reqIgnore meta "Request ignored"

init :: (Transport t) => t -> UserAgent -> AuthToken -> IO ()
init conn agent auth = simple conn $ Msg.Init agent auth

reset :: (Transport t) => t -> IO ()
reset conn = simple conn Msg.Reset

discardAll :: (Transport t) => t -> IO ()
discardAll conn = simple conn Msg.DiscardAll

pullAll :: (Transport t) => t -> IO [Record]
pullAll conn = detail conn Msg.PullAll

run :: (Transport t) => t -> Statement -> Parameters -> IO ()
run conn stmt params = simple conn $ Msg.Run stmt params

exec :: (Transport t) => t -> Statement -> Parameters -> IO [Record]
exec conn stmt params = do
  run conn stmt params
  pullAll conn