1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
|
-----------------------------------------------------------------------------
-- |
-- Module : Network.EBus.Layer2
-- Copyright : Yves Fischer 2012
-- License : BSD3
--
-- Stability : experimental
-- Portability : portable
--
-- This module contains a Attoparsec based Parser for eBus Layer 2
module Network.EBus.Layer2(
ebusParserLayer2,
EbusPacket,
ebusPacketType,
ebusPacketSource,
ebusPacketDestination,
ebusPacketPrimaryCommand,
ebusPacketSecondaryCommand,
ebusPacketPayload,
ebusPacketPayloadSlave) where
import Control.Applicative ((<|>))
import Data.Attoparsec (anyWord8, count, skipMany, try, Parser, word8)
import Data.Bits (xor)
import Data.Word (Word8)
-- | Ebus Layer2 Constants
ebusConstant :: String -> Word8
ebusConstant "SYN" = 0xaa
ebusConstant "ACK" = 0x00
ebusConstant "BROADCAST" = 0xff
ebusConstant "ESCAPE" = 0xa9
ebusConstant "ESCAPE_ESCAPE" = 0x00
ebusConstant "ESCAPE_SYN" = 0x01
ebusConstant _ = 0x00
-- | Ebus Packet Types
data EbusType = EbusBroadcast
| EbusMasterMaster
| EbusMasterSlave
deriving (Show)
-- | Ebus Packet
data EbusPacket = EbusPacket {
ebusPacketType :: EbusType,
ebusPacketSource :: Word8,
ebusPacketDestination :: Word8,
ebusPacketPrimaryCommand :: Word8,
ebusPacketSecondaryCommand :: Word8,
ebusPacketPayload :: [Word8],
ebusPacketPayloadSlave :: Maybe [Word8]
} deriving (Show)
-- | Ebus Binary Escape Sequences for payload data
parserPayload :: Parser Word8
parserPayload = do{ _ <- word8 $ ebusConstant "ESCAPE"
; _ <- word8 $ ebusConstant "ESCAPE_ESCAPE"
; return $ ebusConstant "ESCAPE"}
<|>
do{ _ <- word8 $ ebusConstant "ESCAPE"
; _ <- word8 $ ebusConstant "ESCAPE_SYN"
; return $ ebusConstant "SYN"}
<|>
anyWord8;
-- | Parse one Ebus Packet, skips leading SYNs
ebusParserLayer2 :: Parser EbusPacket
ebusParserLayer2 = do{
skipMany $ word8 $ ebusConstant "SYN"
; source <- anyWord8
; destination <- anyWord8
; primaryCommand <- anyWord8
; secondaryCommand <- anyWord8
; payloadLength <- anyWord8
; payload <- count (fromIntegral payloadLength) parserPayload
; followup <-
if destination == 0xfe then
-- Broadcast
do{ crc <- anyWord8
; _ <- {- syn -} word8 $ ebusConstant "SYN"
; if ebusCrc ([source, destination,
primaryCommand, secondaryCommand, payloadLength]
++ payload) == crc then
return $ EbusPacket EbusBroadcast source destination primaryCommand secondaryCommand payload Nothing
else
fail "Broadcast: CRC Check failed"}
<|>
fail "Failed to parse Broadcast Paket"
else
-- Master-Master
try(
do{ crc <- anyWord8
; _ <- {- ack -} word8 $ ebusConstant "ACK"
; _ <- {- syn -} word8 $ ebusConstant "SYN"
; if ebusCrc ([source, destination,
primaryCommand, secondaryCommand, payloadLength]
++ payload) == crc then
return $ EbusPacket EbusMasterMaster source destination primaryCommand secondaryCommand payload Nothing
else
fail "Master-Master: CRC Check failed"})
<|>
-- Master Slave
try(
do{ crc <- anyWord8
; _ <- {- ack -} word8 $ ebusConstant "ACK"
; payloadSlaveLength <- anyWord8
; payloadSlave <- count (fromIntegral payloadSlaveLength) parserPayload
; crcSlave <- anyWord8
; _ <- {- ackSlave -} word8 $ ebusConstant "ACK"
; _ <- {- synSlave -} word8 $ ebusConstant "SYN"
; if ebusCrc ([source, destination,
primaryCommand, secondaryCommand, payloadLength]
++ payload) == crc &&
ebusCrc ([payloadSlaveLength] ++ payloadSlave) == crcSlave then
return $ EbusPacket EbusMasterSlave source destination primaryCommand secondaryCommand payload (Just payloadSlave)
else
fail "Master-Slave: CRC Check failed"})
<|>
fail "Failed to parse Master-Master/Master-Slave Packet"
; return followup
<|> fail "Failed to parse packet"
}
-- | Ebus CRC Calculation using a Table of precalculated values
ebusCrc :: [Word8] -> Word8
ebusCrc input = foldl step 0 input
where step acc x = (crctab (fromIntegral acc)) `xor` x
-- | Table for CRC Calculation
crctab :: Int -> Word8
crctab pos = [
0, 155, 173, 54, 193, 90, 108, 247, 25, 130, --0 -9
180, 47, 216, 67, 117, 238, 50, 169, 159, 4, --10-19
243, 104, 94, 197, 43, 176, 134, 29, 234, 113, --20
71, 220, 100, 255, 201, 82, 165, 62, 8, 147, --30
125, 230, 208, 75, 188, 39, 17, 138, 86, 205,
251, 96, 151, 12, 58, 161, 79, 212, 226, 121,
142, 21, 35, 184, 200, 83, 101, 254, 9, 146,
164, 63, 209, 74, 124, 231, 16, 139, 189, 38,
250, 97, 87, 204, 59, 160, 150, 13, 227, 120,
78, 213, 34, 185, 143, 20, 172, 55, 1, 154,
109, 246, 192, 91, 181, 46, 24, 131, 116, 239, --100
217, 66, 158, 5, 51, 168, 95, 196, 242, 105,
135, 28, 42, 177, 70, 221, 235, 112, 11, 144,
166, 61, 202, 81, 103, 252, 18, 137, 191, 36,
211, 72, 126, 229, 57, 162, 148, 15, 248, 99,
85, 206, 32, 187, 141, 22, 225, 122, 76, 215,
111, 244, 194, 89, 174, 53, 3, 152, 118, 237,
219, 64, 183, 44, 26, 129, 93, 198, 240, 107,
156, 7, 49, 170, 68, 223, 233, 114, 133, 30,
40, 179, 195, 88, 110, 245, 2, 153, 175, 52,
218, 65, 119, 236, 27, 128, 182, 45, 241, 106, --200
92, 199, 48, 171, 157, 6, 232, 115, 69, 222,
41, 178, 132, 31, 167, 60, 10, 145, 102, 253,
203, 80, 190, 37, 19, 136, 127, 228, 210, 73,
149, 14, 56, 163, 84, 207, 249, 98, 140, 23,
33, 186, 77, 214, 224, 123] !! pos
|
