packages feed

natskell-0.0.0.1: test/Unit/ParserSpec.hs

{-# LANGUAGE OverloadedStrings #-}

module ParserSpec (spec) where

import           Parser.API
    ( ParseStep (DropPrefix, Emit, NeedMore)
    , ParsedMessage (ParsedMsg, ParsedPing)
    , parse
    )
import           Parser.Attoparsec (parserApi)
import           Test.Hspec
import qualified Types.Msg         as Msg
import           Types.Ping        (Ping (Ping))

spec :: Spec
spec = do
  describe "parser api" $ do
    it "parses a valid frame through the API" $ do
      parse parserApi "PING\r\n" `shouldBe` Emit (ParsedPing Ping) ""

    it "suggests pulling more data for truncated input" $ do
      parse parserApi "MSG FOO 1 5\r\nHEL" `shouldBe` NeedMore

    it "suggests dropping invalid prefix bytes" $ do
      case parse parserApi "LOL" of
        DropPrefix n _ ->
          n `shouldSatisfy` (> 0)
        other ->
          expectationFailure ("expected DropPrefix, got " ++ show other)

  describe "message parsing" $ do
    it "accepts tab-delimited fields and non-alphanumeric subjects" $ do
      let input = "MSG foo-bar\t1\t_INBOX.a_b\t5\r\nHELLO\r\n"
      case parse parserApi input of
        Emit parsed rest -> do
          rest `shouldBe` ""
          case parsed of
            ParsedMsg msg' -> do
              Msg.subject msg' `shouldBe` "foo-bar"
              Msg.replyTo msg' `shouldBe` Just "_INBOX.a_b"
              Msg.payload msg' `shouldBe` Just "HELLO"
            other ->
              expectationFailure ("unexpected parse result: " ++ show other)
        other ->
          expectationFailure ("unexpected parse result: " ++ show other)

    it "trims horizontal whitespace in HMSG headers" $ do
      let input =
            "HMSG FOO 13 30 35\r\nNATS/1.0\r\n  KEY  : VALUE  \r\n\r\nHELLO\r\n"
      case parse parserApi input of
        Emit parsed rest -> do
          rest `shouldBe` ""
          case parsed of
            ParsedMsg msg' -> do
              Msg.headers msg' `shouldBe` Just [("KEY", "VALUE")]
              Msg.payload msg' `shouldBe` Just "HELLO"
            other ->
              expectationFailure ("unexpected parse result: " ++ show other)
        other ->
          expectationFailure ("unexpected parse result: " ++ show other)