aboutsummaryrefslogtreecommitdiff
path: root/src/Tomato/Data
diff options
context:
space:
mode:
Diffstat (limited to 'src/Tomato/Data')
-rw-r--r--src/Tomato/Data/Except.hs9
-rw-r--r--src/Tomato/Data/Message.hs81
-rw-r--r--src/Tomato/Data/Tomato.hs70
3 files changed, 160 insertions, 0 deletions
diff --git a/src/Tomato/Data/Except.hs b/src/Tomato/Data/Except.hs
new file mode 100644
index 0000000..30212cf
--- /dev/null
+++ b/src/Tomato/Data/Except.hs
@@ -0,0 +1,9 @@
+module Tomato.Data.Except
+ ( DecodeException (..)
+ ) where
+
+import RIO
+
+data DecodeException = DecodeException !Text
+ deriving (Show, Typeable)
+instance Exception DecodeException
diff --git a/src/Tomato/Data/Message.hs b/src/Tomato/Data/Message.hs
new file mode 100644
index 0000000..0f650db
--- /dev/null
+++ b/src/Tomato/Data/Message.hs
@@ -0,0 +1,81 @@
+{-# LANGUAGE DeriveGeneric #-}
+module Tomato.Data.Message
+ ( InMessage (..)
+ , GMIUrl (..)
+ , OutMessage (..)
+ ) where
+
+import RIO
+
+import Data.Aeson ((.:), (.=))
+import Network.HTTP.Req
+ ( Url
+ , Scheme (Https)
+ , useHttpsURI
+ , renderUrl
+ )
+
+import qualified Data.Aeson as Ae
+import qualified Data.Aeson.Types as Ae
+import qualified RIO.Vector as V
+import qualified Text.URI as URI
+
+data InMessage = InMessage
+ { hasAttach :: !Bool
+ , groupId :: !Text
+ , isUser :: !Bool
+ , text :: !Text
+ } deriving (Show, Generic)
+
+instance NFData InMessage
+
+instance Ae.FromJSON InMessage where
+ parseJSON = Ae.withObject "InMessage" $ \o -> InMessage
+ <$> (o .: "attachments" >>= Ae.withArray "attachments" (pure . not . null))
+ <*> o .: "group_id"
+ <*> ((==) ("user" :: Text) <$> o .: "sender_type")
+ <*> o .: "text"
+
+
+newtype GMIUrl = GMIUrl
+ { unGMIUrl :: Url Https
+ } deriving Show
+
+instance Ae.FromJSON GMIUrl where
+ parseJSON = Ae.withObject "payload" $ \o -> do
+ p <- o .: "payload"
+ u <- p .: "url"
+ GMIUrl <$> toUrl u
+ where
+ toUrl :: Text -> Ae.Parser (Url Https)
+ toUrl t = maybe mzero pure $ fmap fst $ useHttpsURI =<< URI.mkURI t
+
+data OutMessage = OutMessage
+ { image :: !GMIUrl
+ } deriving Show
+
+instance Ae.ToJSON OutMessage where
+ toJSON om = Ae.object
+ [ "attachments" .=
+ ( Ae.Array $ V.singleton attach )
+ -- , "bot_id" .= botId
+ ]
+ where
+ attach :: Ae.Value
+ attach = Ae.object
+ [ "type" .= ("image" :: Text)
+ , "url" .= url
+ ]
+ url :: Text
+ url = renderUrl $ unGMIUrl $ image om
+
+ -- {
+ -- "bot_id" : "j5abcdefg",
+ -- "text" : "Hello world",
+ -- "attachments" : [
+ -- {
+ -- "type" : "image",
+ -- "url" : "https://i.groupme.com/somethingsomething.large"
+ -- }
+ -- ]
+-- }
diff --git a/src/Tomato/Data/Tomato.hs b/src/Tomato/Data/Tomato.hs
new file mode 100644
index 0000000..4b75adf
--- /dev/null
+++ b/src/Tomato/Data/Tomato.hs
@@ -0,0 +1,70 @@
+module Tomato.Data.Tomato
+ ( Links (..)
+ , Tomato (..)
+ , Urls (..)
+ ) where
+
+import RIO
+
+import Data.Aeson ((.:))
+import Network.HTTP.Req (Url, Scheme (Https), useHttpsURI)
+
+import qualified Data.Aeson as Ae
+import qualified Data.Aeson.Types as Ae
+import qualified Text.URI as URI
+
+
+data Tomato = Tomato
+ { id :: !Text
+ , width :: !Word
+ , height :: !Word
+ , color :: !Text
+ , blur_hash :: !Text
+ , description :: !Text
+ , urls :: !Urls
+ , links :: !Links
+ } deriving Show
+
+instance Ae.FromJSON Tomato where
+ parseJSON = Ae.withObject "Tomato" $ \o -> Tomato
+ <$> o .: "id"
+ <*> o .: "width"
+ <*> o .: "height"
+ <*> o .: "color"
+ <*> o .: "blur_hash"
+ <*> o .: "description"
+ <*> o .: "urls"
+ <*> o .: "links"
+
+data Links = Links
+ { self :: !(Url Https)
+ , html :: !(Url Https)
+ , download :: !(Url Https)
+ , download_location :: !(Url Https)
+ } deriving Show
+
+instance Ae.FromJSON Links where
+ parseJSON = Ae.withObject "Links" $ \o -> Links
+ <$> (o .: "self" >>= toUrl)
+ <*> (o .: "html" >>= toUrl)
+ <*> (o .: "download" >>= toUrl)
+ <*> (o .: "download_location" >>= toUrl)
+
+data Urls = Urls
+ { raw :: !(Url Https)
+ , full :: !(Url Https)
+ , regular :: !(Url Https)
+ , small :: !(Url Https)
+ , thumb :: !(Url Https)
+ } deriving Show
+
+instance Ae.FromJSON Urls where
+ parseJSON = Ae.withObject "Urls" $ \o -> Urls
+ <$> (o .: "raw" >>= toUrl)
+ <*> (o .: "full" >>= toUrl)
+ <*> (o .: "regular" >>= toUrl)
+ <*> (o .: "small" >>= toUrl)
+ <*> (o .: "thumb" >>= toUrl)
+
+toUrl :: Text -> Ae.Parser (Url Https)
+toUrl t = maybe mzero pure $ fmap fst $ useHttpsURI =<< URI.mkURI t