deregisterService uses PUT method instead of GET

src/Network/Consul.hs

@@ -582,12 +582,18 @@ registerService client request dc = do
       _ -> return False
 
 
-deregisterService :: MonadIO m => ConsulClient -> Text -> m ()
-deregisterService client service = do
+deregisterService :: MonadIO m => ConsulClient -> Text -> Maybe Datacenter -> m ()
+deregisterService client service dc = do
   let portNumber = ccPort client
       manager = ccManager client
       hostname = hostWithScheme client
-  initReq <- liftIO $ parseUrlThrow $ T.unpack $ T.concat [hostname, ":", T.pack $ show portNumber ,"/v1/agent/service/deregister/", service]
+  initReq <- createRequest hostname
+                           portNumber
+                           (T.concat ["/v1/agent/service/deregister/", service])
+                           Nothing
+                           (Just "") -- forces PUT
+                           False
+                           dc
   liftIO $ withResponse initReq manager $ \ response -> do
     _bodyParts <- brConsume $ responseBody response
     return ()

tests/Main.hs

@@ -269,9 +269,24 @@ testRegisterService = testCase "testRegisterService" $ do
   val <- registerService client req Nothing
   assertEqual "testRegisterService: Service was not created" val True
   mService <- getService client "testService" Nothing Nothing
+  let serviceWasNotFound = assertFailure "testRegisterService: Service was not found"
   case mService of
+    Just [] -> serviceWasNotFound
+    Nothing -> serviceWasNotFound
     Just _ -> return ()
-    Nothing -> assertFailure "testRegisterService: Service was not found"
+
+testDeregisterService :: TestTree
+testDeregisterService = testCase "testDeregisterService" $ do
+  client@ConsulClient{..} <- newClient
+  let req = RegisterService Nothing "testService" ["test"] Nothing Nothing
+  val <- registerService client req Nothing
+  assertEqual "testDeregisterService: Service was not created" val True
+  deregisterService client (rsName req) Nothing
+  mService <- getService client (rsName req) Nothing Nothing
+  case mService of
+    Just [] -> return ()
+    Nothing -> return ()
+    Just s -> assertFailure $ "testDeregisterService: Service was found... " <> show s
 
 testGetSelf :: TestTree
 testGetSelf = testCase "testGetSelf" $ do
@@ -496,6 +511,7 @@ agentTests =
     "Agent Tests"
     [ testGetSelf
     , testRegisterService
+    , testDeregisterService
     ]
 
 sequencerTests :: TestTree