module Network.XcpEth
(
XcpEth
,runXcpEth
,connect
,disconnect
,setVariable
,getVariable
,logString
,readCommands
,AddressMap
,loadAddressMap
,setAddressMap
,module Network
,module Network.Udp
,throwError
,ToByteString
,IPAddress) where
import Network (PortNumber, Socket)
import Network.Udp
import Network.Socket (SockAddr(..), inet_addr, close)
import Network.Socket.ByteString
import Network.Xcp
import Control.Applicative
import Control.Monad (when, liftM)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except
import Control.Monad.Trans.RWS
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LB
import Data.ByteString (ByteString)
import Data.ByteString.Builder
import Data.Monoid
import Data.Word
import Data.Int
import qualified Data.Map as M
import Foreign.Storable
type IPAddress = String
type AddressMap = M.Map String Word32
loadAddressMapIO :: FilePath -> IO AddressMap
loadAddressMapIO fp = do
f <- readFile fp
let a l = let (addr:name:_) = words l in (name, read ('0':'x':addr))
return $ M.fromList $ map a (lines f)
setAddressMap :: AddressMap -> XcpEth ()
setAddressMap am = XcpEth $ modify $ \s -> s { xcpStateConfig = (xcpStateConfig s) { xcpConfigAddressMap = am } }
loadAddressMap :: FilePath -> XcpEth ()
loadAddressMap fp = XcpEth (liftIO (loadAddressMapIO fp)) >>= setAddressMap
data XcpCommand = ReadNames FilePath
| Connect IPAddress Int IPAddress Int
| Disconnect
| SetInt8 String Int8
| SetUInt8 String Word8
| SetInt16 String Int16
| SetUInt16 String Word16
| SetInt32 String Int32
| SetUInt32 String Word32
| SetFloat String Float
| GetInt8 String
| GetUInt8 String
| GetInt16 String
| GetUInt16 String
| GetInt32 String
| GetUInt32 String
| GetFloat String deriving (Show, Read)
compileCommand :: XcpCommand -> XcpEth ()
compileCommand a = case a of
ReadNames fp -> loadAddressMap fp
Connect myIp myPort destIp destPort -> connect myIp (fromIntegral myPort) destIp (fromIntegral destPort)
Disconnect -> disconnect
SetInt8 name a -> setVariable name a
SetUInt8 name a -> setVariable name a
SetInt16 name a -> setVariable name a
SetUInt16 name a -> setVariable name a
SetInt32 name a -> setVariable name a
SetUInt32 name a -> setVariable name a
SetFloat name a -> setVariable name a
GetInt8 name -> getAndPrint (0::Int8) name
GetUInt8 name -> getAndPrint (0::Word8) name
GetInt16 name -> getAndPrint (0::Int16) name
GetUInt16 name -> getAndPrint (0::Word16) name
GetInt32 name -> getAndPrint (0::Int32) name
GetUInt32 name -> getAndPrint (0::Word32) name
GetFloat name -> getAndPrint (0::Float) name
readCommand :: String -> XcpEth ()
readCommand s = compileCommand $ read s
readCommands :: [String] -> XcpEth ()
readCommands = mapM_ readCommand
getAndPrint :: (ToByteString a, Show a) => a -> String -> XcpEth ()
getAndPrint dummy name = do
a <- getVariable dummy name
XcpEth $ liftIO $ putStrLn $ name ++ " = " ++ show a
data XcpConfig = XcpConfig { xcpConfigMyIP :: IPAddress
, xcpConfigMyPort :: PortNumber
, xcpConfigTargetIP :: IPAddress
, xcpConfigTargetPort :: PortNumber
, xcpConfigAddressMap :: AddressMap }
data XcpState = XcpState { xcpStateMasterCounter :: Word16
, xcpStateSlaveCounter :: Word16
, xcpStateSocket :: Maybe Socket
, xcpStateConfig :: XcpConfig }
newtype XcpEth a = XcpEth { unXcpEth :: RWST () [String] XcpState (ExceptT String IO) a } deriving (Monad, Applicative, Functor)
defaultXcpConfig = XcpConfig "192.168.1.1" 21845 "192.168.1.2" 21845 M.empty
runXcpEth :: XcpEth a -> IO (Either String (a,[String]))
runXcpEth act = let s = XcpState 0 0 Nothing defaultXcpConfig in
runExceptT (runRWST (unXcpEth act) () s >>= \(a,_,w) -> return (a,w))
wrapXcpEth :: Word16
-> LB.ByteString
-> XcpEth B.ByteString
wrapXcpEth ctr bs = do
let len = LB.length bs
when (len > 2^161) $ throwError "wrapXcpEth: XCP packet is too long."
let xcpMessage = word16LE (fromIntegral len)
`mappend` word16LE ctr
`mappend` lazyByteString bs
return . LB.toStrict . toLazyByteString $ xcpMessage
incCtr :: XcpEth ()
incCtr = XcpEth . modify $ \s -> s { xcpStateMasterCounter = xcpStateMasterCounter s + 1 }
sendXcp :: LB.ByteString -> XcpEth XcpResult
sendXcp bs = do
st@(XcpState ctr slaveCtr msock cfg) <- XcpEth get
let XcpConfig ip port targetIP targetPort _ = cfg
sock <- maybe
(throwError "sendXcp: Not connected.")
(return)
msock
xcpMessage <- wrapXcpEth ctr bs
targetHostAddr <- XcpEth . liftIO $ inet_addr targetIP
let targetAddr = SockAddrInet targetPort targetHostAddr
n <- XcpEth . liftIO $ sendTo sock xcpMessage targetAddr
incCtr
(res, addr) <- XcpEth . liftIO $ recvFrom sock (1024 * 10)
return $ byteStringToResult res
connect :: IPAddress
-> PortNumber
-> IPAddress
-> PortNumber
-> XcpEth ()
connect myIp myPort destIp destPort = do
conf <- XcpEth $ gets xcpStateConfig
let conf' = XcpConfig myIp myPort destIp destPort (xcpConfigAddressMap conf)
mySocket <- XcpEth $ liftIO $ udpSocket myIp myPort
XcpEth $ modify $ \s -> s { xcpStateConfig = conf', xcpStateSocket = Just mySocket }
res <- sendXcp xcpConnect
case res of
XcpResult _ _ _ -> XcpEth $ tell ["connect ok"]
XcpErr _ _ _ _ -> XcpEth $ tell ["connect failed"]
disconnect :: XcpEth ()
disconnect = do
res <- sendXcp xcpDisconnect
case res of
XcpResult _ _ _ -> do XcpEth $ tell ["disconnect ok"]
ms <- XcpEth $ gets xcpStateSocket
maybe (return ()) (\s -> XcpEth . liftIO $ close s) ms
XcpEth $ modify $ \s -> s { xcpStateSocket = Nothing }
XcpErr _ _ _ _ -> XcpEth $ tell ["disconnect failed"]
logString :: String -> XcpEth ()
logString a = XcpEth $ tell [a]
setVariable :: ToByteString a =>
String
-> a
-> XcpEth ()
setVariable name value = do
addr <- address name
res <- sendXcp $ xcpSet addr value
case res of
XcpErr _ _ _ _ -> throwError "get failed."
XcpResult _ _ _ -> return ()
address :: String
-> XcpEth Word32
address name = do
am <- xcpConfigAddressMap <$> XcpEth (gets xcpStateConfig)
maybe (throwError $ "Could not find name " ++ name) (return) $ M.lookup name am
getVariable :: ToByteString a =>
a
-> String
-> XcpEth a
getVariable dummy name = do
addr <- address name
let sz = sizeOf dummy
res <- sendXcp $ xcpGet addr $ fromIntegral sz
case res of
XcpErr _ _ _ _ -> throwError "get failed."
XcpResult payload _ _ -> let ma = fromBytes dummy (B.unpack payload)
in maybe (throwError "get failed: could not convert result.")
return
ma
throwError :: forall a. String -> XcpEth a
throwError s = XcpEth $ lift $ throwE s