Client.hs

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

module Network.Skylark.Client
  ( runSkylark
  ) where

import Control.Concurrent.Async
import Control.Monad.Trans.Resource
import Data.Conduit
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 -> Sink ByteString (ResourceT IO) () -> m ()
download device manager request sink =
  liftIO $ runResourceT $ do
    response <- flip http manager request
      { method = methodGet
      , requestHeaders =
          [ (hAccept, sbpContentType)
          , (hDevice, device)
          , (hPragma, "proxy")
          ]
      }
    responseBody response $$+- sink

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

-- | Run Skylark client.
--
runSkylark :: (MonadIO m, MonadThrow m) => String -> ByteString -> Source (ResourceT IO) ByteString -> Sink ByteString (ResourceT IO) () -> m ()
runSkylark url device source sink = do
  manager <- liftIO $ newManager tlsManagerSettings
  request <- parseRequest url
  liftIO $ void $ concurrently (upload device manager request source) (download device manager request sink)