sakuraio-platform (empty) → 0.1.0.0
raw patch · 26 files changed
+857/−0 lines, 26 filesdep +aesondep +basedep +bytestringsetup-changed
Dependencies added: aeson, base, bytestring, hspec, http-client, http-client-tls, http-types, mtl, network, sakuraio-platform, text, time, unordered-containers, wai, warp, websockets, wuss
Files
- ChangeLog.md +3/−0
- LICENSE +30/−0
- README.md +1/−0
- Setup.hs +2/−0
- app/DemoHttpClient.hs +60/−0
- app/DemoWai.hs +71/−0
- app/DemoWebSockets.hs +85/−0
- sakuraio-platform.cabal +141/−0
- src/Network/SakuraIO/Platform/Message.hs +242/−0
- test/Spec.hs +188/−0
- test/data/OGChannels_Bytes.json.txt +1/−0
- test/data/OGChannels_Double_0.001.json.txt +1/−0
- test/data/OGChannels_Float_0.001.json.txt +1/−0
- test/data/OGChannels_Int32_0.json.txt +1/−0
- test/data/OGChannels_Int32_12345.json.txt +1/−0
- test/data/OGChannels_Int64_0.json.txt +1/−0
- test/data/OGChannels_Int64_12345.json.txt +1/−0
- test/data/OGChannels_Word32_0.json.txt +1/−0
- test/data/OGChannels_Word32_12345.json.txt +1/−0
- test/data/OGChannels_Word64_0.json.txt +1/−0
- test/data/OGChannels_Word64_12345.json.txt +1/−0
- test/data/OGConnection_false.json.txt +1/−0
- test/data/OGConnection_true.json.txt +1/−0
- test/data/OGKeepalive.json.txt +1/−0
- test/data/OGLocation_0.json.txt +12/−0
- test/data/OGLocation_unknown.json.txt +8/−0
+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for sakuraio-platform++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Takamasa Mitsuji (c) 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Author name here nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,1 @@+# sakuraio-platform
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/DemoHttpClient.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import System.Environment (getArgs)+import qualified Network.HTTP.Client as HC+import Network.HTTP.Client.TLS (tlsManagerSettings)+import qualified Data.ByteString.Lazy as LBS++import Data.Monoid ((<>))+import qualified Data.Aeson as AE++import Network.SakuraIO.Platform.Message+++main :: IO ()+main = do+ httpManager <- HC.newManager tlsManagerSettings+ ep:mid:ch:tname:value:_ <- getArgs+ + case tname of+ xs | elem xs ["i","I","l","L","f","d","b"] ->+ let msg = case tname of+ "i" -> ICChannels mid [ICChannel (read ch) (CVInt32 (read value))]+ "I" -> ICChannels mid [ICChannel (read ch) (CVWord32 (read value))]+ "l" -> ICChannels mid [ICChannel (read ch) (CVInt64 (read value))]+ "L" -> ICChannels mid [ICChannel (read ch) (CVWord64 (read value))]+ "f" -> ICChannels mid [ICChannel (read ch) (CVFloat (read value))]+ "d" -> ICChannels mid [ICChannel (read ch) (CVDouble (read value))]+ "b" -> ICChannels mid [ICChannel (read ch) (CVBytes (read value))] -- [TODO]+ in LBS.putStr =<< sendMessage httpManager ep msg+ + _ -> do+ putStrLn "sakuraio-platform-demo-http-client"+ putStrLn ""+ putStrLn "Usage: sakuraio-platform-demo-http-client-exe [endpoint] [module] [channel] [type] [value]"+ putStrLn ""+ putStrLn "Avaliable type:"+ putStrLn "\ti: signed 32 bit integer"+ putStrLn "\tI: unsigned 32 bit integer"+ putStrLn "\tl: signed 64 bit integer"+ putStrLn "\tL: unsigned 64 bit integer"+ putStrLn "\tf: float"+ putStrLn "\td: double"+ putStrLn "\tb: byte array"+++sendMessage :: HC.Manager -> String -> InComingMessage -> IO LBS.ByteString+sendMessage man ep msg = do+ req <- HC.parseRequest $ "https://api.sakura.io/incoming/v1/" <> ep+ let req' = req {HC.method = "POST", HC.requestBody = HC.RequestBodyLBS $ AE.encode msg}+ res <- HC.httpLbs req' man+ return $ HC.responseBody res+++-- for repl+sendMessage' :: String -> InComingMessage -> IO LBS.ByteString+sendMessage' ep msg =+ HC.newManager tlsManagerSettings >>= \man -> sendMessage man ep msg+
+ app/DemoWai.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import System.Environment (getArgs)+import Data.String (fromString)+import qualified Network.Wai.Handler.Warp as Warp+import qualified Network.Wai as Wai+import qualified Network.HTTP.Types as H++import Data.Monoid ((<>))+import qualified Data.Aeson as AE++import Network.SakuraIO.Platform.Message+++main :: IO ()+main = do+ host:port:_ <- getArgs+ Warp.runSettings (+ Warp.setHost (fromString host) $+ Warp.setPort (read port) $+ Warp.defaultSettings+ ) $ demoApp++demoApp :: Wai.Application+demoApp req respond = do+ body <- Wai.strictRequestBody req+ case AE.decode body of+ Nothing -> do+ putStrLn $ "parse json failed ..."+ respond $ Wai.responseLBS H.status500 [("Content-Type","text/plain")] "NG"+ + Just msg -> do+ case msg of+ OGChannels md mdt (OGChannel ch cdt (CVInt32 i):_) ->+ putStrLn $ md <> ": " <> "OGChannel " <> (show ch) <> " " <> "(CVInt32 " <> (show i <> ")")+ + OGChannels md mdt (OGChannel ch cdt (CVWord32 i):_) ->+ putStrLn $ md <> ": " <> "OGChannel " <> (show ch) <> " " <> "(CVWord32 " <> (show i <> ")")++ OGChannels md mdt (OGChannel ch cdt (CVInt64 l):_) ->+ putStrLn $ md <> ": " <> "OGChannel " <> (show ch) <> " " <> "(CVInt64 " <> (show l <> ")")++ OGChannels md mdt (OGChannel ch cdt (CVWord64 l):_) ->+ putStrLn $ md <> ": " <> "OGChannel " <> (show ch) <> " " <> "(CVWord64 " <> (show l <> ")")++ OGChannels md mdt (OGChannel ch cdt (CVFloat f):_) ->+ putStrLn $ md <> ": " <> "OGChannel " <> (show ch) <> " " <> "(CVFloat " <> (show f <> ")")++ OGChannels md mdt (OGChannel ch cdt (CVDouble d):_) ->+ putStrLn $ md <> ": " <> "OGChannel " <> (show ch) <> " " <> "(CVDouble " <> (show d <> ")")+ + OGChannels md mdt (OGChannel ch cdt (CVBytes b):_) ->+ putStrLn $ md <> ": " <> "OGChannel " <> (show ch) <> " " <> "(CVBytes " <> (show b <> ")")++ OGConnection md mdt conn ->+ putStrLn $ md <> ": " <> "OGConnection " <> (show conn)+ + OGLocation md mdt Nothing ->+ putStrLn $ md <> ": " <> "OGLocation " <> "Unknown"++ OGLocation md mdt (Just (Coordinate la lo rm)) ->+ putStrLn $ md <> ": " <> "OGLocation " <> (show la) <> " " <> (show lo) <> " " <> (show rm)++ OGKeepalive mdt ->+ putStrLn $ "OGKeepalive " <> (show mdt)+ + respond $ Wai.responseLBS H.status200 [("Content-Type","text/plain")] "OK"+ +
+ app/DemoWebSockets.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import System.Environment (getArgs)+import Network.Socket (withSocketsDo)+import qualified Network.WebSockets as WS+import Wuss (runSecureClient)+import Control.Concurrent (forkIO)+import Control.Monad (forever,unless)++import Data.Monoid ((<>))+import qualified Data.Aeson as AE++import Network.SakuraIO.Platform.Message+++main :: IO ()+main = do+ ep:_ <- getArgs+ withSocketsDo $ runSecureClient "api.sakura.io" 443 ("/ws/v1/" <> ep) app+++app :: WS.ClientApp ()+app conn = do+ + _ <- forkIO $ forever $ do+ rdata <- WS.receiveData conn+ case AE.decode rdata of+ Nothing -> putStrLn $ "parse json failed ..."+ Just msg ->+ case msg of+ OGChannels md mdt (OGChannel ch cdt (CVInt32 i):_) ->+ putStrLn $ md <> ": " <> "OGChannel " <> (show ch) <> " " <> "(CVInt32 " <> (show i <> ")")+ + OGChannels md mdt (OGChannel ch cdt (CVWord32 i):_) ->+ putStrLn $ md <> ": " <> "OGChannel " <> (show ch) <> " " <> "(CVWord32 " <> (show i <> ")")++ OGChannels md mdt (OGChannel ch cdt (CVInt64 l):_) ->+ putStrLn $ md <> ": " <> "OGChannel " <> (show ch) <> " " <> "(CVInt64 " <> (show l <> ")")++ OGChannels md mdt (OGChannel ch cdt (CVWord64 l):_) ->+ putStrLn $ md <> ": " <> "OGChannel " <> (show ch) <> " " <> "(CVWord64 " <> (show l <> ")")++ OGChannels md mdt (OGChannel ch cdt (CVFloat f):_) ->+ putStrLn $ md <> ": " <> "OGChannel " <> (show ch) <> " " <> "(CVFloat " <> (show f <> ")")++ OGChannels md mdt (OGChannel ch cdt (CVDouble d):_) ->+ putStrLn $ md <> ": " <> "OGChannel " <> (show ch) <> " " <> "(CVDouble " <> (show d <> ")")+ + OGChannels md mdt (OGChannel ch cdt (CVBytes b):_) ->+ putStrLn $ md <> ": " <> "OGChannel " <> (show ch) <> " " <> "(CVBytes " <> (show b <> ")")++ OGConnection md mdt conn ->+ putStrLn $ md <> ": " <> "OGConnection " <> (show conn)+ + OGLocation md mdt Nothing ->+ putStrLn $ md <> ": " <> "OGLocation " <> "Unknown"++ OGLocation md mdt (Just (Coordinate la lo rm)) ->+ putStrLn $ md <> ": " <> "OGLocation " <> (show la) <> " " <> (show lo) <> " " <> (show rm)++ OGKeepalive mdt ->+ putStrLn $ "OGKeepalive " <> (show mdt)+ ++ let loop = do+ line <- getLine+ unless (null line) $ do+ let mid:ch:tname:value:_ = words line+ case tname of+ xs | elem xs ["i","I","l","L","f","d","b"] ->+ let msg = case tname of+ "i" -> ICChannels mid [ICChannel (read ch) (CVInt32 (read value))]+ "I" -> ICChannels mid [ICChannel (read ch) (CVWord32 (read value))]+ "l" -> ICChannels mid [ICChannel (read ch) (CVInt64 (read value))]+ "L" -> ICChannels mid [ICChannel (read ch) (CVWord64 (read value))]+ "f" -> ICChannels mid [ICChannel (read ch) (CVFloat (read value))]+ "d" -> ICChannels mid [ICChannel (read ch) (CVDouble (read value))]+ "b" -> ICChannels mid [ICChannel (read ch) (CVBytes (read value))] -- [TODO]+ in WS.sendTextData conn (AE.encode msg)+ _ -> return ()+ loop+ loop+
+ sakuraio-platform.cabal view
@@ -0,0 +1,141 @@+-- This file has been generated from package.yaml by hpack version 0.15.0.+--+-- see: https://github.com/sol/hpack++name: sakuraio-platform+version: 0.1.0.0+synopsis: Haskell representation of messages exchanged on the sakura.io platform.+description: Please see the README on GitHub at <https://github.com/mitsuji/sakuraio-platform#readme>+category: Network+homepage: https://github.com/mitsuji/sakuraio-platform#readme+bug-reports: https://github.com/mitsuji/sakuraio-platform/issues+author: Takamasa Mitsuji+maintainer: tkms@mitsuji.org+copyright: 2018 Takamasa Mitsuji+license: BSD3+license-file: LICENSE+build-type: Simple+cabal-version: >= 1.10++extra-source-files:+ ChangeLog.md+ README.md+ test/data/OGChannels_Bytes.json.txt+ test/data/OGChannels_Double_0.001.json.txt+ test/data/OGChannels_Float_0.001.json.txt+ test/data/OGChannels_Int32_0.json.txt+ test/data/OGChannels_Int32_12345.json.txt+ test/data/OGChannels_Int64_0.json.txt+ test/data/OGChannels_Int64_12345.json.txt+ test/data/OGChannels_Word32_0.json.txt+ test/data/OGChannels_Word32_12345.json.txt+ test/data/OGChannels_Word64_0.json.txt+ test/data/OGChannels_Word64_12345.json.txt+ test/data/OGConnection_false.json.txt+ test/data/OGConnection_true.json.txt+ test/data/OGKeepalive.json.txt+ test/data/OGLocation_0.json.txt+ test/data/OGLocation_unknown.json.txt++source-repository head+ type: git+ location: https://github.com/mitsuji/sakuraio-platform++flag demo+ description: install demo applications.+ manual: True+ default: False++library+ hs-source-dirs:+ src+ build-depends:+ base >= 4.7 && < 5+ , time+ , bytestring+ , aeson+ , unordered-containers+ exposed-modules:+ Network.SakuraIO.Platform.Message+ default-language: Haskell2010++executable sakuraio-platform-demo-http-client-exe+ main-is: DemoHttpClient.hs+ hs-source-dirs:+ app+ build-depends:+ base >= 4.7 && < 5+ , time+ , bytestring+ , aeson+ , unordered-containers+ , sakuraio-platform+ , http-types+ , http-client+ , http-client-tls+ if !flag(demo)+ buildable: False+ other-modules:+ DemoWai+ DemoWebSockets+ default-language: Haskell2010++executable sakuraio-platform-demo-wai-exe+ main-is: DemoWai.hs+ hs-source-dirs:+ app+ build-depends:+ base >= 4.7 && < 5+ , time+ , bytestring+ , aeson+ , unordered-containers+ , sakuraio-platform+ , http-types+ , wai+ , warp+ if !flag(demo)+ buildable: False+ other-modules:+ DemoHttpClient+ DemoWebSockets+ default-language: Haskell2010++executable sakuraio-platform-demo-websockets-exe+ main-is: DemoWebSockets.hs+ hs-source-dirs:+ app+ build-depends:+ base >= 4.7 && < 5+ , time+ , bytestring+ , aeson+ , unordered-containers+ , sakuraio-platform+ , websockets+ , wuss+ , network+ , mtl+ , text+ if !flag(demo)+ buildable: False+ other-modules:+ DemoHttpClient+ DemoWai+ default-language: Haskell2010++test-suite sakuraio-platform-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs:+ test+ build-depends:+ base >= 4.7 && < 5+ , time+ , bytestring+ , aeson+ , unordered-containers+ , sakuraio-platform+ , hspec+ , time+ default-language: Haskell2010
+ src/Network/SakuraIO/Platform/Message.hs view
@@ -0,0 +1,242 @@+{-# LANGUAGE OverloadedStrings #-}++-- :set -XOverloadedStrings++-- |+-- This module provides Haskell representation of messages exchanged on the sakura.io platform.+-- +-- https://sakura.io/docs/pages/spec/platform/message.html++module Network.SakuraIO.Platform.Message (+ ModuleID+ ,OutGoingMessage (..)+ ,ChannelID+ ,OGChannel (..)+ ,Latitude, Longitude, RangeM+ ,Coordinate (..)+ ,InComingMessage (..)+ ,ICChannel (..)+ ,ChannelValue (..)+ ) where+++import Data.Time.Clock(UTCTime(..))+import Data.Int(Int32(..),Int64(..))+import Data.Word(Word8(..),Word32(..),Word64(..))+import qualified Data.ByteString as BS++import Control.Applicative(empty)+import Data.HashMap.Strict ((!))+import Data.Aeson.Types (Value(..))+import Data.Aeson.Types (FromJSON,parseJSON,(.:),Parser(..))+import Data.Aeson.Types (ToJSON,toJSON,object,(.=))++import Data.Monoid ((<>))++-- | Module ID starting with \'u\'.+type ModuleID = String++-- | Messages sent from sakura.io to external services.+--+-- It supports `FromJSON` to parse from json using @aeson@.+data OutGoingMessage = OGChannels ModuleID UTCTime [OGChannel]+ | OGConnection ModuleID UTCTime Bool+ | OGLocation ModuleID UTCTime (Maybe Coordinate)+ | OGKeepalive UTCTime+ deriving (Eq,Show)+++-- | 7bit channel number.+type ChannelID = Word8++-- | Channel payload sent from sakura.io to external services as part of `OGChannels`.+--+-- It supports `FromJSON` to parse from json using @aeson@.+data OGChannel = OGChannel ChannelID UTCTime ChannelValue deriving (Eq,Show)++-- | Latitude.+type Latitude = Float+-- | Longitude.+type Longitude = Float+-- | Range in meters.+type RangeM = Int32++-- | Coordinate payload sent from sakura.io to external services as part of `OGLocation`.+--+-- It supports `FromJSON` to get json representation using @aeson@.+data Coordinate = Coordinate Latitude Longitude RangeM deriving (Eq,Show)+++-- | Messages sent from external services to sakura.io.+--+-- It supports `ToJSON` to get json representation using @aeson@.+data InComingMessage = ICChannels ModuleID [ICChannel] deriving (Eq,Show)++-- | Channel payload sent from external services to sakura.io as part of `ICChannels`.+--+-- It supports `ToJSON` to get json representation using @aeson@.+data ICChannel = ICChannel ChannelID ChannelValue deriving (Eq,Show)+++-- | Data exchanged between sakura.io and external services as part of `OGChannel` and `ICChannel`.+--+data ChannelValue = CVInt32 Int32+ | CVWord32 Word32+ | CVInt64 Int64+ | CVWord64 Word64+ | CVFloat Float+ | CVDouble Double+ | CVBytes BS.ByteString+ deriving (Eq,Show)++++++instance FromJSON OutGoingMessage where+ parseJSON (Object v ) = do+ dt <- v .: "datetime"+ t <- (v .: "type" :: Parser String)+ case t of+ "channels" -> case (v ! "payload") of+ Object pl -> do+ md <- v .: "module"+ cs <- pl .: "channels"+ return $ OGChannels md dt cs+ _ -> fail "playload must be Object"+ "connection" -> case (v ! "payload") of+ Object pl -> do+ md <- v .: "module"+ ol <- pl .: "is_online"+ return $ OGConnection md dt ol+ _ -> fail "playload must be Object"+ "location" -> case (v ! "payload") of+ Object pl -> do+ md <- v .: "module"+ cd <- pl .: "coordinate"+ return $ OGLocation md dt cd+ _ -> fail "playload must be Object"+ "keepalive"-> return $ OGKeepalive dt++ parseJSON _ = empty+++instance FromJSON OGChannel where+ parseJSON (Object v) = do+ ch <- v .: "channel"+ dt <- v .: "datetime"+ t <- v .: "type"+ v <- case t of+ 'i' -> CVInt32 <$> v .: "value"+ 'I' -> CVWord32 <$> v .: "value"+ 'l' -> CVInt64 <$> v .: "value"+ 'L' -> CVWord64 <$> v .: "value"+ 'f' -> CVFloat <$> v .: "value"+ 'd' -> CVDouble <$> v .: "value"+ 'b' -> CVBytes . parseHex <$> v .: "value"+ return $ OGChannel ch dt v++ parseJSON _ = empty++++instance FromJSON Coordinate where+ parseJSON (Object v) =+ Coordinate <$> v .: "latitude" <*> v .: "longitude" <*> v .: "range_m"++ parseJSON _ = empty++++instance ToJSON InComingMessage where+ toJSON (ICChannels md xs) =+ object ["type" .= ("channels"::String), "module" .= md,+ "payload" .= object ["channels" .= xs]+ ]+ +instance ToJSON ICChannel where++ toJSON (ICChannel ch (CVInt32 i)) =+ object ["channel" .= ch, "type" .= ("i"::String), "value" .= i]+ + toJSON (ICChannel ch (CVWord32 i)) =+ object ["channel" .= ch, "type" .= ("I"::String), "value" .= i]++ toJSON (ICChannel ch (CVInt64 l)) =+ object ["channel" .= ch, "type" .= ("l"::String), "value" .= l]++ toJSON (ICChannel ch (CVWord64 l)) =+ object ["channel" .= ch, "type" .= ("L"::String), "value" .= l]++ toJSON (ICChannel ch (CVFloat f)) =+ object ["channel" .= ch, "type" .= ("f"::String), "value" .= f]++ toJSON (ICChannel ch (CVDouble d)) =+ object ["channel" .= ch, "type" .= ("d"::String), "value" .= d]++ toJSON (ICChannel ch (CVBytes b)) =+ object ["channel" .= ch, "type" .= ("b"::String), "value" .= toHex b]++++parseHex :: [Char] -> BS.ByteString+parseHex = BS.pack . f . splitAt 2+ where+ f :: ([Char],[Char]) -> [Word8]+ f ([], _) = []+ f (xs, ys) = (g xs) : (f $ splitAt 2 ys)++ g :: [Char] -> Word8+ g (h:l:[]) = (d h) * 16 + (d l)+ where+ d :: Char -> Word8+ d '0' = 0x0+ d '1' = 0x1+ d '2' = 0x2+ d '3' = 0x3+ d '4' = 0x4+ d '5' = 0x5+ d '6' = 0x6+ d '7' = 0x7+ d '8' = 0x8+ d '9' = 0x9+ d 'a' = 0xa+ d 'b' = 0xb+ d 'c' = 0xc+ d 'd' = 0xd+ d 'e' = 0xe+ d 'f' = 0xf+ d 'A' = 0xa+ d 'B' = 0xb+ d 'C' = 0xc+ d 'D' = 0xd+ d 'E' = 0xe+ d 'F' = 0xf+++toHex :: BS.ByteString -> [Char]+toHex bs = foldr (\b->(<>)(g b)) [] $ BS.unpack bs+ where+ g :: Word8 -> [Char]+ g w = [d $ w `div` 16, d $ w `mod` 16]+ where+ d :: Word8 -> Char+ d 0x0 = '0'+ d 0x1 = '1'+ d 0x2 = '2'+ d 0x3 = '3'+ d 0x4 = '4'+ d 0x5 = '5'+ d 0x6 = '6'+ d 0x7 = '7'+ d 0x8 = '8'+ d 0x9 = '9'+ d 0xa = 'a'+ d 0xb = 'b'+ d 0xc = 'c'+ d 0xd = 'd'+ d 0xe = 'e'+ d 0xf = 'f'+++
+ test/Spec.hs view
@@ -0,0 +1,188 @@+{-# LANGUAGE OverloadedStrings #-}++-- :set -XOverloadedStrings++import Test.Hspec+-- import Control.Exception (evaluate)++import Network.SakuraIO.Platform.Message +import qualified Data.Aeson as AE+import qualified Data.ByteString.Lazy as LBS+import Data.Time.Clock (UTCTime(..),DiffTime(..))+import Data.Time.Calendar (fromGregorian)+++main :: IO ()+main = hspec $ do+ describe "Network.SakuraIO.Platform" $ do+ describe "Message" $ do++ json <- runIO $ LBS.readFile "test/data/OGChannels_Word32_0.json.txt"+ it "32 bit unsigned integer 0" $ do+ AE.decode json `shouldBe`+ (Just+ (OGChannels "uXXXXXXXXXXX"+ (UTCTime (fromGregorian 2018 06 21) (fromClock 1 10 57.770020629))+ [OGChannel 0+ (UTCTime (fromGregorian 2018 06 21) (fromClock 1 10 57.770023483))+ (CVWord32 0)]))++ json <- runIO $ LBS.readFile "test/data/OGChannels_Word32_12345.json.txt"+ it "32 bit unsigned integer 12345" $ do+ AE.decode json `shouldBe`+ (Just+ (OGChannels "uXXXXXXXXXXX"+ (UTCTime (fromGregorian 2018 06 21) (fromClock 1 10 57.770020629))+ [OGChannel 0+ (UTCTime (fromGregorian 2018 06 21) (fromClock 1 10 57.770023483))+ (CVWord32 12345)]))+ + json <- runIO $ LBS.readFile "test/data/OGChannels_Int32_0.json.txt"+ it "32 bit signed integer 0" $ do+ AE.decode json `shouldBe`+ (Just+ (OGChannels "uXXXXXXXXXXX"+ (UTCTime (fromGregorian 2018 06 21) (fromClock 1 10 57.770020629))+ [OGChannel 0+ (UTCTime (fromGregorian 2018 06 21) (fromClock 1 10 57.770023483))+ (CVInt32 0)]))++ json <- runIO $ LBS.readFile "test/data/OGChannels_Int32_12345.json.txt"+ it "32 bit signed integer 12345" $ do+ AE.decode json `shouldBe`+ (Just+ (OGChannels "uXXXXXXXXXXX"+ (UTCTime (fromGregorian 2018 06 21) (fromClock 1 10 57.770020629))+ [OGChannel 0+ (UTCTime (fromGregorian 2018 06 21) (fromClock 1 10 57.770023483))+ (CVInt32 12345)]))+ + json <- runIO $ LBS.readFile "test/data/OGChannels_Word64_0.json.txt"+ it "64 bit unsigned integer 0" $ do+ AE.decode json `shouldBe`+ (Just+ (OGChannels "uXXXXXXXXXXX"+ (UTCTime (fromGregorian 2018 06 21) (fromClock 1 10 57.770020629))+ [OGChannel 0+ (UTCTime (fromGregorian 2018 06 21) (fromClock 1 10 57.770023483))+ (CVWord64 0)]))++ json <- runIO $ LBS.readFile "test/data/OGChannels_Word64_12345.json.txt"+ it "64 bit unsigned integer 12345" $ do+ AE.decode json `shouldBe`+ (Just+ (OGChannels "uXXXXXXXXXXX"+ (UTCTime (fromGregorian 2018 06 21) (fromClock 1 10 57.770020629))+ [OGChannel 0+ (UTCTime (fromGregorian 2018 06 21) (fromClock 1 10 57.770023483))+ (CVWord64 12345)]))+ + json <- runIO $ LBS.readFile "test/data/OGChannels_Int64_0.json.txt"+ it "64 bit signed integer 0" $ do+ AE.decode json `shouldBe`+ (Just+ (OGChannels "uXXXXXXXXXXX"+ (UTCTime (fromGregorian 2018 06 21) (fromClock 1 10 57.770020629))+ [OGChannel 0+ (UTCTime (fromGregorian 2018 06 21) (fromClock 1 10 57.770023483))+ (CVInt64 0)]))++ json <- runIO $ LBS.readFile "test/data/OGChannels_Int64_12345.json.txt"+ it "64 bit signed integer 12345" $ do+ AE.decode json `shouldBe`+ (Just+ (OGChannels "uXXXXXXXXXXX"+ (UTCTime (fromGregorian 2018 06 21) (fromClock 1 10 57.770020629))+ [OGChannel 0+ (UTCTime (fromGregorian 2018 06 21) (fromClock 1 10 57.770023483))+ (CVInt64 12345)]))+ + json <- runIO $ LBS.readFile "test/data/OGChannels_Float_0.001.json.txt"+ it "float 0.001" $ do+ AE.decode json `shouldBe`+ (Just+ (OGChannels "uXXXXXXXXXXX"+ (UTCTime (fromGregorian 2018 06 21) (fromClock 1 10 57.770020629))+ [OGChannel 0+ (UTCTime (fromGregorian 2018 06 21) (fromClock 1 10 57.770023483))+ (CVFloat 0.001)]))+ + json <- runIO $ LBS.readFile "test/data/OGChannels_Double_0.001.json.txt"+ it "double 0.001" $ do+ AE.decode json `shouldBe`+ (Just+ (OGChannels "uXXXXXXXXXXX"+ (UTCTime (fromGregorian 2018 06 21) (fromClock 1 10 57.770020629))+ [OGChannel 0+ (UTCTime (fromGregorian 2018 06 21) (fromClock 1 10 57.770023483))+ (CVDouble 0.001)]))+ + json <- runIO $ LBS.readFile "test/data/OGChannels_Bytes.json.txt"+ it "bytes abcdefgh ijklmnop ABCEDFGH IJKLMNOP" $ do+ AE.decode json `shouldBe`+ (Just+ (OGChannels "uXXXXXXXXXXX"+ (UTCTime (fromGregorian 2018 06 21) (fromClock 1 10 57.770020629))+ [OGChannel 0+ (UTCTime (fromGregorian 2018 06 21) (fromClock 1 10 57.770023483))+ (CVBytes "abcdefgh")+ ,OGChannel 0+ (UTCTime (fromGregorian 2018 06 21) (fromClock 1 10 57.770023483))+ (CVBytes "ijklmnop")+ ,OGChannel 0+ (UTCTime (fromGregorian 2018 06 21) (fromClock 1 10 57.770023483))+ (CVBytes "ABCDEFGH")+ ,OGChannel 0+ (UTCTime (fromGregorian 2018 06 21) (fromClock 1 10 57.770023483))+ (CVBytes "IJKLMNOP")+ ]))+++ json <- runIO $ LBS.readFile "test/data/OGConnection_true.json.txt"+ it "connection true" $ do+ AE.decode json `shouldBe`+ (Just+ (OGConnection "uXXXXXXXXXXX"+ (UTCTime (fromGregorian 2018 06 21) (fromClock 1 10 57.770020629))+ True))+ + json <- runIO $ LBS.readFile "test/data/OGConnection_false.json.txt"+ it "connection false" $ do+ AE.decode json `shouldBe`+ (Just+ (OGConnection "uXXXXXXXXXXX"+ (UTCTime (fromGregorian 2018 06 21) (fromClock 1 10 57.770020629))+ False))++ json <- runIO $ LBS.readFile "test/data/OGLocation_unknown.json.txt"+ it "location unknown" $ do+ AE.decode json `shouldBe`+ (Just+ (OGLocation "uXXXXXXXXXXX"+ (UTCTime (fromGregorian 2018 06 21) (fromClock 1 10 57.770020629))+ Nothing))++ json <- runIO $ LBS.readFile "test/data/OGLocation_0.json.txt"+ it "location 0" $ do+ AE.decode json `shouldBe`+ (Just+ (OGLocation "uXXXXXXXXXXX"+ (UTCTime (fromGregorian 2018 06 21) (fromClock 1 10 57.770020629))+ (Just (Coordinate 0.0 0.0 0))))++ json <- runIO $ LBS.readFile "test/data/OGKeepalive.json.txt"+ it "keepalive" $ do+ AE.decode json `shouldBe`+ (Just+ (OGKeepalive+ (UTCTime (fromGregorian 2018 06 21) (fromClock 1 10 57.770020629))+ )+ )++++++fromClock :: Int -> Int -> Double -> DiffTime+fromClock h m s =+ fromRational $ (fromIntegral h) * 60 * 60 + (fromIntegral m) * 60 + (toRational s)
+ test/data/OGChannels_Bytes.json.txt view
@@ -0,0 +1,1 @@+{"module":"uXXXXXXXXXXX","type":"channels","datetime":"2018-06-21T01:10:57.770020629Z","payload":{"channels":[{"channel":0,"type":"b","value":"6162636465666768","datetime":"2018-06-21T01:10:57.770023483Z"},{"channel":0,"type":"b","value":"696a6b6c6d6e6f70","datetime":"2018-06-21T01:10:57.770023483Z"},{"channel":0,"type":"b","value":"4142434445464748","datetime":"2018-06-21T01:10:57.770023483Z"},{"channel":0,"type":"b","value":"494a4b4c4d4e4f50","datetime":"2018-06-21T01:10:57.770023483Z"}]}}
+ test/data/OGChannels_Double_0.001.json.txt view
@@ -0,0 +1,1 @@+{"module":"uXXXXXXXXXXX","type":"channels","datetime":"2018-06-21T01:10:57.770020629Z","payload":{"channels":[{"channel":0,"type":"d","value":0.001,"datetime":"2018-06-21T01:10:57.770023483Z"}]}}
+ test/data/OGChannels_Float_0.001.json.txt view
@@ -0,0 +1,1 @@+{"module":"uXXXXXXXXXXX","type":"channels","datetime":"2018-06-21T01:10:57.770020629Z","payload":{"channels":[{"channel":0,"type":"f","value":0.001,"datetime":"2018-06-21T01:10:57.770023483Z"}]}}
+ test/data/OGChannels_Int32_0.json.txt view
@@ -0,0 +1,1 @@+{"module":"uXXXXXXXXXXX","type":"channels","datetime":"2018-06-21T01:10:57.770020629Z","payload":{"channels":[{"channel":0,"type":"i","value":0,"datetime":"2018-06-21T01:10:57.770023483Z"}]}}
+ test/data/OGChannels_Int32_12345.json.txt view
@@ -0,0 +1,1 @@+{"module":"uXXXXXXXXXXX","type":"channels","datetime":"2018-06-21T01:10:57.770020629Z","payload":{"channels":[{"channel":0,"type":"i","value":12345,"datetime":"2018-06-21T01:10:57.770023483Z"}]}}
+ test/data/OGChannels_Int64_0.json.txt view
@@ -0,0 +1,1 @@+{"module":"uXXXXXXXXXXX","type":"channels","datetime":"2018-06-21T01:10:57.770020629Z","payload":{"channels":[{"channel":0,"type":"l","value":0,"datetime":"2018-06-21T01:10:57.770023483Z"}]}}
+ test/data/OGChannels_Int64_12345.json.txt view
@@ -0,0 +1,1 @@+{"module":"uXXXXXXXXXXX","type":"channels","datetime":"2018-06-21T01:10:57.770020629Z","payload":{"channels":[{"channel":0,"type":"l","value":12345,"datetime":"2018-06-21T01:10:57.770023483Z"}]}}
+ test/data/OGChannels_Word32_0.json.txt view
@@ -0,0 +1,1 @@+{"module":"uXXXXXXXXXXX","type":"channels","datetime":"2018-06-21T01:10:57.770020629Z","payload":{"channels":[{"channel":0,"type":"I","value":0,"datetime":"2018-06-21T01:10:57.770023483Z"}]}}
+ test/data/OGChannels_Word32_12345.json.txt view
@@ -0,0 +1,1 @@+{"module":"uXXXXXXXXXXX","type":"channels","datetime":"2018-06-21T01:10:57.770020629Z","payload":{"channels":[{"channel":0,"type":"I","value":12345,"datetime":"2018-06-21T01:10:57.770023483Z"}]}}
+ test/data/OGChannels_Word64_0.json.txt view
@@ -0,0 +1,1 @@+{"module":"uXXXXXXXXXXX","type":"channels","datetime":"2018-06-21T01:10:57.770020629Z","payload":{"channels":[{"channel":0,"type":"L","value":0,"datetime":"2018-06-21T01:10:57.770023483Z"}]}}
+ test/data/OGChannels_Word64_12345.json.txt view
@@ -0,0 +1,1 @@+{"module":"uXXXXXXXXXXX","type":"channels","datetime":"2018-06-21T01:10:57.770020629Z","payload":{"channels":[{"channel":0,"type":"L","value":12345,"datetime":"2018-06-21T01:10:57.770023483Z"}]}}
+ test/data/OGConnection_false.json.txt view
@@ -0,0 +1,1 @@+{"module":"uXXXXXXXXXXX","type":"connection","datetime":"2018-06-21T01:10:57.770020629Z","payload":{"is_online":false}}
+ test/data/OGConnection_true.json.txt view
@@ -0,0 +1,1 @@+{"module":"uXXXXXXXXXXX","type":"connection","datetime":"2018-06-21T01:10:57.770020629Z","payload":{"is_online":true}}
+ test/data/OGKeepalive.json.txt view
@@ -0,0 +1,1 @@+{"type":"keepalive","datetime":"2018-06-21T01:10:57.770020629Z"}
+ test/data/OGLocation_0.json.txt view
@@ -0,0 +1,12 @@+{+ "datetime": "2018-06-21T01:10:57.770020629Z",+ "module": "uXXXXXXXXXXX",+ "type": "location",+ "payload": {+ "coordinate": {+ "latitude": 0.000000,+ "longitude": 0.000000,+ "range_m": 0+ }+ }+}
+ test/data/OGLocation_unknown.json.txt view
@@ -0,0 +1,8 @@+{+ "datetime": "2018-06-21T01:10:57.770020629Z",+ "module": "uXXXXXXXXXXX",+ "type": "location",+ "payload": {+ "coordinate": null+ }+}