Add unit-tests for parseLocation in XmlParser.Test

test/Network/Minio/XmlParser/Test.hs

@@ -0,0 +1,52 @@
+module Network.Minio.XmlParser.Test
+  (
+    testParseLocation
+  ) where
+
+import Test.Tasty.HUnit
+
+import Lib.Prelude
+
+import Network.Minio.Data
+import Network.Minio.XmlParser
+
+
+euLocationXml :: LByteString
+euLocationXml = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\
+\<LocationConstraint xmlns=\"http://s3.amazonaws.com/doc/2006-03-01/\">EU</LocationConstraint>"
+
+badLocationXml :: LByteString
+badLocationXml = "ClearlyInvalidXml"
+
+usLocationXml :: LByteString
+usLocationXml = "<LocationConstraint xmlns=\"http://s3.amazonaws.com/doc/2006-03-01/\"/>"
+
+testValidParseLocation :: Assertion
+testValidParseLocation = do
+  txt <- runExceptT $ parseLocation euLocationXml
+  let location = case txt of
+        Right loc -> loc
+        Left _ -> ""
+  (isRight txt && location == "EU") @? ("Parsing failed unexpectedly => " ++ show txt)
+
+testInvalidParseLocation :: Assertion
+testInvalidParseLocation = do
+  txt <- runExceptT $ parseLocation badLocationXml
+  (isLeft txt) @? ("Parsing succeeded unexpectedly => " ++ show txt)
+
+testEmptyParseLocation :: Assertion
+testEmptyParseLocation = do
+  txt <- runExceptT $ parseLocation usLocationXml
+  let location = case txt of
+        Right loc -> loc
+        Left _ -> ""
+  (isRight txt && location == "") @? ("Parsing failed unexpectedly => " ++ show txt)
+
+testParseLocation :: Assertion
+testParseLocation = do
+  -- 1. Test parsing of a valid location xml.
+  testValidParseLocation
+  -- 2. Test parsing of an invalid location xml.
+  testInvalidParseLocation
+  -- 3. Test parsing of a valid, empty location xml.
+  testEmptyParseLocation

test/Spec.hs

@@ -13,6 +13,7 @@ import Control.Monad.Trans.Resource (runResourceT)
 import Network.Minio
 -- import Network.Minio.S3API
 import Network.Minio.XmlGenerator.Test
+import Network.Minio.XmlParser.Test
 
 main :: IO ()
 main = defaultMain tests
@@ -87,4 +88,5 @@ unitTests = testGroup "Unit tests"
       isLeft ret @? ("putObject unexpected success => " ++ show ret)
 
   , testCase "Test mkCreateBucketConfig." testMkCreateBucketConfig
+  , testCase "Test parseLocation." testParseLocation
   ]