From 3bf77d7c3144b16d55f35998dddc0d67bb8c17b2 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Tue, 7 Jun 2022 21:38:00 +0200
Subject: ...

---
 overlays/spm/lib/Spm/Api.hs | 19 +++++++++++++++++--
 1 file changed, 17 insertions(+), 2 deletions(-)

(limited to 'overlays/spm/lib')

diff --git a/overlays/spm/lib/Spm/Api.hs b/overlays/spm/lib/Spm/Api.hs
index 14acfac4..c44a7951 100644
--- a/overlays/spm/lib/Spm/Api.hs
+++ b/overlays/spm/lib/Spm/Api.hs
@@ -2,7 +2,7 @@
 
 module Spm.Api
   ( SpmStyle(..), _SpmWords, _SpmConsonants
-  , SpmMailbox
+  , SpmMailbox, SpmDomain
   , SpmApi, spmApi
   ) where
 
@@ -30,6 +30,8 @@ import Crypto.JWT.Instances ()
 import Data.UUID (UUID)
 import Data.UUID.Instances ()
 
+import qualified Data.Aeson as JSON
+
 -- import Data.Aeson (ToJSON, FromJSON)
 
 
@@ -50,8 +52,20 @@ instance FromHttpApiData SpmStyle where
 
 newtype SpmMailbox = SpmMailbox { unSpmMailbox :: CI Text }
   deriving stock (Eq, Ord, Read, Show, Generic, Typeable)
-  deriving newtype (MimeRender JSON, MimeRender PlainText)
+  deriving newtype (MimeRender PlainText)
 makeWrapped ''SpmMailbox
+
+instance MimeRender JSON SpmMailbox where
+  mimeRender p mbox = mimeRender p $ JSON.object [ "mailbox" JSON..= unSpmMailbox mbox ]
+  
+newtype SpmDomain = SpmDomain { unSpmDomain :: CI Text }
+  deriving stock (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving newtype (MimeRender PlainText)
+makeWrapped ''SpmDomain
+
+instance MimeRender JSON SpmDomain where
+  mimeRender p dom = mimeRender p $ JSON.object [ "domain" JSON..= unSpmDomain dom ]
+
 -- newtype SpmLocal = SpmLocal
 --   { unSpmLocal :: CI Text
 --   } deriving stock (Eq, Ord, Read, Show, Generic, Typeable)
@@ -79,6 +93,7 @@ makeWrapped ''SpmMailbox
 --     ]
 
 type SpmApi = "whoami" :> Get '[PlainText, JSON] SpmMailbox
+         :<|> "domain" :> Get '[PlainText, JSON] SpmDomain
          :<|> "jwks.json" :> Get '[JSON] JWKSet
          :<|> "instance-id" :> Get '[PlainText, JSON, OctetStream] UUID
          :<|> "spm" :> "generate" :> QueryParam "style" SpmStyle :> Get '[PlainText, JSON, OctetStream] SignedJWT
-- 
cgit v1.2.3