module DMCC.XML.Raw where
import DMCC.Prelude
import Data.Binary.Get
import Data.Binary.Put
import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as L8
import System.IO.Streams (InputStream, OutputStream)
import qualified System.IO.Streams as Streams
import Text.Printf
import DMCC.XML.Request
import DMCC.XML.Response
sendRequest :: MonadLoggerIO m
=> OutputStream S.ByteString
-> Int
-> Request
-> m ()
sendRequest h ix rq = do
logDebugN
$ "Sending request (invokeId=" <> tshow ix <> ") "
<> tshow (L8.unpack rawRequest)
liftIO $ flip Streams.writeLazyByteString h $ runPut $ do
putWord16be 0
putWord16be . fromIntegral $ 8 + L.length rawRequest
let invokeId = S.pack . take 4 $ printf "%04d" ix
putByteString invokeId
putLazyByteString rawRequest
where rawRequest = toXml rq
readResponse :: MonadLoggerIO m
=> InputStream S.ByteString
-> m (Response, Int)
readResponse h = do
let readLazy i = do
v <- Streams.readExactly i h
pure $ L.fromChunks [v]
(len, invokeId) <- liftIO $ runGet readHeader <$> readLazy 8
resp <- liftIO $ readLazy $ len - 8
logDebugN
$ "Received response (invokeId=" <> tshow invokeId <> ") "
<> tshow (L8.unpack resp)
pure (fromXml resp, invokeId)
where
readHeader = do
skip 2
len <- fromIntegral <$> getWord16be
ix <- getByteString 4
case S.readInt ix of
Just (invokeId, "") -> pure (len, invokeId)
_ -> fail $ "Invalid InvokeID: " <> show ix