diff options
Diffstat (limited to 'overlays/spm/lib')
| -rw-r--r-- | overlays/spm/lib/Spm/Api.hs | 19 |
1 files changed, 17 insertions, 2 deletions
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 @@ | |||
| 2 | 2 | ||
| 3 | module Spm.Api | 3 | module Spm.Api |
| 4 | ( SpmStyle(..), _SpmWords, _SpmConsonants | 4 | ( SpmStyle(..), _SpmWords, _SpmConsonants |
| 5 | , SpmMailbox | 5 | , SpmMailbox, SpmDomain |
| 6 | , SpmApi, spmApi | 6 | , SpmApi, spmApi |
| 7 | ) where | 7 | ) where |
| 8 | 8 | ||
| @@ -30,6 +30,8 @@ import Crypto.JWT.Instances () | |||
| 30 | import Data.UUID (UUID) | 30 | import Data.UUID (UUID) |
| 31 | import Data.UUID.Instances () | 31 | import Data.UUID.Instances () |
| 32 | 32 | ||
| 33 | import qualified Data.Aeson as JSON | ||
| 34 | |||
| 33 | -- import Data.Aeson (ToJSON, FromJSON) | 35 | -- import Data.Aeson (ToJSON, FromJSON) |
| 34 | 36 | ||
| 35 | 37 | ||
| @@ -50,8 +52,20 @@ instance FromHttpApiData SpmStyle where | |||
| 50 | 52 | ||
| 51 | newtype SpmMailbox = SpmMailbox { unSpmMailbox :: CI Text } | 53 | newtype SpmMailbox = SpmMailbox { unSpmMailbox :: CI Text } |
| 52 | deriving stock (Eq, Ord, Read, Show, Generic, Typeable) | 54 | deriving stock (Eq, Ord, Read, Show, Generic, Typeable) |
| 53 | deriving newtype (MimeRender JSON, MimeRender PlainText) | 55 | deriving newtype (MimeRender PlainText) |
| 54 | makeWrapped ''SpmMailbox | 56 | makeWrapped ''SpmMailbox |
| 57 | |||
| 58 | instance MimeRender JSON SpmMailbox where | ||
| 59 | mimeRender p mbox = mimeRender p $ JSON.object [ "mailbox" JSON..= unSpmMailbox mbox ] | ||
| 60 | |||
| 61 | newtype SpmDomain = SpmDomain { unSpmDomain :: CI Text } | ||
| 62 | deriving stock (Eq, Ord, Read, Show, Generic, Typeable) | ||
| 63 | deriving newtype (MimeRender PlainText) | ||
| 64 | makeWrapped ''SpmDomain | ||
| 65 | |||
| 66 | instance MimeRender JSON SpmDomain where | ||
| 67 | mimeRender p dom = mimeRender p $ JSON.object [ "domain" JSON..= unSpmDomain dom ] | ||
| 68 | |||
| 55 | -- newtype SpmLocal = SpmLocal | 69 | -- newtype SpmLocal = SpmLocal |
| 56 | -- { unSpmLocal :: CI Text | 70 | -- { unSpmLocal :: CI Text |
| 57 | -- } deriving stock (Eq, Ord, Read, Show, Generic, Typeable) | 71 | -- } deriving stock (Eq, Ord, Read, Show, Generic, Typeable) |
| @@ -79,6 +93,7 @@ makeWrapped ''SpmMailbox | |||
| 79 | -- ] | 93 | -- ] |
| 80 | 94 | ||
| 81 | type SpmApi = "whoami" :> Get '[PlainText, JSON] SpmMailbox | 95 | type SpmApi = "whoami" :> Get '[PlainText, JSON] SpmMailbox |
| 96 | :<|> "domain" :> Get '[PlainText, JSON] SpmDomain | ||
| 82 | :<|> "jwks.json" :> Get '[JSON] JWKSet | 97 | :<|> "jwks.json" :> Get '[JSON] JWKSet |
| 83 | :<|> "instance-id" :> Get '[PlainText, JSON, OctetStream] UUID | 98 | :<|> "instance-id" :> Get '[PlainText, JSON, OctetStream] UUID |
| 84 | :<|> "spm" :> "generate" :> QueryParam "style" SpmStyle :> Get '[PlainText, JSON, OctetStream] SignedJWT | 99 | :<|> "spm" :> "generate" :> QueryParam "style" SpmStyle :> Get '[PlainText, JSON, OctetStream] SignedJWT |
