module OpcXmlDaClient.TestSuites.Mocking where import Data.Default import qualified Data.Vector as V import qualified Network.HTTP.Client as Hc import qualified OpcXmlDaClient as Opc import OpcXmlDaClient.Base.Prelude import Test.QuickCheck.Instances () import Test.Tasty import Test.Tasty.HUnit defBrowse :: Opc.Browse defBrowse = Opc.Browse V.empty Nothing Nothing Nothing Nothing Nothing 10 Opc.AllBrowseFilter Nothing Nothing True True True getItemNames :: Hc.Manager -> IO (V.Vector Text) getItemNames manager = do Opc.browse manager def uri defBrowse >>= \case Left e -> error $ show e Right r -> pure $ fmap (fromMaybe "" . #itemName) $ V.filter #isItem $ #elements r uri :: Opc.Uri uri = fromJust . Opc.textUri $ "http://info.advosol.com/XMLDADemo/XML_Sim/OpcXmlDaServer.asmx" makeReadItem :: Text -> Opc.ReadRequestItem makeReadItem n = Opc.ReadRequestItem Nothing Nothing (Just n) Nothing Nothing makeItemValue :: Text -> Opc.ItemValue makeItemValue n = Opc.ItemValue { Opc._diagnosticInfo = Nothing, Opc._value = Nothing, Opc._quality = Nothing, Opc._valueTypeQualifier = Nothing, Opc._itemPath = Nothing, Opc._itemName = Just n, Opc._clientItemHandle = Nothing, Opc._timestamp = Nothing, Opc._resultId = Nothing } defRequestOptions :: Opc.RequestOptions defRequestOptions = Opc.RequestOptions True True True True True Nothing Nothing Nothing serverSubHandleRef :: IORef Text serverSubHandleRef = unsafePerformIO $ newIORef "" {-# NOINLINE serverSubHandleRef #-} initTests :: IO [TestTree] initTests = do manager <- Hc.newManager Hc.defaultManagerSettings let op :: Opc.Op i o -> i -> IO (Either Opc.Error o) op _op = _op manager def uri itemNames <- getItemNames manager return $ [ testCase "GetStatus" $ do _res <- op Opc.getStatus $ Opc.GetStatus Nothing Nothing assertBool (show _res) $ isRight _res, testCase "Browse" $ do _res <- op Opc.browse defBrowse assertBool (show _res) $ isRight _res, testCase "Read" $ do _res <- op Opc.read $ Opc.Read { -- "options" is required Opc._options = Just defRequestOptions, Opc._itemList = Just $ Opc.ReadRequestItemList (fmap makeReadItem itemNames) Nothing Nothing Nothing } assertBool (show _res) $ isRight _res, testCase "Write" $ do _res <- op Opc.write $ Opc.Write { -- "options" is required Opc._options = Just defRequestOptions, Opc._itemList = Just $ Opc.WriteRequestItemList { Opc._items = fmap makeItemValue itemNames, Opc._itemPath = Nothing }, Opc._returnValuesOnReply = False } assertBool (show _res) $ isRight _res, testCase "Subscribe" $ do _res <- op Opc.subscribe $ Opc.Subscribe { Opc._options = Just defRequestOptions, Opc._returnValuesOnReply = False, Opc._itemList = Just $ Opc.SubscribeRequestItemList { Opc._itemPath = Nothing, Opc._reqType = Nothing, Opc._deadband = Nothing, Opc._requestedSamplingRate = Nothing, Opc._enableBuffering = Nothing, Opc._items = V.fromList [ Opc.SubscribeRequestItem { Opc._itemPath = Nothing, Opc._reqType = Nothing, Opc._itemName = listToMaybe $ V.toList itemNames, Opc._clientItemHandle = Nothing, Opc._deadband = Nothing, Opc._requestedSamplingRate = Nothing, Opc._enableBuffering = Nothing } ] }, Opc._subscriptionPingRate = Nothing } case _res of Left err -> assertBool (show err) False Right Opc.SubscribeResponse {..} -> case _serverSubHandle of Nothing -> error "SubHandle not found" Just sh -> writeIORef serverSubHandleRef sh, testCase "Subscription polled refresh" $ do sh <- readIORef serverSubHandleRef _res <- op Opc.subscriptionPolledRefresh $ Opc.SubscriptionPolledRefresh { Opc._options = Just defRequestOptions, Opc._serverSubHandles = V.fromList [sh], Opc._holdTime = Nothing, Opc._waitTime = 1, Opc._returnAllItems = False } assertBool (show _res) $ isRight _res, testCase "Subscription cancel" $ do sh <- readIORef serverSubHandleRef _res <- op Opc.subscriptionCancel $ Opc.SubscriptionCancel { Opc._serverSubHandle = Just sh, Opc._clientRequestHandle = Nothing } assertBool (show _res) $ isRight _res, testCase "Get properties" $ do _res <- op Opc.getProperties $ Opc.GetProperties { Opc._itemIds = itemNames <&> \n -> Opc.ItemIdentifier { Opc._itemPath = Nothing, Opc._itemName = Just n }, Opc._propertyNames = V.empty, Opc._localeId = Nothing, Opc._clientRequestHandle = Nothing, Opc._itemPath = Nothing, Opc._returnAllProperties = False, Opc._returnPropertyValues = False, Opc._returnErrorText = False } assertBool (show _res) $ isRight _res ]