-- | Module for sending segments to the XRay daemon.

module Network.AWS.XRayClient.SendSegments
  ( sendSegmentsToDaemon
  , NoAddressInfoException(..)
  ) where

import Prelude

import Control.Exception (Exception, SomeException, catch, throwIO)
import Data.Aeson
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as BSL
import Data.Foldable (traverse_)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Typeable
import Network.AWS.XRayClient.Segment as X
import Network.Socket
import Network.Socket.ByteString (sendAll)
import System.IO (hPutStrLn, stderr)

-- | Makes JSON payloads for each segment and sends it to the daemon.
sendSegmentsToDaemon :: Text -> Int -> [XRaySegment] -> IO ()
sendSegmentsToDaemon :: Text -> Int -> [XRaySegment] -> IO ()
sendSegmentsToDaemon Text
host Int
port [XRaySegment]
segments = IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch
  (Text -> Int -> [ByteString] -> IO ()
sendUDPByteStrings Text
host Int
port ([ByteString] -> IO ()) -> [ByteString] -> IO ()
forall a b. (a -> b) -> a -> b
$ XRaySegment -> ByteString
makeXRayPayload (XRaySegment -> ByteString) -> [XRaySegment] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [XRaySegment]
segments)
  (\(SomeException
err :: SomeException) ->
    Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"sendUDPByteStrings: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SomeException -> String
forall a. Show a => a -> String
show SomeException
err)
  )

makeXRayPayload :: XRaySegment -> ByteString
makeXRayPayload :: XRaySegment -> ByteString
makeXRayPayload XRaySegment
segment =
  let header :: Value
header = [Pair] -> Value
object [Text
"format" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (String
"json" :: String), Text
"version" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Int
1 :: Int)]
  in ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
header ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> XRaySegment -> ByteString
forall a. ToJSON a => a -> ByteString
encode XRaySegment
segment

-- | Sends the entirety of multiple 'ByteString' values to a given host/port
-- via UDP Datagrams.
sendUDPByteStrings :: Text -> Int -> [ByteString] -> IO ()
sendUDPByteStrings :: Text -> Int -> [ByteString] -> IO ()
sendUDPByteStrings Text
host Int
port [ByteString]
payloads = do
  [AddrInfo]
addrInfos <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
getAddrInfo Maybe AddrInfo
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
host) (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
port)
  case [AddrInfo]
addrInfos of
    [] ->
      NoAddressInfoException -> IO ()
forall e a. Exception e => e -> IO a
throwIO
        (NoAddressInfoException -> IO ())
-> NoAddressInfoException -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> NoAddressInfoException
NoAddressInfoException
        (String -> NoAddressInfoException)
-> String -> NoAddressInfoException
forall a b. (a -> b) -> a -> b
$ String
"No address info for "
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
host
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":"
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
port
    (AddrInfo
serverAddr : [AddrInfo]
_) -> do
      Socket
sock <- Family -> SocketType -> ProtocolNumber -> IO Socket
socket (AddrInfo -> Family
addrFamily AddrInfo
serverAddr) SocketType
Datagram ProtocolNumber
defaultProtocol
      Socket -> SockAddr -> IO ()
connect Socket
sock (AddrInfo -> SockAddr
addrAddress AddrInfo
serverAddr)
      (ByteString -> IO ()) -> [ByteString] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Socket -> ByteString -> IO ()
sendAll Socket
sock) [ByteString]
payloads
      Socket -> IO ()
close Socket
sock

newtype NoAddressInfoException
  = NoAddressInfoException String
  deriving (Int -> NoAddressInfoException -> String -> String
[NoAddressInfoException] -> String -> String
NoAddressInfoException -> String
(Int -> NoAddressInfoException -> String -> String)
-> (NoAddressInfoException -> String)
-> ([NoAddressInfoException] -> String -> String)
-> Show NoAddressInfoException
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [NoAddressInfoException] -> String -> String
$cshowList :: [NoAddressInfoException] -> String -> String
show :: NoAddressInfoException -> String
$cshow :: NoAddressInfoException -> String
showsPrec :: Int -> NoAddressInfoException -> String -> String
$cshowsPrec :: Int -> NoAddressInfoException -> String -> String
Show, Typeable)

instance Exception NoAddressInfoException