{- Copyright 2017 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU AGPL version 3 or higher.
 -}

{-# LANGUAGE DeriveGeneric, DataKinds, MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts, UndecidableInstances #-}
{-# LANGUAGE OverloadedStrings #-}

{- | Protocol buffers serialization for the debug-me wire protocol.
 - 
 - The message types in here define protocol buffers, so should be changed
 - with care. These messages correspond to the main data types in the Types
 - module.
 -
 - Note that the type level numbers used with fields should never be
 - changed.
 -}

module ProtocolBuffers where

import qualified Types as T
import Val

import Data.ProtocolBuffers
import GHC.Generics (Generic)
import qualified Data.ByteString as B
import Data.Monoid
import Prelude

data SeenP = SeenP
	{ seenDataP :: Required 1 (Value B.ByteString)
	}
	deriving (Generic)

data EnteredP = EnteredP
	{ enteredDataP :: Required 2 (Value B.ByteString)
	, echoDataP :: Required 3 (Value B.ByteString)
	}
	deriving (Generic)

data MessageP a
	= ActivityMessageP
		{ activityMessageP :: Required 4 (Message (ActivityP a)) }
	| ControlMessageP
		{ controlMessageP :: Required 5 (Message ControlP) }
	deriving (Generic)

data ActivityP a = ActivityP
	{ activityP :: Required 6 (Message a)
	, elapsedTimeP :: Required 8 (Message ElapsedTimeP)
	, activitySignatureP :: Required 9 (Message SignatureP)
	}
	deriving (Generic)

data ControlP = ControlP
	{ controlP :: Required 10 (Message ControlActionP)
	, controlSignatureP ::Required 11 (Message SignatureP)
	}
	deriving (Generic)

data ControlActionP
	= EnteredRejectedP
		{ enteredRejectedP :: Required 12 (Message HashP)
		, enteredLastAcceptedP :: Optional 13 (Message HashP)
		}
	| SessionKeyP
		{ sessionKeyP :: Required 14 (Message (PerhapsSignedP PublicKeyP)) }
	| SessionKeyAcceptedP
		{ sessionKeyAcceptedP :: Required 15 (Message PublicKeyP) }
	| SessionKeyRejectedP
		{ sessionKeyRejectedP :: Required 16 (Message PublicKeyP) }
	| ChatMessageP
		{ chatMessageSenderName :: Required 17 (Value B.ByteString)
		, chatMessage :: Required 18 (Value B.ByteString)
		}
	deriving (Generic)

data SignatureP
	= Ed25519SignatureP
		{ ed25519SignatureP :: Required 19 (Value B.ByteString) }
	| OtherSignatureP
		{ otherSignatureP :: Required 20 (Value B.ByteString) }
	deriving (Generic)

data PublicKeyP = PublicKeyP 
	{ mkPublicKeyP :: Required 21 (Value B.ByteString) }
	deriving (Generic)

data PerhapsSignedP a
	= GpgSignedP
		{ gpgSignedValP :: Required 22 (Message a)
		, gpgSigP :: Required 23 (Message GpgSigP)
		}
	| UnSignedP
		{ mkUnSignedP :: Required 24 (Message a )
		}
	deriving (Generic)

data GpgSigP = GpgSigP
	{ mkGpgSigP :: Required 25 (Value B.ByteString) }
	deriving (Generic)

data ElapsedTimeP = ElapsedTimeP
	{ mkElapsedTimeP :: Required 26 (Value Double) }
	deriving (Generic)

data AnyMessageP
	= UserP { mkUserP :: Required 27 (Message (MessageP SeenP)) }
	| DeveloperP { mkDeveloperP :: Required 28 (Message (MessageP EnteredP)) }
	deriving (Generic)

data HashP = HashP
	{ hashMethodP :: Required 29 (Message HashMethodP)
	, hashValueP :: Required 30 (Value B.ByteString)
	}
	deriving (Generic)

data HashMethodP
	= SHA512P { mkSHA512P :: Required 31 (Value Bool) }
	| SHA3P { mkSHA3P :: Required 32 (Value Bool) }
	deriving (Generic)

-- | Conversion between protocol buffer messages and debug-me's main Types.
class ProtocolBuffer p t where
	toProtocolBuffer :: t -> p
	fromProtocolBuffer :: p -> t

instance ProtocolBuffer SeenP T.Seen where
	toProtocolBuffer t = SeenP
		{ seenDataP = putField $ val $ T.seenData t
		}
	fromProtocolBuffer p =T.Seen
		{ T.seenData = Val $ getField $ seenDataP p
		}

instance ProtocolBuffer EnteredP T.Entered where
	toProtocolBuffer t = EnteredP
		{ enteredDataP = putField $ val $ T.enteredData t
		, echoDataP = putField $ val $ T.echoData t
		}
	fromProtocolBuffer p =T.Entered
		{ T.enteredData = Val $ getField $ enteredDataP p
		, T.echoData = Val $ getField $ echoDataP p
		}

instance ProtocolBuffer (ActivityP p) (T.Activity t) => ProtocolBuffer (MessageP p) (T.Message t) where
	toProtocolBuffer (T.ActivityMessage a) =
		ActivityMessageP (putField (toProtocolBuffer a))
	toProtocolBuffer (T.ControlMessage c) = 
		ControlMessageP (putField (toProtocolBuffer c))
	fromProtocolBuffer p@(ActivityMessageP {}) =
		T.ActivityMessage $ fromProtocolBuffer $
			getField $ activityMessageP p
	fromProtocolBuffer p@(ControlMessageP {}) =
		T.ControlMessage $ fromProtocolBuffer $
			getField $ controlMessageP p

instance ProtocolBuffer p t => ProtocolBuffer (ActivityP p) (T.Activity t) where
	toProtocolBuffer t = ActivityP
		{ activityP = putField $ toProtocolBuffer $ T.activity t
		, elapsedTimeP = putField $ toProtocolBuffer $ T.elapsedTime t
		, activitySignatureP = putField $ toProtocolBuffer $ T.activitySignature t
		}
	fromProtocolBuffer p = T.Activity
		{ T.activity = fromProtocolBuffer $ getField $ activityP p
		, T.prevActivity = Nothing -- not sent over the wire
		, T.prevEntered = Nothing -- not sent over the wire
		, T.elapsedTime = fromProtocolBuffer $ getField $ elapsedTimeP p
		, T.activitySignature = fromProtocolBuffer $ getField $ activitySignatureP p
		}

instance ProtocolBuffer ControlP T.Control where
	toProtocolBuffer t = ControlP
		{ controlP = putField $ toProtocolBuffer $ T.control t
		, controlSignatureP = putField $ toProtocolBuffer $ T.controlSignature t
		}
	fromProtocolBuffer p = T.Control
		{ T.control = fromProtocolBuffer $ getField $ controlP p
		, T.controlSignature = fromProtocolBuffer $ getField $ controlSignatureP p
		}

instance ProtocolBuffer ControlActionP T.ControlAction where
	toProtocolBuffer t@(T.EnteredRejected {}) = EnteredRejectedP
		{ enteredRejectedP = putField $ toProtocolBuffer $ T.enteredRejected t
		, enteredLastAcceptedP = putField $ toProtocolBuffer <$> T.enteredLastAccepted t
		}
	toProtocolBuffer (T.SessionKey t) = SessionKeyP
		{ sessionKeyP = putField $ toProtocolBuffer t }
	toProtocolBuffer (T.SessionKeyAccepted t) = SessionKeyAcceptedP
		{ sessionKeyAcceptedP = putField $ toProtocolBuffer t }
	toProtocolBuffer (T.SessionKeyRejected t) = SessionKeyRejectedP
		{ sessionKeyRejectedP = putField $ toProtocolBuffer t }
	toProtocolBuffer (T.ChatMessage sendername t) = ChatMessageP
		{ chatMessageSenderName = putField (val sendername)
		, chatMessage = putField (val t)
		}
	fromProtocolBuffer p@(EnteredRejectedP {}) = T.EnteredRejected
		{ T.enteredRejected = fromProtocolBuffer $ getField $ enteredRejectedP p
		, T.enteredLastAccepted = fromProtocolBuffer <$> getField (enteredLastAcceptedP p)
		}
	fromProtocolBuffer p@(SessionKeyP {}) = T.SessionKey $
		fromProtocolBuffer $ getField $ sessionKeyP p
	fromProtocolBuffer p@(SessionKeyAcceptedP {}) = T.SessionKeyAccepted $
		fromProtocolBuffer $ getField $ sessionKeyAcceptedP p
	fromProtocolBuffer p@(SessionKeyRejectedP {}) = T.SessionKeyRejected $
		fromProtocolBuffer $ getField $ sessionKeyRejectedP p
	fromProtocolBuffer p@(ChatMessageP {}) = T.ChatMessage
		(Val $ getField $ chatMessageSenderName p)
		(Val $ getField $ chatMessage p)

instance ProtocolBuffer SignatureP T.Signature where
	toProtocolBuffer (T.Ed25519Signature t) = Ed25519SignatureP
		{ ed25519SignatureP = putField $ val t }
	toProtocolBuffer (T.OtherSignature t) = OtherSignatureP
		{ otherSignatureP = putField $ val t }
	fromProtocolBuffer p@(Ed25519SignatureP {}) = T.Ed25519Signature $
		Val $ getField $ ed25519SignatureP p
	fromProtocolBuffer p@(OtherSignatureP {}) = T.OtherSignature $
		Val $ getField $ otherSignatureP p

instance ProtocolBuffer HashP T.Hash where
	toProtocolBuffer t = HashP
		{ hashMethodP = putField $ toProtocolBuffer $ T.hashMethod t
		, hashValueP = putField $ val $ T.hashValue t
		}
	fromProtocolBuffer p = T.Hash
		{ T.hashMethod = fromProtocolBuffer $ getField $ hashMethodP p
		, T.hashValue = Val $ getField $ hashValueP p
		}

instance ProtocolBuffer HashMethodP T.HashMethod where
	toProtocolBuffer T.SHA512 = SHA512P { mkSHA512P = putField True }
	toProtocolBuffer T.SHA3 = SHA3P { mkSHA3P = putField True }
	fromProtocolBuffer (SHA512P {}) = T.SHA512
	fromProtocolBuffer (SHA3P {}) = T.SHA3

instance ProtocolBuffer PublicKeyP T.PublicKey where
	toProtocolBuffer (T.PublicKey t) = PublicKeyP
		{ mkPublicKeyP = putField (val t) }
	fromProtocolBuffer p = T.PublicKey $ Val $ getField $ mkPublicKeyP p

instance ProtocolBuffer p t => ProtocolBuffer (PerhapsSignedP p) (T.PerhapsSigned t) where
	toProtocolBuffer (T.GpgSigned tv tg) = GpgSignedP
		{ gpgSignedValP = putField $ toProtocolBuffer tv
		, gpgSigP = putField $ toProtocolBuffer tg
		}
	toProtocolBuffer (T.UnSigned tv) = UnSignedP
		{ mkUnSignedP = putField $ toProtocolBuffer tv
		}
	fromProtocolBuffer p@(GpgSignedP {}) = T.GpgSigned
		(fromProtocolBuffer $ getField $ gpgSignedValP p)
		(fromProtocolBuffer $ getField $ gpgSigP p)
	fromProtocolBuffer p@(UnSignedP {}) = T.UnSigned
		(fromProtocolBuffer $ getField $ mkUnSignedP p)

instance ProtocolBuffer GpgSigP T.GpgSig where
	toProtocolBuffer (T.GpgSig t) = GpgSigP
		{ mkGpgSigP = putField ( val t) }
	fromProtocolBuffer p = T.GpgSig $ Val $ getField $ mkGpgSigP p

instance ProtocolBuffer ElapsedTimeP T.ElapsedTime where
	toProtocolBuffer (T.ElapsedTime t) = ElapsedTimeP
		{ mkElapsedTimeP = putField t }
	fromProtocolBuffer p = T.ElapsedTime $ getField $ mkElapsedTimeP p

instance ProtocolBuffer AnyMessageP T.AnyMessage where
	toProtocolBuffer (T.User t) = UserP
		{ mkUserP = putField $ toProtocolBuffer t }
	toProtocolBuffer (T.Developer t) = DeveloperP
		{ mkDeveloperP = putField $ toProtocolBuffer t }
	fromProtocolBuffer p@(UserP {}) = T.User $
		fromProtocolBuffer $ getField $ mkUserP p
	fromProtocolBuffer p@(DeveloperP {}) = T.Developer $
		fromProtocolBuffer $ getField $ mkDeveloperP p

instance Encode SeenP
instance Decode SeenP
instance Encode EnteredP
instance Decode EnteredP
instance Encode ControlP
instance Decode ControlP
instance Encode ControlActionP
instance Decode ControlActionP
instance Encode HashP
instance Decode HashP
instance Encode HashMethodP
instance Decode HashMethodP
instance Encode SignatureP
instance Decode SignatureP
instance Encode PublicKeyP
instance Decode PublicKeyP
instance Encode GpgSigP
instance Decode GpgSigP
instance Encode ElapsedTimeP
instance Decode ElapsedTimeP
instance Encode AnyMessageP
instance Decode AnyMessageP
instance Encode a => Encode (MessageP a)
-- This is why UndecidableInstances is needed. The need
-- for a Monoid instance is an implementation detail of
-- Data.ProtocolBuffers.
instance (Monoid (Message a), Generic a, Decode a) => Decode (MessageP a)
instance Encode a => Encode (ActivityP a)
instance (Monoid (Message a), Generic a, Decode a) => Decode (ActivityP a)
instance Encode a => Encode (PerhapsSignedP a)
instance (Monoid (Message a), Generic a, Decode a) => Decode (PerhapsSignedP a)