sdk/samples/WCFSamples/TechnologySamples/Scenario/PoxMessaging/VB/service/CustomerService.vb

   1 ' Copyright (c) Microsoft Corporation.  All Rights Reserved.
   2
   3 Imports System
   4 Imports System.Collections.Generic
   5 Imports System.IO
   6 Imports System.Net
   7 Imports System.Text
   8 Imports System.ServiceModel
   9 Imports System.ServiceModel.Channels
  10 Imports System.Runtime.Serialization
  11 Imports Microsoft.VisualBasic
  12
  13 Namespace Microsoft.ServiceModel.Samples
  14
  15     <ServiceBehavior(InstanceContextMode:=InstanceContextMode.[Single], AddressFilterMode:=AddressFilterMode.Prefix)> _
  16     Class CustomerService
  17         Implements IUniversalContract
  18
  19         'For the purposes of this sample, we're storing
  20         'state inside of an instance variable on the service
  21         'and using InstanceContextMode.Single.
  22         Private customerList As Dictionary(Of String, Customer)
  23         Private nextId As Integer
  24
  25         Private Sub New()
  26
  27             customerList = New Dictionary(Of String, Customer)()
  28             ' Default customer
  29             Dim customer As New Customer()
  30             customer.Name = "Bob"
  31             customer.Address = "100 Main Street"
  32             customerList.Add("1", customer)
  33
  34             nextId = 1
  35
  36         End Sub
  37
  38 #Region "IUniversalContract Members"
  39
  40         Public Function ProcessMessage(ByVal request As Message) As Message Implements IUniversalContract.ProcessMessage
  41
  42             Dim response As Message = Nothing
  43
  44             'The HTTP Method (e.g. GET) from the incoming HTTP request
  45             'can be found on the HttpRequestMessageProperty. The MessageProperty
  46             'is added by the HTTP Transport when the message is received.
  47             Dim requestProperties As HttpRequestMessageProperty = DirectCast(request.Properties(HttpRequestMessageProperty.Name), HttpRequestMessageProperty)
  48
  49             'Here we dispatch to different internal implementation methods
  50             'based on the incoming HTTP verb.
  51             If requestProperties IsNot Nothing Then
  52
  53                 If [String].Equals("GET", requestProperties.Method, StringComparison.OrdinalIgnoreCase) Then
  54
  55                     response = GetCustomer(request)
  56
  57                 ElseIf [String].Equals("PUT", requestProperties.Method, StringComparison.OrdinalIgnoreCase) Then
  58
  59                     response = UpdateCustomer(request)
  60
  61                 ElseIf [String].Equals("POST", requestProperties.Method, StringComparison.OrdinalIgnoreCase) Then
  62
  63                     response = AddCustomer(request)
  64
  65                 ElseIf [String].Equals("DELETE", requestProperties.Method, StringComparison.OrdinalIgnoreCase) Then
  66
  67                     response = DeleteCustomer(request)
  68
  69                 Else
  70
  71                     'This service doesn't implement handlers for other HTTP verbs (such as HEAD), so we
  72                     'construct a response message and use the HttpResponseMessageProperty to
  73                     'set the HTTP status code to 405 (Method Not Allowed) which indicates the client
  74                     'used an HTTP verb not supported by the server.
  75                     response = Message.CreateMessage(MessageVersion.None, [String].Empty, [String].Empty)
  76
  77                     Dim responseProperty As New HttpResponseMessageProperty()
  78                     responseProperty.StatusCode = HttpStatusCode.MethodNotAllowed
  79
  80                     response.Properties.Add(HttpResponseMessageProperty.Name, responseProperty)
  81
  82                 End If
  83
  84             Else
  85
  86                 Throw New InvalidOperationException("This service requires the HTTP transport")
  87
  88             End If
  89
  90             Return response
  91
  92         End Function
  93
  94 #End Region
  95
  96         Private Function GetCustomer(ByVal msg As Message) As Message
  97
  98             Dim response As Message = Nothing
  99
 100             Dim requestProperties As HttpRequestMessageProperty = TryCast(msg.Properties(HttpRequestMessageProperty.Name), HttpRequestMessageProperty)
 101             Dim responseProperties As New HttpResponseMessageProperty()
 102
 103             Dim customer As Customer = Nothing
 104             Console.WriteLine("Received GET for " & msg.Properties.Via.ToString())
 105
 106             Dim endpointUri As Uri = OperationContext.Current.EndpointDispatcher.EndpointAddress.Uri
 107             Dim id As String = CustomerIdFromRequestUri(msg.Properties.Via, endpointUri)
 108
 109             If id IsNot Nothing Then
 110
 111                 customerList.TryGetValue(id, customer)
 112
 113             Else
 114
 115                 'No customer was specified, so return the contents of the collection as links
 116                 Dim links As New List(Of Uri)()
 117
 118                 For Each customerId As String In Me.customerList.Keys
 119
 120                     links.Add(New Uri(msg.Properties.Via.ToString() & customerId))
 121
 122                 Next
 123
 124                 responseProperties.StatusCode = HttpStatusCode.OK
 125                 response = Message.CreateMessage(msg.Version, msg.Headers.Action, links)
 126                 response.Properties(HttpResponseMessageProperty.Name) = responseProperties
 127                 Return response
 128
 129             End If
 130
 131             If customer Is Nothing Then
 132
 133                 responseProperties.StatusCode = HttpStatusCode.NotFound
 134                 response = Message.CreateMessage(msg.Version, msg.Headers.Action, [String].Empty)
 135
 136             Else
 137
 138                 responseProperties.StatusCode = HttpStatusCode.OK
 139                 response = Message.CreateMessage(msg.Version, msg.Headers.Action, customer)
 140
 141             End If
 142
 143             response.Properties(HttpResponseMessageProperty.Name) = responseProperties
 144
 145             Return response
 146
 147         End Function
 148
 149         Private Function UpdateCustomer(ByVal msg As Message) As Message
 150
 151             Dim response As Message = Nothing
 152
 153             Dim requestProperties As HttpRequestMessageProperty = TryCast(msg.Properties(HttpRequestMessageProperty.Name), HttpRequestMessageProperty)
 154             Dim responseProperties As New HttpResponseMessageProperty()
 155
 156             Dim endpointUri As Uri = OperationContext.Current.EndpointDispatcher.EndpointAddress.Uri
 157             Dim id As String = CustomerIdFromRequestUri(msg.Properties.Via, endpointUri)
 158
 159             Console.WriteLine("Received " + requestProperties.Method + " for Customer.")
 160             Dim customer As Customer = msg.GetBody(Of Customer)()
 161             Console.WriteLine(vbTab & "Customer Data - Name: " & customer.Name & " Address: " & customer.Address)
 162
 163             If customer IsNot Nothing Then
 164
 165                 If Not customerList.ContainsKey(id) Then
 166
 167                     responseProperties.StatusCode = HttpStatusCode.NotFound
 168                 Else
 169
 170                     customerList(id) = customer
 171                     responseProperties.StatusCode = HttpStatusCode.OK
 172
 173                 End If
 174
 175             Else
 176
 177                 responseProperties.StatusCode = HttpStatusCode.BadRequest
 178
 179             End If
 180             responseProperties.SuppressEntityBody = True
 181             response = Message.CreateMessage(msg.Version, msg.Headers.Action, [String].Empty)
 182             response.Properties(HttpResponseMessageProperty.Name) = responseProperties
 183
 184             Return response
 185
 186         End Function
 187
 188         Private Function AddCustomer(ByVal msg As Message) As Message
 189
 190             Dim response As Message = Nothing
 191             Dim requestProperties As HttpRequestMessageProperty = TryCast(msg.Properties(HttpRequestMessageProperty.Name), HttpRequestMessageProperty)
 192
 193             Dim responseProperties As New HttpResponseMessageProperty()
 194
 195             Console.WriteLine("Received " & requestProperties.Method & " for Customer.")
 196             Dim customer As Customer = msg.GetBody(Of Customer)()
 197
 198             Console.WriteLine(vbTab & "Customer Data - Name: " & customer.Name & " Address: " & customer.Address)
 199             If customer IsNot Nothing Then
 200
 201                 Me.nextId += 1
 202                 Me.customerList(nextId.ToString()) = customer
 203
 204                 Dim collectionUri As Uri = msg.Properties.Via
 205
 206                 responseProperties.StatusCode = HttpStatusCode.Created
 207                 responseProperties.Headers(HttpResponseHeader.Location) = New Uri(collectionUri, Me.nextId.ToString()).ToString()
 208
 209             Else
 210
 211                 responseProperties.StatusCode = HttpStatusCode.BadRequest
 212
 213             End If
 214
 215             responseProperties.SuppressEntityBody = True
 216             response = Message.CreateMessage(msg.Version, msg.Headers.Action, [String].Empty)
 217             response.Properties(HttpResponseMessageProperty.Name) = responseProperties
 218
 219             Return response
 220
 221         End Function
 222
 223         Private Function DeleteCustomer(ByVal msg As Message) As Message
 224
 225             Dim response As Message = Nothing
 226             Dim requestProperties As HttpRequestMessageProperty = TryCast(msg.Properties(HttpRequestMessageProperty.Name), HttpRequestMessageProperty)
 227
 228             Dim responseProperties As New HttpResponseMessageProperty()
 229
 230             Console.WriteLine("Received DELETE for Customer")
 231
 232             Dim endpointUri As Uri = OperationContext.Current.EndpointDispatcher.EndpointAddress.Uri
 233             Dim id As String = CustomerIdFromRequestUri(msg.Properties.Via, endpointUri)
 234
 235             If customerList.ContainsKey(id) Then
 236
 237                 customerList.Remove(id)
 238                 responseProperties.StatusCode = HttpStatusCode.OK
 239
 240             Else
 241
 242                 responseProperties.StatusCode = HttpStatusCode.NotFound
 243
 244             End If
 245
 246             responseProperties.SuppressEntityBody = True
 247             response = Message.CreateMessage(msg.Version, msg.Headers.Action, [String].Empty)
 248             response.Properties(HttpResponseMessageProperty.Name) = responseProperties
 249
 250             Return response
 251
 252         End Function
 253
 254         Private Function CustomerIdFromRequestUri(ByVal via As Uri, ByVal endpoint As Uri) As String
 255
 256             Dim customerNameSegmentIndex As Integer = endpoint.Segments.Length
 257
 258             If customerNameSegmentIndex < via.Segments.Length Then
 259                 Return via.Segments(customerNameSegmentIndex)
 260             End If
 261             Return Nothing
 262
 263         End Function
 264
 265     End Class
 266
 267 End Namespace