skylark-client 0.1.0 → 0.1.1

raw patch · 3 files changed

+30/−24 lines, 3 filesdep +lifted-asyncdep +stmdep +stm-conduitdep −async

Dependencies added: lifted-async, stm, stm-conduit

Dependencies removed: async

Files

• main/skylark-client.hs +2/−2
• skylark-client.cabal +5/−4
• src/Network/Skylark/Client.hs +23/−18

@@ -17,5 +17,5 @@  main :: IO () main = do-  args <- getRecord "NTRIP Client"-  runSkylark (url args) (device args) (sourceHandle stdin) (sinkHandle stdout)+  args <- getRecord "Skylark Client"+  runResourceT $ runSkylark (url args) (device args) (sourceHandle stdin) (sinkHandle stdout)

@@ -1,5 +1,5 @@ name:                  skylark-client-version:               0.1.0+version:               0.1.1 synopsis:              Skylark client. description:           Skylark network client. homepage:              https://github.com/githubuser/skylark-client#readme@@ -16,14 +16,15 @@   exposed-modules:     Network.Skylark.Client   ghc-options:         -Wall   default-language:    Haskell2010-  build-depends:       async-                     , base == 4.8.*+  build-depends:       base == 4.8.*                      , conduit-                     , conduit-extra                      , http-conduit                      , http-types+                     , lifted-async                      , preamble                      , resourcet+                     , stm+                     , stm-conduit  executable skylark-client   hs-source-dirs:      main

@@ -1,3 +1,4 @@+{-# LANGUAGE FlexibleContexts  #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} @@ -5,14 +6,17 @@   ( runSkylark   ) where -import Control.Concurrent.Async+import Control.Concurrent.Async.Lifted+import Control.Concurrent.STM import Control.Monad.Trans.Resource 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@@ -27,36 +31,37 @@  -- | 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+download :: MonadResource m => ByteString -> Manager -> Request -> Sink ByteString m () -> m ()+download device manager request sink = 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 =+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 source+    , requestBody = requestBodySourceChunked $ sourceTBQueue queue     }  -- | Run Skylark client. ---runSkylark :: (MonadIO m, MonadThrow m) => String -> ByteString -> Source (ResourceT IO) ByteString -> Sink ByteString (ResourceT IO) () -> m ()+runSkylark :: MonadMain m => String -> ByteString -> Source m ByteString -> Sink ByteString m () -> 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)+  queue   <- liftIO $ atomically $ newTBQueue 8192+  void $ concurrently (download device manager request sink) $+    concurrently (source $$ sinkTBQueue queue) (upload device manager request queue)