diff --git a/src/Network/STUN.hs b/src/Network/STUN.hs index e6ba48f..3bdccc3 100644 --- a/src/Network/STUN.hs +++ b/src/Network/STUN.hs @@ -19,6 +19,8 @@ module Network.STUN -- * Types STUNMessage(..) , STUNType(..) + , Method(..) + , Class(..) , STUNAttributes , STUNAttribute(..) , TransactionID @@ -84,7 +86,7 @@ sendBindingRequest sock attrs = do transId <- genTransactionId let attrs' = software : attrs - stunMsg = STUNMessage BindingRequest transId attrs' + stunMsg = STUNMessage (STUNType Binding Request) transId attrs' datagram = produceSTUNMessage stunMsg _ <- Socket.send sock datagram return transId @@ -96,7 +98,7 @@ recvBindingResponse sock transId = do packet <- Socket.recv sock 65536 let response = parseSTUNMessage packet case response of - Right result@(STUNMessage BindingResponse transId' _) -> + Right result@(STUNMessage (STUNType Binding Response) transId' _) -> if transId == transId' then return result else recvBindingResponse sock transId @@ -111,7 +113,7 @@ recvBinding :: Socket.Socket -> IO () recvBinding sock = do (request, from) <- recvBindingRequest sock case request of - STUNMessage BindingRequest transId _ -> + STUNMessage (STUNType Binding Request) transId _ -> sendBindingResponse sock from transId _ -> recvBinding sock @@ -122,7 +124,7 @@ recvBindingRequest sock = do putStrLn $ "Request from " ++ show from let request = parseSTUNMessage packet case request of - Right result@(STUNMessage BindingRequest _ _) -> + Right result@(STUNMessage (STUNType Binding Request) _ _) -> return (result, from) _ -> recvBindingRequest sock @@ -135,7 +137,7 @@ sendBindingResponse sock from transId = do where mappedAddr = addrToXorMappedAddress from transId attrs = [software, mappedAddr, Fingerprint Nothing] - response = STUNMessage BindingResponse transId attrs + response = STUNMessage (STUNType Binding Response) transId attrs addrToXorAddress :: (Socket.HostAddress -> Word16 -> STUNAttribute) diff --git a/src/Network/STUN/Internal.hs b/src/Network/STUN/Internal.hs index 2a2182f..9a5f270 100644 --- a/src/Network/STUN/Internal.hs +++ b/src/Network/STUN/Internal.hs @@ -21,7 +21,7 @@ module Network.STUN.Internal where import Control.Monad (replicateM, unless, when) -import Data.Bits (setBit, shiftL, testBit, xor) +import Data.Bits (setBit, shiftL, testBit, xor, (.&.), shiftR, (.|.)) import Data.ByteArray (convert) import Data.ByteString (ByteString) import qualified Data.ByteString as ByteString @@ -31,7 +31,7 @@ import Data.Maybe (isJust) import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text -import Data.Word (Word16, Word32, Word8) +import Data.Word (Word16, Word32, Word8, Word64) import Network.Socket (HostAddress, HostAddress6) import qualified Network.Socket as Socket @@ -48,18 +48,23 @@ import Data.Serialize data STUNMessage = STUNMessage STUNType TransactionID STUNAttributes deriving (Show, Eq) -data STUNType = BindingRequest - -- ^ RFC5389 Binding Request message type - | BindingResponse - -- ^ RFC5389 Binding Response message type - | AllocateRequest - -- ^ RFC5766 Allocate Request - | AllocateResponse - -- ^ RFC5766 Allocate Success Response - | AllocateError - -- ^ RFC5766 Allocate Error Response - | UnknownStunMessage Word16 - -- ^ Unknown message +data Method = Binding + | Allocate + | Refresh + | Send + | Data + | CreatePermission + | ChannelBind + | UnknownMethod Word16 + deriving(Eq,Show) + +data Class = Request + | Response + | Error + | Indication + deriving(Eq,Show) + +data STUNType = STUNType Method Class deriving (Show, Eq) type TransactionID = (Word32, Word32, Word32) @@ -106,6 +111,49 @@ data STUNAttribute = MappedAddressIPv4 HostAddress Word16 -- ^ IPv4 XOR-RELAYED-ADDRESS Attribute | XORRelayedAddressIPv6 HostAddress6 Word16 TransactionID -- ^ IPv6 XOR-RELAYED-ADDRESS Attribute + + | ChannelNumber Word16 + -- ^ RFC8656 CHANNEL-NUMBER + | PeerAddressIPv4 HostAddress Word16 + -- ^ RFC8656 XOR-PEER-ADDRESS + | PeerAddressIPv6 HostAddress6 Word16 + -- ^ RFC8656 XOR-PEER-ADDRESS + | XORPeerAddressIPv4 HostAddress Word16 + -- ^ RFC8656 XOR-PEER-ADDRESS + | XORPeerAddressIPv6 HostAddress6 Word16 TransactionID + -- ^ RFC8656 XOR-PEER-ADDRESS + | DataValue ByteString + -- ^ RFC8656 DATA + | RequestedAddressFamily Socket.Family + -- ^ RFC8656 REQUESTED-ADDRESS-FAMILY + | EvenPort Bool + -- ^ RFC8656 EVEN-PORT + | DontFragment + -- ^ RFC8656 DONT-FRAGMENT + | ReservationToken ByteString + -- ^ RFC8656 RESERVATION-TOKEN + | AdditionalAddressFamily Socket.Family + -- ^ RFC8656 ADDITIONAL-ADDRESS-FAMILY + | AddressErrorCode Socket.Family Word8 Word8 Text + -- ^ RFC8656 ADDRESS-ERROR-CODE + | Icmp Word8 Word16 Word32 + -- ^ RFC8656 ICMP + + -- + -- ICE Attributes + -- + | Priority Word32 + -- ^ RFC8445 PRIORITY + | UseCandidate + -- ^ RFC8445 USE-CANDIDATE + | IceControlled Word64 + -- ^ RFC8445 ICE-CONTROLLED + | IceControlling Word64 + -- ^ RFC8445 ICE-CONTROLLING + + | XNetworkIdCost Word16 Word16 + -- ^ https://www.ietf.org/mail-archive/web/ice/current/msg00247.html + -- https://tools.ietf.org/html/draft-thatcher-ice-network-cost-00 section 5 | UnknownAttribute Word16 ByteString -- ^ Unknown attribute @@ -147,7 +195,7 @@ parseSTUNMessage bytes = do msg@(STUNMessage _ _ attrs) <- runGet getSTUNMessage bytes when (hasFingerprint attrs) ( unless (verifyFingerprint msg bytes) $ - fail "STUN Message fingerprint verification failed" + Left "STUN Message fingerprint verification failed" ) return msg @@ -252,22 +300,46 @@ addFingerprint' msg@(STUNMessage msgType transId attrs) = in STUNMessage msgType transId newAttrs else msg +encodeMethod :: Method -> Word16 +encodeMethod Binding = 0x001 +encodeMethod Allocate = 0x003 +encodeMethod Refresh = 0x004 +encodeMethod Send = 0x006 +encodeMethod Data = 0x007 +encodeMethod CreatePermission = 0x008 +encodeMethod ChannelBind = 0x009 +encodeMethod (UnknownMethod x) = x .&. 0x3eef + +decodeMethod :: Word16 -> Method +decodeMethod 0x001 = Binding +decodeMethod 0x003 = Allocate +decodeMethod 0x004 = Refresh +decodeMethod 0x006 = Send +decodeMethod 0x007 = Data +decodeMethod 0x008 = CreatePermission +decodeMethod 0x009 = ChannelBind +decodeMethod x = UnknownMethod (x .&. 0x3eef) + +decodeClass :: Word16 -> Class +decodeClass 0x0000 = Request +decodeClass 0x0100 = Response +decodeClass 0x0110 = Error +decodeClass 0x0010 = Indication +decodeClass x = decodeClass (x .&. 0x0110) + +encodeClass :: Class -> Word16 +encodeClass Request = 0x0000 +encodeClass Response = 0x0100 +encodeClass Error = 0x0110 +encodeClass Indication = 0x0010 toStunType :: Word16 -> STUNType -toStunType 0x0001 = BindingRequest -toStunType 0x0101 = BindingResponse -toStunType 0x0003 = AllocateRequest -toStunType 0x0103 = AllocateResponse -toStunType 0x0113 = AllocateError -toStunType x = UnknownStunMessage x +toStunType w = let methodBits = w .&. 0x3eef + classBits = w .&. 0x0110 + in STUNType (decodeMethod methodBits) (decodeClass classBits) fromStunType :: STUNType -> Word16 -fromStunType BindingRequest = 0x0001 -fromStunType BindingResponse = 0x0101 -fromStunType AllocateRequest = 0x0003 -fromStunType AllocateResponse = 0x0103 -fromStunType AllocateError = 0x0113 -fromStunType (UnknownStunMessage x) = x +fromStunType (STUNType method cls) = (encodeMethod method) .|. (encodeClass cls) @@ -330,6 +402,29 @@ getSTUNAttribute transId = do 0x0016 -> getXORRelayedAddress transId -- RFC5766 xx.x. XOR-RELAYED-ADDRESS 0x0019 -> getRequestedTransport -- RFC5766 14.7. REQUESTED-TRANSPORT + -- RFC8445 ICE + 0x0024 -> Priority <$> getWord32be -- RFC8445 7.1.1 PRIORITY + 0x0025 -> return UseCandidate -- RFC8445 16.1 USE-CANDIDATE + 0x8029 -> IceControlled <$> getWord64be -- RFC8445 7.1.3 ICE-CONTROLLED + 0x802a -> IceControlling <$> getWord64be -- RFC8445 7.1.3 ICE-CONTROLLING + + -- generated by Chrome WebRTC implementation + 0xc057 -> XNetworkIdCost <$> getWord16be <*> getWord16be -- experimental "network cost" + + -- RFC8656, missing TURN-related + 0x000c -> ChannelNumber <$> do cn <- getWord16be + skip 2 + return cn + 0x0012 -> getXORPeerAddress transId + 0x0013 -> DataValue <$> getByteString len + 0x0017 -> RequestedAddressFamily <$> getAddressFamily + 0x0018 -> EvenPort <$> (\b -> (b .&. 0x80) /= 0) <$> getWord8 + 0x001a -> pure DontFragment + 0x0022 -> ReservationToken <$> getByteString 8 + 0x8000 -> AdditionalAddressFamily <$> getAddressFamily + 0x8001 -> getAddressErrorCode len + 0x8004 -> getIcmp + _ -> do -- Catch all unknown attributes bytes <- getByteString len return $! UnknownAttribute msgType bytes @@ -386,47 +481,16 @@ putSTUNAttribute (MappedAddressIPv6 addr port) = do putWord32be addr4 -- IPv6 address putSTUNAttribute (XORMappedAddressIPv4 addr port) = do - -- See getXORMappedAddress function for how XOR encoding works - let (b1, b2, b3, b4) = Socket.hostAddressToTuple addr - let xPort = port `xor` 0x2112 - x1 = b1 `xor` 0x21 - x2 = b2 `xor` 0x12 - x3 = b3 `xor` 0xA4 - x4 = b4 `xor` 0x42 - attrTLV 0x0020 $ do - putWord16be 0x0001 -- family - putWord16be xPort -- port - mapM_ putWord8 [x1, x2, x3, x4] -- IPv4 address + attrTLV 0x0020 $ putXORAddress4 addr port putSTUNAttribute (XORRelayedAddressIPv4 addr port) = do - -- See getXORMappedAddress function for how XOR encoding works - let (b1, b2, b3, b4) = Socket.hostAddressToTuple addr - let xPort = port `xor` 0x2112 - x1 = b1 `xor` 0x21 - x2 = b2 `xor` 0x12 - x3 = b3 `xor` 0xA4 - x4 = b4 `xor` 0x42 - attrTLV 0x0016 $ do - putWord16be 0x0001 -- family - putWord16be xPort -- port - mapM_ putWord8 [x1, x2, x3, x4] -- IPv4 address + attrTLV 0x0016 $ putXORAddress4 addr port -putSTUNAttribute (XORMappedAddressIPv6 addr port transId) = do - let (addr1, addr2, addr3, addr4) = addr - w1 = 0x2112A442 - (w2, w3, w4) = transId - let xPort = port `xor` 0x2112 - xAddr1 = addr1 `xor` w1 - xAddr2 = addr2 `xor` w2 - xAddr3 = addr3 `xor` w3 - xAddr4 = addr4 `xor` w4 - attrTLV 0x0020 $ do - putWord16be 0x0002 -- family - putWord16be xPort -- port - putWord32be xAddr1 -- IPv6 address - putWord32be xAddr2 -- IPv6 address - putWord32be xAddr3 -- IPv6 address - putWord32be xAddr4 -- IPv6 address +putSTUNAttribute (XORMappedAddressIPv6 addr port transId) = + attrTLV 0x0020 $ putXORAddress6 addr port transId + +putSTUNAttribute (XORRelayedAddressIPv6 addr port transId) = + attrTLV 0x0016 $ putXORAddress6 addr port transId putSTUNAttribute (ChangeRequest changeIP changePort) = attrTLV 0x0003 $ do @@ -479,7 +543,56 @@ putSTUNAttribute (RequestedTransport transport) = putWord8 0 putWord16be 0 -putSTUNAttribute attr = fail $ "Unknown STUN Attribute: " ++ show attr +putSTUNAttribute (Priority prio) = + attrTLV 0x0024 (putWord32be prio) + +putSTUNAttribute (UseCandidate) = + attrTLV 0x0025 (return ()) + +putSTUNAttribute (IceControlled tiebreaker) = + attrTLV 0x8029 (putWord64be tiebreaker) + +putSTUNAttribute (IceControlling tiebreaker) = + attrTLV 0x802a (putWord64be tiebreaker) + +putSTUNAttribute (XNetworkIdCost netid netcost) = + attrTLV 0xc057 (putWord16be netid >> putWord16be netcost) + +-- RFC8656 missing TURN-related +putSTUNAttribute (ChannelNumber cn) = + attrTLV 0x000c (putWord16be cn >> putWord16be 0) + +putSTUNAttribute (XORPeerAddressIPv4 addr port) = + attrTLV 0x0012 $ putXORAddress4 addr port + +putSTUNAttribute (XORPeerAddressIPv6 addr port transId) = + attrTLV 0x0012 $ putXORAddress6 addr port transId + +putSTUNAttribute (DataValue bs) = + attrTLV 0x0013 $ putByteString bs + +putSTUNAttribute (RequestedAddressFamily af) = + attrTLV 0x0017 $ putAddressFamily af + +putSTUNAttribute (EvenPort b) = + attrTLV 0x0018 $ putWord8 $ if b then 0x80 else 0x00 + +putSTUNAttribute (DontFragment) = + attrTLV 0x001a $ return () + +putSTUNAttribute (ReservationToken bs) = + attrTLV 0x0022 $ putByteString $ ByteString.take 8 bs + +putSTUNAttribute (AdditionalAddressFamily af) = + attrTLV 0x8000 $ putAddressFamily af + +putSTUNAttribute (AddressErrorCode af cls num txt) = + attrTLV 0x8001 $ putAddressErrorCode af cls num txt + +putSTUNAttribute (Icmp typ cod dat) = + attrTLV 0x8004 $ putIcmp typ cod dat + +putSTUNAttribute attr = error $ "Unknown STUN Attribute: " ++ show attr -- | Get STUN MAPPED-ADDRESS @@ -567,6 +680,11 @@ getXORRelayedAddress transId = -- FIXME: Should these not be XOR addresses below? getXORAddress transId RelayedAddressIPv4 RelayedAddressIPv6 +-- | Get STUN XOR-PEER-ADDRESS +getXORPeerAddress :: TransactionID -> Get STUNAttribute +getXORPeerAddress transId = + getXORAddress transId PeerAddressIPv4 PeerAddressIPv6 + -- | Get ERROR-CODE -- RFC5389 15.6. https://tools.ietf.org/html/rfc5389#section-15.6 @@ -603,6 +721,34 @@ getRequestedTransport = do _rffu2 <- getWord16be return $! RequestedTransport protocol +getAddressFamily :: Get Socket.Family +getAddressFamily = do + af <- toAddressFamily <$> getWord8 + skip 3 + return af + +toAddressFamily :: Word8 -> Socket.Family +toAddressFamily 0x01 = Socket.AF_INET +toAddressFamily 0x02 = Socket.AF_INET6 +toAddressFamily _ = error "Invalid address family encoded value" + +getAddressErrorCode :: Int -> Get STUNAttribute +getAddressErrorCode len = do + af <- toAddressFamily <$> getWord8 + skip 1 + cls <- getWord8 + num <- getWord8 + txt <- getUTF8 (len-4) (MaxChars 128) + return $ AddressErrorCode af (cls .&. 7) num txt + +getIcmp :: Get STUNAttribute +getIcmp = do + skip 2 + typcod <- getWord16be + let typ = fromIntegral $ typcod `shiftR` 9 + cod = typcod .&. 0x01ff + dat <- getWord32be + return $ Icmp typ cod dat ------------------------------------------------------------------------ -- Utilities to work with Data.Serialize.Get and Data.Serialize.Put @@ -641,6 +787,9 @@ getUTF8 byteLen (MaxChars maxLen) = do fail "getUTF8: Too many characters in UTF-8 string" return text +putUTF8 :: Text -> Put +putUTF8 = putByteString . Text.encodeUtf8 + -- | Take Word32 out from ByteString -- -- FIXME: If given bytestring is too short, this throws exception @@ -797,3 +946,55 @@ verifyMessageIntegrity msg@(STUNMessage _ _ attrs) bytes key = let mac = calculateMessageIntegrity msg bytes key in convert mac == oldMac _ -> False + +putXORAddress4 :: HostAddress -> Word16 -> Put +putXORAddress4 addr port = do + let (b1, b2, b3, b4) = Socket.hostAddressToTuple addr + let xPort = port `xor` 0x2112 + x1 = b1 `xor` 0x21 + x2 = b2 `xor` 0x12 + x3 = b3 `xor` 0xA4 + x4 = b4 `xor` 0x42 + putWord16be 0x0001 -- family + putWord16be xPort -- port + mapM_ putWord8 [x1, x2, x3, x4] -- IPv4 address + +putXORAddress6 :: HostAddress6 -> Word16 -> TransactionID -> Put +putXORAddress6 addr port transId = do + let (addr1, addr2, addr3, addr4) = addr + w1 = 0x2112A442 + (w2, w3, w4) = transId + let xPort = port `xor` 0x2112 + xAddr1 = addr1 `xor` w1 + xAddr2 = addr2 `xor` w2 + xAddr3 = addr3 `xor` w3 + xAddr4 = addr4 `xor` w4 + putWord16be 0x0002 -- family + putWord16be xPort -- port + putWord32be xAddr1 -- IPv6 address + putWord32be xAddr2 -- IPv6 address + putWord32be xAddr3 -- IPv6 address + putWord32be xAddr4 -- IPv6 address + +putAddressFamily :: Socket.Family -> Put +putAddressFamily Socket.AF_INET = putWord32be 0x01000000 +putAddressFamily Socket.AF_INET6 = putWord32be 0x02000000 +putAddressFamily _ = error "Invalid address family for STUN" + +putAddressErrorCode :: Socket.Family -> Word8 -> Word8 -> Text -> Put +putAddressErrorCode af cls num txt = do + case af of + Socket.AF_INET -> putWord8 0x01 + Socket.AF_INET6 -> putWord8 0x02 + _ -> error "Invalid address family for STUN" + putWord8 0 + putWord8 cls + putWord8 num + putUTF8 txt + +putIcmp :: Word8 -> Word16 -> Word32 -> Put +putIcmp typ cod dat = do + putWord16be 0 + let typcod = (((fromIntegral typ) .&. 0x8f) `shiftL` 9) .|. (cod .&. 0x1ff) + putWord16be typcod + putWord32be dat diff --git a/stack.yaml b/stack.yaml index 0fb96fb..49b4020 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,3 +1 @@ -resolver: lts-7.16 -extra-deps: - - smallcheck-series-0.6 +resolver: lts-18.19 diff --git a/stun.cabal b/stun.cabal index 2d8b7db..895acd4 100644 --- a/stun.cabal +++ b/stun.cabal @@ -1,5 +1,5 @@ name: stun -version: 0.1.0.0 +version: 0.2.0.0 synopsis: Session Traversal Utilities for NAT (STUN) protocol description: Please see README.md homepage: https://github.com/oherrala/haskell-stun#readme diff --git a/test/SmallCheck.hs b/test/SmallCheck.hs index f55a5dc..661ca2d 100644 --- a/test/SmallCheck.hs +++ b/test/SmallCheck.hs @@ -14,9 +14,24 @@ instance Monad m => Serial m STUNMessage where series = localDepth (const 3) $ cons3 STUNMessage instance Monad m => Serial m STUNType where - series = cons0 BindingRequest \/ cons0 BindingResponse - \/ cons0 AllocateRequest \/ cons0 AllocateResponse - \/ cons0 AllocateError + series = cons2 STUNType + +instance Monad m => Serial m Method where + series = cons0 Binding + \/ cons0 Allocate + \/ cons0 Refresh + \/ cons0 Send + \/ cons0 Data + \/ cons0 CreatePermission + \/ cons0 ChannelBind + \/ cons1 UnknownMethod + +instance Monad m => Serial m Class where + series = cons0 Request + \/ cons0 Response + \/ cons0 Error + \/ cons0 Indication + instance Monad m => Serial m STUNAttribute where series = cons2 MappedAddressIPv4 diff --git a/test/test.hs b/test/test.hs index 7bf105e..210403a 100644 --- a/test/test.hs +++ b/test/test.hs @@ -43,7 +43,7 @@ rfc5769Tests = testGroup "RFC5769 Test Vectors" key = shortTermKey "VOkJxbRl1RmTxUk/WvJxBt" software = "STUN test client" in sequence_ - [ stunType @=? BindingRequest + [ stunType @=? (STUNType Binding Request) , transID @=? (0xb7e7a701, 0xbc34d686, 0xfa87dfae) , assertBool "Software attribute" $ elem (Software software) attrs , assertBool "Username attribute" $ elem (Username username) attrs @@ -61,7 +61,7 @@ rfc5769Tests = testGroup "RFC5769 Test Vectors" ipAddr = Socket.tupleToHostAddress (192,0,2,1) port = 32853 in sequence_ - [ stunType @=? BindingResponse + [ stunType @=? (STUNType Binding Response) , transID @=? (0xb7e7a701, 0xbc34d686, 0xfa87dfae) , assertBool "Software attribute" $ elem (Software software) attrs , assertBool "Mapped-Address attribute" $ @@ -81,7 +81,7 @@ rfc5769Tests = testGroup "RFC5769 Test Vectors" (0x2001,0xdb8,0x1234,0x5678,0x11,0x2233,0x4455,0x6677) port = 32853 in sequence_ - [ stunType @=? BindingResponse + [ stunType @=? (STUNType Binding Response) , transID @=? (0xb7e7a701, 0xbc34d686, 0xfa87dfae) , assertBool "Software attribute" $ elem (Software software) attrs , assertBool "Mapped-Address attribute" $ @@ -101,7 +101,7 @@ rfc5769Tests = testGroup "RFC5769 Test Vectors" nonce = "f//499k954d6OL34oL9FSTvy64sA" key = longTermKey realm username password in sequence_ - [ stunType @=? BindingRequest + [ stunType @=? (STUNType Binding Request) , transID @=? (0x78ad3433, 0xc6ad72c0, 0x29da412e) , assertBool "Realm attribute" $ elem (Realm realm) attrs , assertBool "Nonce attribute" $ elem (Nonce nonce) attrs @@ -118,7 +118,7 @@ samplePacketTests = testGroup "Sample Packets" Right msg = parseSTUNMessage bytes STUNMessage stunType transID attrs = msg in sequence_ - [ stunType @=? AllocateRequest + [ stunType @=? (STUNType Allocate Request) , transID @=? (0xce2f7065, 0x5f265751, 0x9c40fa8f) , assertBool "Lifetime attribute" $ elem (Lifetime 3600) attrs , assertBool "Fingerprint attribute" $ verifyFingerprint msg bytes @@ -136,7 +136,7 @@ samplePacketTests = testGroup "Sample Packets" nonce = "This is fine nonce-nse" key = longTermKey realm username password in sequence_ - [ stunType @=? AllocateRequest + [ stunType @=? (STUNType Allocate Request) , transID @=? (0x91191b8c, 0x0aca8aac, 0xe7660f12) , assertBool "Username attribute" $ elem (Username username) attrs , assertBool "Realm attribute" $ elem (Realm realm) attrs @@ -231,7 +231,7 @@ miscTests = testGroup "Misc Tests" , testCase "Messate-Integrity with Short-Term Authentication" $ let key = shortTermKey "swordfish" - msg = STUNMessage BindingRequest (12, 654, 2) [MessageIntegrity (Key key)] + msg = STUNMessage (STUNType Binding Request) (12, 654, 2) [MessageIntegrity (Key key)] bytes = produceSTUNMessage msg (Right parsed) = parseSTUNMessage bytes in assertBool "" $ verifyMessageIntegrity parsed bytes key @@ -246,7 +246,7 @@ miscTests = testGroup "Misc Tests" , Username user , Nonce nonce , MessageIntegrity (Key key) ] - msg = STUNMessage BindingRequest (12, 654, 2) attrs + msg = STUNMessage (STUNType Binding Request) (12, 654, 2) attrs bytes = produceSTUNMessage msg (Right parsed) = parseSTUNMessage bytes in assertBool "" $ verifyMessageIntegrity parsed bytes key @@ -260,7 +260,7 @@ miscTests = testGroup "Misc Tests" attrs = [ Realm realm , Nonce nonce , MessageIntegrity (Key key) ] - msg = STUNMessage BindingRequest (1, 33, 7) attrs + msg = STUNMessage (STUNType Binding Request) (1, 33, 7) attrs bytes = produceSTUNMessage msg (Right parsed) = parseSTUNMessage bytes in assertBool "" $ verifyMessageIntegrity parsed bytes key