{-# 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)