diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -5,3 +5,29 @@ The library is split into a high-level API in Network.CoAP.Server and Network.CoAP.Client, and a lower layer API in Network.CoAP.Message for working directly with CoAP messages. [![Build Status](https://travis-ci.org/lulf/hcoap.svg?branch=master)](https://travis-ci.org/lulf/hcoap) + +## Example server + main = + withSocketsDo $ do + sock <- socket AF_INET6 Datagram defaultProtocol + bindSocket sock (SockAddrInet6 5683 0 iN6ADDR_ANY 0) + server <- createServer (createUDPTransport sock) (\(request, _) -> do + let payload = Just (B.pack "{\"value\":\"foo\"}") + return (Response Content [ContentFormat ApplicationJson] payload)) + runServer server + +## Example client + main = do + let request = Request { requestMethod = GET + , requestOptions = [] + , requestPayload = Nothing + , requestReliable = True } + withSocketsDo $ do + sock <- socket AF_INET6 Datagram defaultProtocol + bindSocket sock (SockAddrInet6 0 0 iN6ADDR_ANY 0) + let transport = createUDPTransport sock + client <- createClient transport + uri <- parseURI "coap://[::1]:5683/hello" + response <- doRequest client uri request + putStrLn ("Got response: " ++ show response) + return () diff --git a/example-client/Main.hs b/example-client/Main.hs --- a/example-client/Main.hs +++ b/example-client/Main.hs @@ -1,21 +1,35 @@ import Network.CoAP.Client import Network.CoAP.Transport import Network.Socket +import Network.URI +import System.Environment import qualified Data.ByteString.Char8 as B main :: IO () main = do - let request = Request { requestMethod = GET - , requestOptions = [UriPath (B.pack "hello")] + args <- getArgs + if length args < 2 + then printUsage + else runClient args + +runClient :: [String] -> IO () +runClient (method:uriStr:_) = do + let request = Request { requestMethod = read method :: Method + , requestOptions = [] , requestPayload = Nothing , requestReliable = True } withSocketsDo $ do sock <- socket AF_INET6 Datagram defaultProtocol - bindSocket sock (SockAddrInet6 12345 0 iN6ADDR_ANY 0) + bindSocket sock (SockAddrInet6 0 0 iN6ADDR_ANY 0) let transport = createUDPTransport sock - let dest = SockAddrInet6 5683 0 (0, 0, 0, 0) 0 client <- createClient transport - response <- doRequest client dest request + let (Just uri) = parseURI uriStr + response <- doRequest client uri request putStrLn ("Got response: " ++ show response) return () + +printUsage :: IO () +printUsage = do + pname <- getProgName + putStrLn ("Usage: " ++ pname ++ " ") diff --git a/hcoap.cabal b/hcoap.cabal --- a/hcoap.cabal +++ b/hcoap.cabal @@ -1,6 +1,6 @@ copyright: Copyright (c) 2016, Ulf Lilleengen name: hcoap -version: 0.1.1.0 +version: 0.1.2.0 synopsis: Library for handling CoAP protocol license: BSD3 license-file: LICENSE @@ -21,7 +21,7 @@ library exposed-modules: Network.CoAP.Server, Network.CoAP.Client, Network.CoAP.Message, Network.CoAP.Transport - other-modules: Network.CoAP.Types, Network.CoAP.MessageCodec, Network.CoAP.Messaging + other-modules: Network.CoAP.Types, Network.CoAP.MessageCodec, Network.CoAP.Messaging, Network.CoAP.Internal build-depends: base >= 4 && < 5, bytestring >= 0.10 && < 0.11, @@ -31,7 +31,10 @@ mtl >= 2.2 && < 2.3, time >= 1.5 && < 1.6, random >= 1.1 && < 1.2, - async >= 2.1 && < 2.2 + async >= 2.1 && < 2.2, + network-uri >= 2.6 && < 3, + iproute >= 1.7 && < 2, + dns >= 2 && < 3 hs-source-dirs: src default-language: Haskell2010 @@ -57,6 +60,7 @@ build-depends: base, network, bytestring, + network-uri, hcoap default-language: Haskell2010 @@ -67,6 +71,7 @@ build-depends: base, network, bytestring, + network-uri, hcoap default-language: Haskell2010 diff --git a/src/Network/CoAP/Client.hs b/src/Network/CoAP/Client.hs --- a/src/Network/CoAP/Client.hs +++ b/src/Network/CoAP/Client.hs @@ -7,9 +7,10 @@ The CoAP client API is intended to provide the minimal building block needed for sending CoAP requests. The API exposes CoAP request and response types and handles all internal messaging details of the CoAP protocol. Example: + @ - client <- createClient (createUDPTransport socket) - doRequest client (SockAddrInet 5683 0) (Request GET [UriPath path] Nothing True) + client <- createClient (createUDPTransport socket) + doRawRequest client (SockAddrInet 5683 0) (Request GET [UriPath path] Nothing True) @ -} module Network.CoAP.Client @@ -30,13 +31,17 @@ import Control.Concurrent.Async import Control.Concurrent.STM import Network.Socket -import Data.ByteString +import Data.ByteString hiding (putStrLn) import Data.Word import System.Random +import Network.URI +import Network.CoAP.Internal -- | A client that can perform CoAP requests. -data Client = Client { -- | Send a CoAP request to a given endpoint. Returns a CoAP response. - doRequest :: Endpoint -> Request -> IO Response +data Client = Client { -- | Send a CoAP request to a given endpoint represented by an URI. Returns a CoAP response. + doRequest :: URI -> Request -> IO Response + -- | Send a CoAP request to a given endpoint. Returns a CoAP response. + , doRawRequest :: Endpoint -> Request -> IO Response -- | Stop a client. Ensures that no threads are running and that messaging -- layer is shut down. , shutdownClient :: IO () } @@ -48,6 +53,7 @@ state <- createMessagingState transport msgThreads <- startMessaging state return Client { doRequest = doRequestInternal state + , doRawRequest = doRawRequestInternal state , shutdownClient = stopClient state msgThreads } -- | Shuts down the internal messaging threads and stops the client @@ -63,9 +69,14 @@ next <- generateToken (len - 1) return (tkn:next) -doRequestInternal :: MessagingState -> Endpoint -> Request -> IO Response -doRequestInternal state dest (Request method options payload reliable) = do +doRequestInternal :: MessagingState -> URI -> Request -> IO Response +doRequestInternal state uri (Request method options payload reliable) = do + dest <- createEndpoint uri + let newOpts = createOpts uri + doRawRequestInternal state dest (Request method (options ++ newOpts) payload reliable) +doRawRequestInternal :: MessagingState -> Endpoint -> Request -> IO Response +doRawRequestInternal state dest (Request method options payload reliable) = do tokenLen <- randomRIO (0, 8) token <- generateToken tokenLen let msg = Message { messageVersion = 1 diff --git a/src/Network/CoAP/Internal.hs b/src/Network/CoAP/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Network/CoAP/Internal.hs @@ -0,0 +1,65 @@ +module Network.CoAP.Internal +( createEndpoint +, createOpts +) where + +import Network.DNS.Lookup +import Network.DNS.Resolver +import Data.ByteString.Char8 +import Network.URI +import Data.IP +import Network.Socket +import Network.CoAP.Types + +createIPv4Endpoint :: [IPv4] -> PortNumber -> Endpoint +createIPv4Endpoint (addr:_) port = SockAddrInet port (toHostAddress addr) + +createIPv6Endpoint :: [IPv6] -> PortNumber -> Endpoint +createIPv6Endpoint (addr:_) port = SockAddrInet6 port 0 (toHostAddress6 addr) 0 + +stripBrackets :: String -> String +stripBrackets [] = [] +stripBrackets [']'] = [] +stripBrackets ('[':rest) = stripBrackets rest +stripBrackets (h:t) = h:stripBrackets t + +parsePort :: String -> Int +parsePort [] = 5683 +parsePort (':':rest) = parsePort rest +parsePort s = read s + +createEndpoint :: URI -> IO Endpoint +createEndpoint uri = do + let (Just auth) = uriAuthority uri + hname = stripBrackets (uriRegName auth) + port = fromIntegral (parsePort (uriPort auth)) + if isIPv6address hname + then return (createIPv6Endpoint [read hname :: IPv6] port) + else if isIPv4address hname + then return (createIPv4Endpoint [read hname :: IPv4] port) + else resolveEndpoint hname port + +resolveEndpoint :: String -> PortNumber -> IO Endpoint +resolveEndpoint hostName port = do + let hname = pack hostName + rs <- makeResolvSeed defaultResolvConf + ipv6Addr <- withResolver rs (`lookupAAAA` hname) + case ipv6Addr of + Left _ -> do + ipv4Addr <- withResolver rs (`lookupA` hname) + case ipv4Addr of + Left _ -> error "Unable to resolve hostname" + Right addr -> return (createIPv4Endpoint addr port) + Right addr -> return (createIPv6Endpoint addr port) + +parsePath :: String -> String +parsePath [] = [] +parsePath ('/':rest) = rest +parsePath any = any + +createOpts :: URI -> [Option] +createOpts uri = + let (Just auth) = uriAuthority uri + path = parsePath (uriPath uri) + port = parsePort (uriPort auth) + in [UriPath (pack path), UriPort port] diff --git a/src/Network/CoAP/MessageCodec.hs b/src/Network/CoAP/MessageCodec.hs --- a/src/Network/CoAP/MessageCodec.hs +++ b/src/Network/CoAP/MessageCodec.hs @@ -165,8 +165,12 @@ , messagePayload = payload } -- | Decode a CoAP message according to the specification. -decode :: BS.ByteString -> Message -decode msg = runGet getMessage (fromStrict msg) +decode :: BS.ByteString -> Either String Message +decode msg = + let result = runGetOrFail getMessage (fromStrict msg) + in case result of + Left (_, _, errorStr) -> Left errorStr + Right (_, _, parsedMsg) -> Right parsedMsg encodeType :: MessageType -> Word8 encodeType CON = 0 @@ -259,20 +263,16 @@ encodeOption (Size1 value) = (60, encodeOptionInt value) encodeOptionPart :: Int -> Word8 -encodeOptionPart value = - if value > 268 - then 14 - else if value > 12 - then 13 - else fromIntegral value +encodeOptionPart value + | value > 268 = 14 + | value > 12 = 13 + | otherwise = fromIntegral value putOptionPart :: Word8 -> Int -> Put -putOptionPart valueLen value = do - if valueLen == 13 - then putWord8 (fromIntegral (value - 13)) - else if valueLen == 14 - then putWord16be (fromIntegral (value - 269)) - else return () +putOptionPart valueLen value + | valueLen == 13 = putWord8 (fromIntegral (value - 13)) + | valueLen == 14 = putWord16be (fromIntegral (value - 269)) + | otherwise = return () putOption :: Int -> BS.ByteString -> Put putOption nextDelta optValue = do diff --git a/src/Network/CoAP/Messaging.hs b/src/Network/CoAP/Messaging.hs --- a/src/Network/CoAP/Messaging.hs +++ b/src/Network/CoAP/Messaging.hs @@ -30,12 +30,10 @@ , replyTimeout :: Double , retransmitCount :: Integer } deriving (Show) -cmpMessageState a b = - messageId (message (messageContext a)) == messageId (message (messageContext b)) && - srcEndpoint (messageContext a) == srcEndpoint (messageContext b) instance Eq MessageState where - (==) = cmpMessageState + (==) a b = messageId (message (messageContext a)) == messageId (message (messageContext b)) && + srcEndpoint (messageContext a) == srcEndpoint (messageContext b) -- A message store contains an inbound and outbound list of messages that needs to be ACKed type MessageList = [MessageState] @@ -127,13 +125,11 @@ takeMessageByIdAndOrigin :: MessageId -> Endpoint -> TVar MessageList -> STM (Maybe MessageState) takeMessageByIdAndOrigin msgId origin = takeMessageMatching (\x -> (origin == dstEndpoint (messageContext x)) && (msgId == messageId (message (messageContext x)))) -recvLoop :: MessagingState -> IO () -recvLoop state@(MessagingState transport store) = do - {-putStrLn "Waiting for UDP packet"-} - (msgData, srcEndpoint) <- recvFrom transport +recvLoopSuccess :: MessagingState -> Endpoint -> Message -> IO () +recvLoopSuccess state@(MessagingState transport store) srcEndpoint message = do dstEndpoint <- localEndpoint transport now <- getCurrentTime - let message = decode msgData + let messageCtx = MessageContext { message = message , srcEndpoint = srcEndpoint , dstEndpoint = dstEndpoint } @@ -147,6 +143,15 @@ atomically (when (msgType == ACK) (do _ <- takeMessageByIdAndOrigin msgId srcEndpoint (unconfirmedMessages store) return ())) atomically (when (msgCode /= CodeEmpty) (queueMessage messageState (incomingMessages store))) + +recvLoopError :: String -> IO () +recvLoopError err = putStrLn ("Error parsing message: " ++ show err ++ ", skipping") + +recvLoop :: MessagingState -> IO () +recvLoop state@(MessagingState transport _) = do + {-putStrLn "Waiting for UDP packet"-} + (msgData, srcEndpoint) <- recvFrom transport + either recvLoopError (recvLoopSuccess state srcEndpoint) (decode msgData) recvLoop state sendLoop :: MessagingState -> IO () diff --git a/src/Network/CoAP/Server.hs b/src/Network/CoAP/Server.hs --- a/src/Network/CoAP/Server.hs +++ b/src/Network/CoAP/Server.hs @@ -7,11 +7,12 @@ The CoAP server API is intended to provide the minimal building block needed for creating CoAP servers. The API exposes CoAP requests and response types and handles all internal messaging details of the CoAP protocol. Example: + @ - server <- createServer (createUDPTransport socket) (\(req, endpoint) = do - let payload = Just (B.pack ("{\"msg\":\"Hello, Client\"}")) - return (Response Content [ContentFormat ApplicationJson] payload)) - runServer server + server <- createServer (createUDPTransport socket) (\(req, endpoint) = do + let payload = Just (B.pack ("{\"msg\":\"Hello, Client\"}")) + return (Response Content [ContentFormat ApplicationJson] payload)) + runServer server @ -} module Network.CoAP.Server diff --git a/src/Network/CoAP/Types.hs b/src/Network/CoAP/Types.hs --- a/src/Network/CoAP/Types.hs +++ b/src/Network/CoAP/Types.hs @@ -55,7 +55,7 @@ type Payload = BS.ByteString -- | Request Method -data Method = GET | POST | PUT | DELETE deriving (Show, Eq) +data Method = GET | POST | PUT | DELETE deriving (Show, Eq, Read) -- | A message with additional context on source and destination data MessageContext = MessageContext { message :: Message @@ -116,13 +116,13 @@ -- | CoAP message record. Can be encoded and decoded to ByteString. data Message = Message - { messageVersion :: MessageVersion - , messageType :: MessageType - , messageCode :: MessageCode - , messageId :: MessageId - , messageToken :: Token - , messageOptions :: [Option] - , messagePayload :: Maybe Payload + { messageVersion :: !MessageVersion + , messageType :: !MessageType + , messageCode :: !MessageCode + , messageId :: !MessageId + , messageToken :: !Token + , messageOptions :: ![Option] + , messagePayload :: !(Maybe Payload) } deriving (Show) diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -20,7 +20,7 @@ sendToChan prob chan msg endpoint = do v <- randomRIO(0, 1) - when (v >= prob) (putStrLn ("Message to to " ++ (show endpoint) ++ " dropped!")) + when (v >= prob) (putStrLn ("Message to to " ++ show endpoint ++ " dropped!")) when (v < prob) (writeChan chan msg) return (length msg) @@ -38,10 +38,10 @@ instance Arbitrary C.Request where arbitrary = do pload <- arbitrary - return (C.Request { C.requestMethod = GET - , C.requestOptions = [] - , C.requestPayload = pload - , C.requestReliable = True }) + return C.Request { C.requestMethod = GET + , C.requestOptions = [] + , C.requestPayload = pload + , C.requestReliable = True } testReliability = TestCase (do @@ -58,7 +58,7 @@ client <- C.createClient transportB reqs <- generate (vector 10) mapM_ (\req -> do - response <- timeout 20000000 (C.doRequest client endpointA req) + response <- timeout 20000000 (C.doRawRequest client endpointA req) assertBool ("Timed out waiting for response on reliable request " ++ show req) (isJust response) let res = fromJust response putStrLn "Got response, checking" @@ -80,7 +80,7 @@ arbitrary = elements [PUT, GET, POST, DELETE] instance Arbitrary ByteString where - arbitrary = suchThat (fmap pack arbitrary) (\s -> ((length s > 0) && (length s <= 8))) + arbitrary = suchThat (fmap pack arbitrary) (\s -> (length s > 0) && (length s <= 8)) instance Arbitrary MediaType where arbitrary = elements [TextPlain, ApplicationLinkFormat, ApplicationXml, ApplicationOctetStream, ApplicationExi, ApplicationJson] @@ -107,19 +107,19 @@ tkn <- arbitrary options <- arbitrary payload <- arbitrary - return (Message { messageVersion = 1 - , messageType = msgType - , messageCode = CodeRequest msgMethod - , messageId = msgId - , messageToken = tkn - , messageOptions = [options] - , messagePayload = payload }) + return Message { messageVersion = 1 + , messageType = msgType + , messageCode = CodeRequest msgMethod + , messageId = msgId + , messageToken = tkn + , messageOptions = [options] + , messagePayload = payload } checkCodec msg = let encoded = encode msg - decoded = decode encoded - in (show msg) == (show decoded) + (Right decoded) = decode encoded + in show msg == show decoded main :: IO () main = do