{-# LANGUAGE DeriveGeneric, OverloadedStrings #-}

module Ssb.Types.Key (
	PublicKey(..),
	parsePublicKey,
	parseEd25519PublicKey,
	formatPublicKey,
) where

import Data.ByteString
import Data.Text.Encoding (encodeUtf8, decodeUtf8)
import qualified Data.Text as T
import qualified Data.ByteString.Base64 as B64
import qualified Data.Aeson as Aeson
import qualified Crypto.Sign.Ed25519 as Ed
import GHC.Generics
import Data.Monoid

newtype PublicKey = Ed25519PublicKey { ed25519Key :: Ed.PublicKey }
	deriving (Eq, Ord, Generic)

instance Aeson.FromJSON PublicKey where
	parseJSON = Aeson.withText "PublicKey" $ \t ->
		case parsePublicKey (encodeUtf8 t) of
			Just pk -> return pk
			Nothing -> fail ("public key decode failure: " ++ T.unpack t)

instance Aeson.ToJSON PublicKey where
	toJSON = Aeson.String . decodeUtf8 . formatPublicKey

instance Show PublicKey where
	show  = T.unpack . decodeUtf8 . formatPublicKey

-- | Parses a SSB public key, which is base64 encoded, and has a prefix of
-- "@" and a suffix specifying the type of the key.
parsePublicKey :: ByteString -> Maybe PublicKey
parsePublicKey b = do
	b' <- stripPrefix "@" b
	case stripSuffix ".ed25519" b' of
		Just b'' -> parseEd25519PublicKey b''
		Nothing -> Nothing

-- | Decodes a SSB Ed25519 public key, which is base64 encoded.
parseEd25519PublicKey :: ByteString -> Maybe PublicKey
parseEd25519PublicKey b = Ed25519PublicKey <$> maybeEd25519PublicKey
  where
	decodedPublicKey = B64.decode b
	maybeEd25519PublicKey = either
		(const Nothing)
		(Just . Ed.PublicKey)
		decodedPublicKey

-- | Formats a SSB public key to a base64 encoded string with a prefix of
-- "@" and suffix specifying the type of the key.
formatPublicKey :: PublicKey -> ByteString
formatPublicKey (Ed25519PublicKey { ed25519Key = k }) =
	"@" <> B64.encode (Ed.unPublicKey k) <> ".ed25519"