{- Copyright 2017 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} {-# LANGUAGE DeriveGeneric, FlexibleInstances, FlexibleContexts, OverloadedStrings #-} {- | Main types for debug-me - - Note that changing types in ways that change the JSON serialization - changes debug-me's log format. -} module Types ( module Types, Val(..) ) where import Val import Memory import JSON import qualified Data.Text as T import Data.Time.Clock.POSIX -- | Things that the developer sees. data Seen = Seen { seenData :: Val } deriving (Show, Generic) instance DataSize Seen where dataSize = dataSize . seenData -- | Things that the developer enters. data Entered = Entered { enteredData :: Val , echoData :: Val -- ^ Data that is expected to be Seen, but has not been received -- at the time this was entered. } deriving (Show, Generic) instance DataSize Entered where dataSize e = dataSize (enteredData e) + dataSize (echoData e) -- | A message in the protocol. data Message a = ActivityMessage (Activity a) | ControlMessage Control deriving (Show, Generic) instance DataSize a => DataSize (Message a) where dataSize (ActivityMessage a) = dataSize a dataSize (ControlMessage c) = dataSize c -- | An activity (either Entered or Seen) with a pointer -- to a previous Activity, and the amount of time elapsed since the -- previous Activity. -- -- The Signature is over both the data in the activity, and its pointer. -- -- The Signature is included in the Hash of an Activity, -- which is why it's part of the Activity. data Activity a = Activity { activity :: a , prevActivity :: Maybe Hash -- ^ Pointer to previous activity Seen/Entered , prevEntered :: Maybe Hash -- ^ Pointer to previous activity Entered , elapsedTime :: ElapsedTime , activitySignature :: Signature } deriving (Show, Generic) -- | Used when a value has had its hashes erased for more efficient -- transfer over the wire. data MissingHashes a = MissingHashes a instance DataSize a => DataSize (Activity a) where dataSize a = dataSize (activity a) + maybe 0 dataSize (prevActivity a) + dataSize (elapsedTime a) + dataSize (activitySignature a) -- | A control message, which can be sent asynchronously. data Control = Control { control :: ControlAction , controlSignature :: Signature } deriving (Show, Generic) instance DataSize Control where dataSize c = dataSize (control c) + dataSize (controlSignature c) data ControlAction = EnteredRejected { enteredRejected :: Hash -- ^ Entered value that was rejected. , enteredLastAccepted :: Maybe Hash -- ^ The last Entered value that was accepted. } | SessionKey (PerhapsSigned PublicKey) ProtocolVersion -- ^ sent by user at start, and later by developer, -- to indicate their session key | SessionKeyAccepted PublicKey -- ^ sent by the user to in response to SessionKey | SessionKeyRejected PublicKey -- ^ sent by the user to in response to SessionKey | ChatMessage SenderName Val -- ^ sent by user or developer at any time deriving (Show, Generic) type ProtocolVersion = Val currentProtocolVersion :: ProtocolVersion currentProtocolVersion = Val "1" type SenderName = Val instance DataSize ControlAction where dataSize (EnteredRejected h1 h2) = dataSize h1 + maybe 0 dataSize h2 dataSize (SessionKey k v) = dataSize k + dataSize v dataSize (SessionKeyAccepted k) = dataSize k dataSize (SessionKeyRejected k) = dataSize k dataSize (ChatMessage s m) = dataSize s + dataSize m data Hash = Hash { hashMethod :: HashMethod , hashValue :: Val } deriving (Show, Generic, Eq) instance DataSize Hash where dataSize (Hash { hashMethod = SHA512 }) = 128 dataSize (Hash { hashMethod = SHA3 }) = 56 -- | We use SHA512. (SHA3 is included to future proof, and because it -- improves the generated JSON.) data HashMethod = SHA512 | SHA3 deriving (Show, Generic, Eq) type EmailAddress = T.Text data Signature = Ed25519Signature Val | OtherSignature Val -- ^ Not used, but included to future-proof the JSON format. deriving (Show, Generic) instance DataSize Signature where dataSize (Ed25519Signature v) = dataSize v dataSize (OtherSignature v) = dataSize v -- | A public key used for a debug-me session. data PublicKey = PublicKey Val deriving (Show, Generic, Eq) instance DataSize PublicKey where -- ed25519 public keys are 32 bytes dataSize (PublicKey _) = 32 -- | A value that may be gpg signed. data PerhapsSigned a = GpgSigned a GpgSig GpgKeyExport | UnSigned a deriving (Show, Generic, Eq) instance DataSize a => DataSize (PerhapsSigned a) where dataSize (GpgSigned a sig export) = dataSize a + dataSize sig + dataSize export dataSize (UnSigned a) = dataSize a -- | A signature made with a gpg key. newtype GpgSig = GpgSig Val deriving (Show, Generic, Eq) instance DataSize GpgSig where dataSize (GpgSig s) = dataSize s -- | An export of a gpg public key. newtype GpgKeyExport = GpgKeyExport Val deriving (Show, Generic, Eq) instance DataSize GpgKeyExport where dataSize (GpgKeyExport k) = dataSize k -- | Elapsed time in seconds. newtype ElapsedTime = ElapsedTime Double deriving (Show, Generic, Eq) mkElapsedTime :: POSIXTime -> POSIXTime -> ElapsedTime mkElapsedTime start end = ElapsedTime $ fromRational $ toRational (end - start) instance Monoid ElapsedTime where mempty = ElapsedTime 0 mappend (ElapsedTime a) (ElapsedTime b) = ElapsedTime (a+b) instance DataSize ElapsedTime where dataSize _ = 16 -- 128 bit Double instance ToJSON ElapsedTime instance FromJSON ElapsedTime data AnyMessage = User (Message Seen) | Developer (Message Entered) deriving (Show, Generic) instance DataSize AnyMessage where dataSize (User a) = dataSize a dataSize (Developer a) = dataSize a instance ToJSON AnyMessage where toJSON = genericToJSON sumOptions toEncoding = genericToEncoding sumOptions instance FromJSON AnyMessage where parseJSON = genericParseJSON sumOptions instance ToJSON Seen instance FromJSON Seen instance ToJSON Entered instance FromJSON Entered instance ToJSON (Activity Seen) instance FromJSON (Activity Seen) instance ToJSON (Activity Entered) instance FromJSON (Activity Entered) instance ToJSON Control instance FromJSON Control instance ToJSON Hash instance FromJSON Hash instance ToJSON HashMethod instance FromJSON HashMethod instance ToJSON PublicKey instance FromJSON PublicKey instance ToJSON GpgSig instance FromJSON GpgSig instance ToJSON GpgKeyExport instance FromJSON GpgKeyExport instance ToJSON (Message Seen) where toJSON = genericToJSON sumOptions toEncoding = genericToEncoding sumOptions instance FromJSON (Message Seen) where parseJSON = genericParseJSON sumOptions instance ToJSON (Message Entered) where toJSON = genericToJSON sumOptions toEncoding = genericToEncoding sumOptions instance FromJSON (Message Entered) where parseJSON = genericParseJSON sumOptions instance ToJSON Signature where toJSON = genericToJSON sumOptions toEncoding = genericToEncoding sumOptions instance FromJSON Signature where parseJSON = genericParseJSON sumOptions instance ToJSON ControlAction where toJSON = genericToJSON sumOptions toEncoding = genericToEncoding sumOptions instance FromJSON ControlAction where parseJSON = genericParseJSON sumOptions instance ToJSON (PerhapsSigned PublicKey) where toJSON = genericToJSON sumOptions toEncoding = genericToEncoding sumOptions instance FromJSON (PerhapsSigned PublicKey) where parseJSON = genericParseJSON sumOptions