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

module Types where

import Data.ByteString
import GHC.Generics (Generic)
import Data.Aeson
import Data.Aeson.Types
import qualified Codec.Binary.Base64 as B64
import qualified Data.Text as T
import qualified Data.Text.Encoding as T

-- | Things that the developer sees.
data Seen = Seen
	{ seenData :: Val
	}
	deriving (Show, Generic)

instance ToJSON Seen
instance FromJSON Seen

-- | 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 ToJSON Entered
instance FromJSON Entered

-- | An activity (either Entered or Seen) with a pointer
-- to the Activity before this one.
--
-- The Signature is over both the data in the activity, and its pointer.
data Activity a
	= Activity a HashPointer Signature
	| StartActivity a Signature
	deriving (Show, Generic)

instance ToJSON (Activity Seen)
instance FromJSON (Activity Seen)
instance ToJSON (Activity Entered)
instance FromJSON (Activity Entered)

activityContent :: Activity a -> a
activityContent (Activity a _ _) = a
activityContent (StartActivity a _) = a

data Signature = Signature
	{ signature :: Val
	}
	deriving (Show, Generic)

instance ToJSON Signature
instance FromJSON Signature

-- | A hash pointer to something that hashes to this value.
data HashPointer = HashPointer
	{ hashMethod :: HashMethod
	, hashValue :: Val
	}
	deriving (Show, Generic, Eq)

instance ToJSON HashPointer
instance FromJSON HashPointer

data HashMethod = SHA256
	deriving (Show, Generic, Eq)

instance ToJSON HashMethod
instance FromJSON HashMethod

-- | Newtype of ByteString so we can have JSON instances without orphans.
newtype Val = Val { val :: ByteString }
	deriving (Show, Generic, Eq, Monoid)

-- | JSON instances for Val, using base64 encoding.
instance ToJSON Val where
	toJSON (Val b) = object [ "b" .= b64 b ]
instance FromJSON Val where
	parseJSON (Object v) = Val <$> (unb64 =<< v .: "b")
	parseJSON invalid = typeMismatch "ByteString" invalid

b64 :: ByteString -> T.Text
b64 = T.decodeUtf8 . B64.encode

unb64 :: Monad m => T.Text -> m ByteString
unb64 t = either
	(\_ -> fail "bad base64 data")
	return
	( B64.decode $ T.encodeUtf8 t)