{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
module SwiftNav.SBP.Types
( module SwiftNav.SBP.Types
) where
import BasicPrelude
import Control.Lens hiding ((.=))
import Data.Aeson
import Data.Binary
import Data.Binary.Get
import Data.Binary.Put
import Data.ByteString.Base64 as Base64
import Data.ByteString.Builder
import Data.Text.Encoding
import Data.Text.Encoding.Error
import SwiftNav.CRC16
msgSBPPreamble :: Word8
msgSBPPreamble = 0x55
defaultSender :: Word16
defaultSender = 0x42
newtype Bytes = Bytes
{ unBytes :: ByteString
} deriving ( Show, Read, Eq )
data Msg = Msg
{ _msgSBPType :: !Word16
, _msgSBPSender :: !Word16
, _msgSBPLen :: !Word8
, _msgSBPPayload :: !Bytes
, _msgSBPCrc :: !Word16
} deriving ( Show, Read, Eq )
$(makeClassy ''Msg)
instance Binary Msg where
get = do
_msgSBPType <- getWord16le
_msgSBPSender <- getWord16le
_msgSBPLen <- getWord8
_msgSBPPayload <- fmap Bytes $ getByteString $ fromIntegral _msgSBPLen
_msgSBPCrc <- getWord16le
pure Msg {..}
put Msg {..} = do
putWord16le _msgSBPType
putWord16le _msgSBPSender
putWord8 _msgSBPLen
putByteString (unBytes _msgSBPPayload)
putWord16le _msgSBPCrc
instance FromJSON Bytes where
parseJSON = withText "ByteString" (pure . Bytes . Base64.decodeLenient . encodeUtf8)
instance FromJSON Msg where
parseJSON (Object v) =
Msg <$> v .: "msg_type"
<*> v .: "sender"
<*> v .: "length"
<*> v .: "payload"
<*> v .: "crc"
parseJSON _ = mzero
instance ToJSON Bytes where
toJSON = toJSON . decodeUtf8With ignore . Base64.encode . unBytes
instance ToJSON Msg where
toJSON Msg {..} = object
[ "preamble" .= msgSBPPreamble
, "msg_type" .= _msgSBPType
, "sender" .= _msgSBPSender
, "length" .= _msgSBPLen
, "payload" .= _msgSBPPayload
, "crc" .= _msgSBPCrc
]
class Binary a => ToSBP a where
toSBP :: a -> Word16 -> Msg
checkCrc :: Msg -> Word16
checkCrc Msg {..} =
crc16 $ toLazyByteString $
word16LE _msgSBPType <>
word16LE _msgSBPSender <>
word8 _msgSBPLen <>
byteString (unBytes _msgSBPPayload)