Client.hs

{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}

module Network.Skylark.Client
  ( runSkylark
  , runSkylark'
  ) where

import Control.Concurrent.Async.Lifted
import Control.Concurrent.STM
import Data.Conduit
import Data.Conduit.TQueue
import Network.HTTP.Conduit
import Network.HTTP.Types
import Network.HTTP.Types.Header
import Preamble

{-# ANN module ("HLint: ignore Redundant flip"::String) #-}

-- | Device-Uid Header
--
hDevice :: HeaderName
hDevice = "Device-Uid"

-- | SBPv2 Content-Type
--
sbpContentType :: ByteString
sbpContentType = "application/vnd.swiftnav.broker.v1+sbp2"

-- | Download data from Skylark to sink.
--
download :: MonadIO m => ByteString -> Manager -> Request -> TBQueue ByteString -> m ()
download device manager request queue =
  liftIO $ runResourceT $ do
    response <- flip http manager request
      { method = methodGet
      , requestHeaders =
          [ (hAccept, sbpContentType)
          , (hDevice, device)
          , (hPragma, "proxy")
          ]
      }
    responseBody response $$+- sinkTBQueue queue


-- | Upload data to Skylark from source.
--
upload :: MonadIO m => ByteString -> Manager -> Request -> TBQueue ByteString -> m ()
upload device manager request queue =
  void $ flip httpLbs manager request
    { method      = methodPut
    , requestHeaders =
        [ (hContentType, sbpContentType)
        , (hDevice, device)
        ]
    , requestBody = requestBodySourceChunked $ sourceTBQueue queue
    }

-- | Run Skylark client with connections concurrent.
--
runSkylark :: MonadControl m => String -> ByteString -> Source m ByteString -> Sink ByteString m () -> m ()
runSkylark url device source sink = do
  manager   <- liftIO $ newManager tlsManagerSettings
  request   <- parseRequest url
  upQueue   <- liftIO $ atomically $ newTBQueue 8192
  downQueue <- liftIO $ atomically $ newTBQueue 8192
  void $ concurrently
    (concurrently (download device manager request downQueue) (sourceTBQueue downQueue $$ sink))
    (concurrently (source $$ sinkTBQueue upQueue) (upload device manager request upQueue))

-- | Run Skylark client with connections racing.
--
runSkylark' :: MonadControl m => String -> ByteString -> Source m ByteString -> Sink ByteString m () -> m ()
runSkylark' url device source sink = do
  manager   <- liftIO $ newManager tlsManagerSettings
  request   <- parseRequest url
  upQueue   <- liftIO $ atomically $ newTBQueue 8192
  downQueue <- liftIO $ atomically $ newTBQueue 8192
  race_
    (race_ (download device manager request downQueue) (sourceTBQueue downQueue $$ sink))
    (race_ (source $$ sinkTBQueue upQueue) (upload device manager request upQueue))