module Network.CoAP.Server
( Request(..)
, Method(..)
, Response(..)
, ResponseCode(..)
, Option(..)
, MediaType(..)
, createServer
, Server(..)
, RequestHandler
) where
import Network.CoAP.Messaging
import Network.CoAP.Types
import Control.Concurrent.Async
import Control.Concurrent.STM
import Network.Socket
type RequestHandler = (Request, Endpoint) -> IO Response
data Server = Server { runServer :: IO ()
, stopServer :: IO () }
createServer :: Transport -> RequestHandler -> IO Server
createServer transport handler = do
state <- createMessagingState transport
msgThreads <- startMessaging state
return Server { runServer = requestLoop state handler
, stopServer = shutdownServer state msgThreads }
shutdownServer :: MessagingState -> [Async ()] -> IO ()
shutdownServer state threads = do
stopMessaging state threads
mapM_ wait threads
createRequest :: MessageContext -> Request
createRequest reqCtx =
let msg = message reqCtx
(CodeRequest method) = messageCode msg
in Request { requestMethod = method
, requestOptions = messageOptions msg
, requestPayload = messagePayload msg
, requestReliable = messageType msg == CON }
handleRequest :: MessageContext -> RequestHandler -> MessagingState -> IO ()
handleRequest requestCtx requestHandler state = do
let request = createRequest requestCtx
response <- requestHandler (request, srcEndpoint requestCtx)
let responseMsg = createResponseMessage (message requestCtx) response
sendResponse requestCtx responseMsg state
requestLoop :: MessagingState -> RequestHandler -> IO ()
requestLoop state requestHandler = do
requestCtx <- recvRequest state
_ <- async (handleRequest requestCtx requestHandler state)
requestLoop state requestHandler
createResponseMessage :: Message -> Response -> Message
createResponseMessage origMsg response =
Message { messageVersion = messageVersion origMsg
, messageType = messageType origMsg
, messageCode = CodeResponse (responseCode response)
, messageId = messageId origMsg
, messageToken = messageToken origMsg
, messageOptions = responseOptions response
, messagePayload = responsePayload response }