{-# LANGUAGE DeriveGeneric, OverloadedStrings, FlexibleContexts, GeneralizedNewtypeDeriving #-}

module Ssb.Types.Message (
	Signature,
	Message(..),
	messageLink,
	AnyContent(..),
	contentType,
	parseMessage,
	narrowParse,
	PrivateContent(..),
	Post(..),
	Branch(..),
	Mentions(..),
	Mention(..),
	About(..),
	AboutImage(..),
	Contact(..),
	Vote(..),
	Pub(..),
	parseMessageType
) where

import Ssb.Types.Link
import Ssb.Types.Hash

import GHC.Generics
import Data.Aeson
import Data.Aeson.Types
import Data.Int (Int64)
import Data.Maybe
import Data.List
import Data.Char
import Control.Applicative
import qualified Data.Text as T
import qualified Data.Vector as V
import qualified Data.ByteString.Lazy as L

import Prelude hiding (sequence)

type Signature = String

data Message a = Message
	{ previous :: Maybe MessageLink
	, author :: FeedLink
	, sequence :: Int64
	, timestamp :: Float
	, hash :: HashType
	, content :: a
	, signature :: Signature
	} deriving (Show, Eq, Generic)

instance FromJSON a => FromJSON (Message a)

instance Functor Message where
	fmap f m = m { content = f (content m) }

messageLink :: Hashed (Message a) -> MessageLink
messageLink hm = MessageLink (hashOf hm)

-- | Parses a JSON formatted message, and accompanies it with the 
-- hash that was originally used for the message.
parseMessage :: FromJSON a => L.ByteString -> Maybe (Hashed (Message a))
parseMessage b = calcHashed b hash decode

-- | Parsing a Message AnyContent allows parsing the message envelope,
-- regardless of the type of content in the message.
data AnyContent = AnyContent { fromAnyContent :: Value }
	deriving (Show, Eq)

instance FromJSON AnyContent where
	parseJSON = pure . AnyContent

-- | Get the declared type of content in a Message AnyContent.
contentType :: Message AnyContent -> T.Text
contentType = fromMaybe ""
	. parseMaybe (withObject "AnyContent" (.: "type"))
	. fromAnyContent
	. content

-- | For best efficiency when the type of a message is not known,
-- first parse to a Message AnyContent, and then use this function
-- with `parseMaybe` or `parseEither` to try to further parse that
-- to different message types.
--
-- For example:
--
-- > Just somemsg = decode b :: Maybe Message AnyContent
-- > case parseMaybe narrowParse somemsg :: Maybe (Message Post) of
-- >   Just postmsg -> ...
-- >   Nothing -> case parseMaybe narrowParse somemsg :: Maybe (Message PrivateContent) of
-- >     Just privmsg -> ...
-- >     Nothing -> ...
narrowParse :: FromJSON a => Message AnyContent -> Parser (Message a)
narrowParse m = do
	c <- parseJSON (fromAnyContent (content m))
	return $ m { content = c }

-- | A message with encrypted content.
data PrivateContent = PrivateContent T.Text
	deriving (Show, Eq)

-- Any message that has a content that is a string, rather than a JSON
-- object, is an encrypted message.
instance FromJSON PrivateContent where
	parseJSON = withText "PrivateContent" (pure . PrivateContent)

-- | A post is a text-based message, for a public or private audience.
-- It can be a reply to other posts.
data Post = Post
	{ text :: T.Text
	, channel :: Maybe T.Text
	, root :: Maybe MessageLink
	, branch :: Maybe Branch
	, recps :: Maybe [FeedLink]
	, mentions :: Maybe Mentions
	} deriving (Show, Eq, Generic)

instance FromJSON Post where
	parseJSON = parseMessageType "post" (genericParseJSON defaultOptions)

-- | Link to the message in the thread that a Post replies to.
--
-- Generally there is only one link, but sometimes more than one.
newtype Branch = Branch { fromBranch :: [MessageLink] }
	deriving (Show, Eq, Monoid)

instance FromJSON Branch where
	parseJSON v@(String _) = Branch . (:[]) <$> parseJSON v
	parseJSON v@(Array _) = Branch <$> parseJSON v
	parseJSON invalid = typeMismatch "Branch" invalid

newtype Mentions = Mentions { fromMentions :: [Mention] }
	deriving (Show, Eq, Monoid)

-- | Sometimes it's an array of objects.
-- Sometimes there is no array, but a single object.
-- And sometimes the Mention contains an invalid Link; avoid failing on
-- those.
instance FromJSON Mentions where
	parseJSON v@(Object _) = pure $
		Mentions $ catMaybes [parseMaybe parseJSON v]
	parseJSON (Array v) = pure $
		Mentions $ mapMaybe (parseMaybe parseJSON) (V.toList v)
	parseJSON invalid = typeMismatch "Mentions" invalid

-- | A reference to other feeds, entities, or blobs that were mentioned in
-- a Post.
data Mention = Mention
	{ mentionLink :: Link
	, mentionName :: Maybe T.Text
	} deriving (Show, Eq, Generic)

instance FromJSON Mention where
	parseJSON = parseStrippingPrefix "mention"

-- | About-messages set attributes about someone or something.
-- They can be used to set a name or picture for users, files, or messages.
-- However, they're most commonly published about users.
data About = About
	{ about :: Link
	, name :: Maybe T.Text
	, image :: Maybe AboutImage
	, description :: Maybe T.Text
	} deriving (Show, Eq, Generic)

instance FromJSON About where
	parseJSON = parseMessageType "about" (genericParseJSON defaultOptions)

data AboutImage = AboutImage
	{ aboutImageLink :: BlobLink
	, aboutImageSize :: Maybe Int
	, aboutImageType :: Maybe T.Text
	, aboutImageWidth :: Maybe Int
	, aboutImageHeight :: Maybe Int
	} deriving (Show, Eq, Generic)

-- | AboutImage can be encoded as either a JSON object or as a string,
-- which is the BlobLink.
instance FromJSON AboutImage where
	parseJSON o@(Object _) = parseStrippingPrefix "aboutimage" o
	parseJSON s@(String _) = AboutImage
		<$> parseJSON s
		<*> pure Nothing
		<*> pure Nothing
		<*> pure Nothing
		<*> pure Nothing
	parseJSON invalid = typeMismatch "AboutImage" invalid

-- | Contact-messages determine who you are following or blocking.
data Contact = Contact
	{ contact :: FeedLink
	, following :: Bool
	, blocking :: Bool
	} deriving (Show, Eq, Generic)

instance FromJSON Contact where
	parseJSON = parseMessageType "contact" $
		withObject "Contect" $ \o -> Contact
			<$> o .: "contact"
			<*> o .:? "following" .!= False
			<*> o .:? "blocking" .!= False

-- | Vote-messages signal approval about someone or something.
-- Votes can be on users, messages, or blobs.
data Vote = Vote
	{ voteLink :: Link
	, voteValue :: Int
	, voteExpression :: Maybe T.Text
	} deriving (Show, Eq, Generic)

instance FromJSON Vote where
	parseJSON = parseMessageType "vote" $ withObject "Vote" $ \o -> do
		-- For some reason the JSON wraps the vote in another object.
		v <- o .: "vote"
		Vote
			<$> v .: "link"
			<*> (v .: "value" <|> stringvalue v)
			<*> v .:? "expression"
	  where
		-- It's not uncommon for the value to be a string containing a
		-- number, although it's supposed to be a plain number.
		stringvalue v = do
			s <- v .: "value" :: Parser T.Text
			case s of
				"1" -> return 1
				"0" -> return 0
				"-1" -> return (-1)
				_ -> fail "unknown vote value"

-- Pub-messages announce the address, port, and public key of pubs.
-- They are automatically published by Scuttlebot after successfully
-- using an invite to a pub.
data Pub = Pub
	{ pubHost :: T.Text
	, pubPort :: Int
	, pubKey :: FeedLink
	} deriving (Show, Eq, Generic)

instance FromJSON Pub where
	parseJSON = parseMessageType "pub" $ withObject "Pub" $ \o -> do
		-- For some reason the JSON wraps the pub in another object.
		v <- o .: "address"
		parseStrippingPrefix "pub" v

-- | Parse the content of a message using the provided Parser,
-- which will typically be genericParseJSON defaultOptions.
--
-- The "type" field must contain the specified Text for the parse to succeed.
parseMessageType :: T.Text -> (Value -> Parser a) -> Value -> Parser a
parseMessageType ty parser v@(Object o) = do
	t <- o .: "type"
	if t == ty
		then parser v
		else fail $ "wrong message type " ++ T.unpack t ++ " (expected " ++ T.unpack ty ++ ")"
parseMessageType ty _ invalid = typeMismatch (T.unpack ty) invalid

-- | Parse, stripping a common prefix from the haskell record names.
parseStrippingPrefix :: (Generic a, GFromJSON Zero (Rep a)) => String -> Value -> Parser a
parseStrippingPrefix prefix = 
	genericParseJSON $ defaultOptions { fieldLabelModifier = f }
  where
  	f s = fromMaybe s $ stripPrefix prefix $ map toLower s