module Network.Xcp
(
XcpCommandId(..)
,pid
,ToByteString
,XcpError(..)
,xcpGet
,xcpSet
,xcpConnect
,xcpDisconnect
,XcpResult(..)
,byteStringToResult
,fromBytes
,bytesToString) where
import Control.Applicative ((<$>))
import Control.Monad (zipWithM_)
import qualified Data.ByteString as B
import Data.ByteString.Builder
import Data.Bits
import qualified Data.ByteString.Lazy as L
import Data.Int
import Data.List (intersperse)
import Data.Monoid
import Data.Word
import Foreign.Ptr
import Foreign.Storable
import Foreign.Marshal.Alloc
import Numeric
import System.IO.Unsafe
data XcpCommandId = ConnectXcp
| DisconnectXcp
| GetStatus
| Synch
| GetCommModeInfo
| GetId
| SetRequest
| GetSeed
| Unlock
| SetMta
| Upload
| ShortUpload
| BuildChecksum
| TransportLayerCmd
| UserCmd
| Download
| DownloadNext
| DownloadMax
| ShortDownload
| ModifyBits
pid :: XcpCommandId -> Word8
pid ConnectXcp = 0xFF
pid DisconnectXcp = 0xFE
pid GetStatus = 0xFD
pid Synch = 0xFC
pid GetCommModeInfo = 0xFB
pid GetId = 0xFA
pid SetRequest = 0xF9
pid GetSeed = 0xF8
pid Unlock = 0xF7
pid SetMta = 0xF6
pid Upload = 0xF5
pid ShortUpload = 0xF4
pid BuildChecksum = 0xF3
pid TransportLayerCmd = 0xF2
pid UserCmd = 0xF1
pid Download = 0xF0
pid DownloadNext = 0xEF
pid DownloadMax = 0xEE
pid ShortDownload = 0xED
pid ModifyBits = 0xEC
class Storable a => ToByteString a where
toByteString :: a -> L.ByteString
instance ToByteString Word8 where
toByteString = L.singleton
instance ToByteString Word16 where
toByteString = toLazyByteString . word16LE
instance ToByteString Word32 where
toByteString = toLazyByteString . word32LE
instance ToByteString Float where
toByteString = toLazyByteString . floatLE
instance ToByteString Int8 where
toByteString = toLazyByteString . int8
instance ToByteString Int16 where
toByteString = toLazyByteString . int16LE
instance ToByteString Int32 where
toByteString = toLazyByteString . int32LE
bytesToString :: [Word8] -> String
bytesToString a = concat $ intersperse " " $ map (flip showHex "") a
xcpGet :: Word32
-> Word8
-> L.ByteString
xcpGet addr sz = L.pack (pid ShortUpload : sz : 0 : 0 : []) `mappend` toByteString addr
xcpSet :: ToByteString a =>
Word32
-> a
-> L.ByteString
xcpSet addr a = L.pack (pid ShortDownload : sz : 0 : 0 : []) `mappend` toByteString addr `mappend` toByteString a
where sz = fromIntegral $ sizeOf a
xcpConnect :: L.ByteString
xcpConnect = L.pack $ [pid ConnectXcp, 0]
xcpDisconnect :: L.ByteString
xcpDisconnect = L.pack $ [pid DisconnectXcp, 0]
fromBytes :: Storable a =>
a
-> [Word8]
-> Maybe a
fromBytes dummy b = unsafePerformIO $ alloca $ \p ->
zipWithM_ (\a n -> pokeByteOff p n a) b [0..sz1] >>
if (sz <= length b)
then Just <$> peek p
else return Nothing
where sz = sizeOf dummy
data XcpResult = XcpResult { xcpResultPayload :: B.ByteString
, xcpResultSize :: Word16
, xcpResultCounter :: Word16 }
| XcpErr { xcpErr :: XcpError
, xcpErrPayload :: B.ByteString
, xcpErrSize :: Word16
, xcpErrCounter :: Word16 }
data XcpError = GenericError Word8
byteStringToResult :: B.ByteString
-> XcpResult
byteStringToResult bs | B.null bs = XcpErr (GenericError 0) mempty 0 0
byteStringToResult bs | B.length bs < 5 = XcpErr (GenericError 0) mempty 0 0
byteStringToResult bs | otherwise =
let (sizeLow:sizeHigh:ctrLow:ctrHigh:a:as) = B.unpack bs
sz = ((fromIntegral sizeLow) .|. ((fromIntegral sizeHigh) `shiftL` 8))
ctr = ((fromIntegral ctrLow) .|. ((fromIntegral ctrHigh) `shiftL` 8)) in
case a of
0xFF -> XcpResult (B.pack as) sz ctr
0xFE -> XcpErr (GenericError (head as)) (B.pack (tail as)) sz ctr
otherwise -> XcpErr (GenericError 0) mempty sz ctr