opc-xml-da-client-0.1: protocol-test/Main.hs

{-# LANGUAGE OverloadedLists #-}

module Main where

import qualified Data.Vector as Vector
import OpcXmlDaClient.Protocol.Types
import qualified OpcXmlDaClient.Protocol.XmlParsing as XmlParsing
import qualified Pcap
import Test.QuickCheck.Instances ()
import Test.Tasty
import Test.Tasty.HUnit
import qualified XmlParser as Xp
import Prelude

main :: IO ()
main = do
  pcapTests <- Pcap.makePcapTests
  defaultMain $
    testGroup "" $
      [ pcapTests,
        testGroup "Subscribe Response" $
          let parsingResult =
                unsafePerformIO $
                  Xp.parseFile XmlParsing.subscribeResponse "samples/680.response.xml"
           in [ testCase "Top level properties" $ do
                  assertEqual
                    ""
                    (Right (Right (Just "Handle1")))
                    ((fmap . fmap) #serverSubHandle parsingResult),
                testCase "DateTime" $ do
                  assertEqual
                    ""
                    (Right (Right (Just (read "2019-09-23 16:01:50.576+00:00"))))
                    ((fmap . fmap) (fmap #rcvTime . #subscribeResult) parsingResult),
                testCase "Item value at offset 0" $ do
                  assertEqual
                    ""
                    (Right (Right (Just (FloatValue 4.5))))
                    ((fmap . fmap) (join . fmap #value . fmap #itemValue . join . fmap (Vector.!? 0) . fmap #items . #rItemList) parsingResult),
                testCase "Item value at offset 1" $ do
                  assertEqual
                    ""
                    (Right (Right (Just (IntValue 1234))))
                    ((fmap . fmap) (join . fmap #value . fmap #itemValue . join . fmap (Vector.!? 1) . fmap #items . #rItemList) parsingResult),
                testCase "Item value at offset 2" $ do
                  assertEqual
                    ""
                    (Right (Right (Just (ArrayOfUnsignedShortValue [0, 0, 3, 11, 0, 0]))))
                    ((fmap . fmap) (join . fmap #value . fmap #itemValue . join . fmap (Vector.!? 2) . fmap #items . #rItemList) parsingResult)
              ],
        testGroup "Fault Response" $
          let parsingResult =
                unsafePerformIO $
                  Xp.parseFile XmlParsing.subscribeResponse "samples/fault.response.xml"
           in [ testCase "" $ do
                  assertEqual
                    ""
                    (Right (Left (SoapFault (#std SenderStdSoapFaultCode) "Server was unable to read request. ---> There is an error in XML document (4, 32). ---> The string 'dateTime' is not a valid AllXsd value.")))
                    parsingResult
              ],
        testGroup "Fault on old SOAP Response" $
          let parsingResult =
                unsafePerformIO $
                  Xp.parseFile XmlParsing.subscribeResponse "samples/fault-on-old-soap.response.xml"
           in [ testCase "" $ do
                  assertEqual
                    ""
                    (Right (Left (SoapFault (#std SenderStdSoapFaultCode) "XML syntax error")))
                    parsingResult
              ],
        testGroup "Fault on old SOAP Response 2" $
          let parsingResult =
                unsafePerformIO $
                  Xp.parseFile XmlParsing.subscribeResponse "samples/fault-on-old-soap-2.response.xml"
           in [ testCase "" $ do
                  assertEqual
                    ""
                    (Right (Left (SoapFault (#custom (UnnamespacedQName "E_NOSUBSCRIPTION")) "E_NOSUBSCRIPTION")))
                    parsingResult
              ]
      ]