module Data.TTN.Client.Decode where

import Data.ByteString.Lazy.Char8 (ByteString)
import Data.Text (Text)
import Data.TTN (Event(..), EventType(Up), Uplink(..))

import qualified Data.ByteString.Char8
import qualified Data.ByteString.Lazy.Char8
import qualified Data.ByteString.Base64
import qualified Data.Text

import Data.Binary.Get
import Data.Either
import qualified Data.Cayenne as CLPP


data Decoded =
    TempHumidity Float Float
  | Cayenne [CLPP.Reading]
  deriving (Int -> Decoded -> ShowS
[Decoded] -> ShowS
Decoded -> String
(Int -> Decoded -> ShowS)
-> (Decoded -> String) -> ([Decoded] -> ShowS) -> Show Decoded
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Decoded] -> ShowS
$cshowList :: [Decoded] -> ShowS
show :: Decoded -> String
$cshow :: Decoded -> String
showsPrec :: Int -> Decoded -> ShowS
$cshowsPrec :: Int -> Decoded -> ShowS
Show, Decoded -> Decoded -> Bool
(Decoded -> Decoded -> Bool)
-> (Decoded -> Decoded -> Bool) -> Eq Decoded
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Decoded -> Decoded -> Bool
$c/= :: Decoded -> Decoded -> Bool
== :: Decoded -> Decoded -> Bool
$c== :: Decoded -> Decoded -> Bool
Eq, Eq Decoded
Eq Decoded
-> (Decoded -> Decoded -> Ordering)
-> (Decoded -> Decoded -> Bool)
-> (Decoded -> Decoded -> Bool)
-> (Decoded -> Decoded -> Bool)
-> (Decoded -> Decoded -> Bool)
-> (Decoded -> Decoded -> Decoded)
-> (Decoded -> Decoded -> Decoded)
-> Ord Decoded
Decoded -> Decoded -> Bool
Decoded -> Decoded -> Ordering
Decoded -> Decoded -> Decoded
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Decoded -> Decoded -> Decoded
$cmin :: Decoded -> Decoded -> Decoded
max :: Decoded -> Decoded -> Decoded
$cmax :: Decoded -> Decoded -> Decoded
>= :: Decoded -> Decoded -> Bool
$c>= :: Decoded -> Decoded -> Bool
> :: Decoded -> Decoded -> Bool
$c> :: Decoded -> Decoded -> Bool
<= :: Decoded -> Decoded -> Bool
$c<= :: Decoded -> Decoded -> Bool
< :: Decoded -> Decoded -> Bool
$c< :: Decoded -> Decoded -> Bool
compare :: Decoded -> Decoded -> Ordering
$ccompare :: Decoded -> Decoded -> Ordering
$cp1Ord :: Eq Decoded
Ord)

decodeUplink :: Event -> [Decoded]
decodeUplink :: Event -> [Decoded]
decodeUplink (Event EventType
Up Uplink { uplinkPayloadRaw :: Uplink -> Maybe Text
uplinkPayloadRaw = Just Text
payload }) =
  Text -> [Decoded]
tryDecode Text
payload
decodeUplink Event
_ = []

tryDecode :: Text -> [Decoded]
tryDecode :: Text -> [Decoded]
tryDecode Text
x = [Either String Decoded] -> [Decoded]
forall a b. [Either a b] -> [b]
rights ([Either String Decoded] -> [Decoded])
-> [Either String Decoded] -> [Decoded]
forall a b. (a -> b) -> a -> b
$ ((ByteString -> Either String Decoded) -> Either String Decoded)
-> [ByteString -> Either String Decoded] -> [Either String Decoded]
forall a b. (a -> b) -> [a] -> [b]
map (\ByteString -> Either String Decoded
f -> ByteString -> Either String Decoded
f (ByteString -> Either String Decoded)
-> (Text -> ByteString) -> Text -> Either String Decoded
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
unbase64 (Text -> Either String Decoded) -> Text -> Either String Decoded
forall a b. (a -> b) -> a -> b
$ Text
x )
  [ ByteString -> Either String Decoded
decodeTH
  , ByteString -> Either String Decoded
decodeCLPP
  ]


decodeTH :: ByteString -> Either String Decoded
decodeTH :: ByteString -> Either String Decoded
decodeTH ByteString
x = case Get Decoded
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, Decoded)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
runGetOrFail Get Decoded
desTH ByteString
x of
  Left (ByteString
_, ByteOffset
_, String
err) -> String -> Either String Decoded
forall a b. a -> Either a b
Left String
err
  Right (ByteString
_, ByteOffset
_, Decoded
a)  -> Decoded -> Either String Decoded
forall a b. b -> Either a b
Right Decoded
a

desTH :: Get Decoded
desTH :: Get Decoded
desTH = do
  Float
t <- Get Float
getFloathost
  Float
h <- Get Float
getFloathost
  Decoded -> Get Decoded
forall (m :: * -> *) a. Monad m => a -> m a
return (Decoded -> Get Decoded) -> Decoded -> Get Decoded
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Decoded
TempHumidity Float
t Float
h

decodeCLPP :: ByteString -> Either String Decoded
decodeCLPP :: ByteString -> Either String Decoded
decodeCLPP ByteString
x = case ByteString -> [Reading]
CLPP.decodeMany ByteString
x of
  [] -> String -> Either String Decoded
forall a b. a -> Either a b
Left String
"no CLPP data decoded"
  [Reading]
c  -> Decoded -> Either String Decoded
forall a b. b -> Either a b
Right (Decoded -> Either String Decoded)
-> Decoded -> Either String Decoded
forall a b. (a -> b) -> a -> b
$ [Reading] -> Decoded
Cayenne [Reading]
c

unbase64 :: Text -> ByteString
unbase64 :: Text -> ByteString
unbase64 =
    ByteString -> ByteString
Data.ByteString.Lazy.Char8.fromStrict
  (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Data.ByteString.Base64.decodeLenient
  (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
Data.ByteString.Char8.pack
  (String -> ByteString) -> (Text -> String) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Data.Text.unpack