Client.hs

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

module Network.Ntrip.Client where

import           BasicPrelude                     hiding (intercalate, tail)
import           Control.Concurrent.Async
import           Control.Lens
import           Data.Attoparsec.ByteString
import           Data.Attoparsec.ByteString.Char8 (decimal, endOfLine, isEndOfLine)
import           Data.ByteString
import           Data.ByteString.Base64
import           Data.CaseInsensitive
import           Data.Conduit
import           Data.Conduit.Attoparsec
import           Data.Conduit.Network
import           Network.HTTP.Types
import           URI.ByteString

tcpClient :: ByteString -> Int -> Source IO ByteString -> Sink ByteString IO () -> IO ()
tcpClient host port source sink =
  runTCPClient (clientSettings port host) $ \ad ->
    void $ concurrently (source $$ appSink ad) (appSource ad $$ sink)

sourceNtrip :: ByteString -> ByteString -> ByteString -> Source IO ByteString -> Source IO ByteString
sourceNtrip path user password source = do
  yield $ intercalate "\r\n"
    [ methodGet <> " " <> path <> " HTTP/1.0"
    , original hUserAgent <> ": NTRIP ntrip-client/0.0"
    , original hAuthorization <> ": " <> encode (user <> ":" <> password)
    , ""
    , ""
    ]
  source

parseNtrip :: Parser (ByteString, Status)
parseNtrip = do
  format  <- parseFormat
  code    <- parseCode
  message <- parseMessage
  return (format, Status code message)
  where
    takeSpace      = takeWhile1 (== 32)
    takeInClass    = takeWhile1 . inClass
    takeEndOfLine1 = takeWhile1 (not . isEndOfLine)
    parseFormat    = takeInClass "a-zA-Z0-9/." <* takeSpace
    parseCode      = decimal <* takeSpace
    parseMessage   = takeEndOfLine1 <* endOfLine

sinkNtrip :: Sink ByteString IO () -> Sink ByteString IO ()
sinkNtrip sink = do
  (format, status) <- sinkParser parseNtrip
  unless (format == "ICY") $ throwIO $ userError "Unsupported format"
  unless (status == status200) $ throwIO $ userError "Bad status"
  sink

runNtrip :: ByteString -> Source IO ByteString -> Sink ByteString IO () -> IO ()
runNtrip url source sink = do
  uri  <- either (throwIO . userError . textToString . show) return $ parseURI strictURIParserOptions url
  auth <- maybe (throwIO $ userError "Bad authority") return $ uri ^. authorityL
  ui   <- maybe (throwIO $ userError "Bad user info") return $ auth ^. authorityUserInfoL
  tcpClient
    (hostBS $ auth ^. authorityHostL)
    (fromMaybe 2101 $ portNumber <$> auth ^. authorityPortL)
    (sourceNtrip
      (tail $ uri ^. pathL)
      (ui ^. uiUsernameL)
      (ui ^. uiPasswordL)
      source)
    (sinkNtrip sink)