diff options
| author | Gregor Kleen <gkleen@yggdrasil.li> | 2025-11-21 14:51:23 +0100 |
|---|---|---|
| committer | Gregor Kleen <gkleen@yggdrasil.li> | 2025-11-21 14:51:23 +0100 |
| commit | 4c46e82769847177f6582447f027a56f9b555fd0 (patch) | |
| tree | c797e1ecf691e8e05399d83ad3042c52ac08111e /overlays/spm/server/Spm | |
| parent | 4341d2d9b0e5d57adf676bfad3d39cefdf7eca6f (diff) | |
| download | nixos-4c46e82769847177f6582447f027a56f9b555fd0.tar nixos-4c46e82769847177f6582447f027a56f9b555fd0.tar.gz nixos-4c46e82769847177f6582447f027a56f9b555fd0.tar.bz2 nixos-4c46e82769847177f6582447f027a56f9b555fd0.tar.xz nixos-4c46e82769847177f6582447f027a56f9b555fd0.zip | |
...
Diffstat (limited to 'overlays/spm/server/Spm')
| -rw-r--r-- | overlays/spm/server/Spm/Server.hs | 7 | ||||
| -rw-r--r-- | overlays/spm/server/Spm/Server/Ctx.hs | 3 | ||||
| -rw-r--r-- | overlays/spm/server/Spm/Server/Database.hs | 9 |
3 files changed, 9 insertions, 10 deletions
diff --git a/overlays/spm/server/Spm/Server.hs b/overlays/spm/server/Spm/Server.hs index 8e7f8786..dc334729 100644 --- a/overlays/spm/server/Spm/Server.hs +++ b/overlays/spm/server/Spm/Server.hs | |||
| @@ -1,3 +1,5 @@ | |||
| 1 | {-# OPTIONS_GHC -Wno-orphans #-} | ||
| 2 | |||
| 1 | {-# LANGUAGE OverloadedStrings #-} | 3 | {-# LANGUAGE OverloadedStrings #-} |
| 2 | 4 | ||
| 3 | module Spm.Server | 5 | module Spm.Server |
| @@ -24,7 +26,6 @@ import Data.Attoparsec.Text | |||
| 24 | import qualified Data.ByteString.Lazy as LBS | 26 | import qualified Data.ByteString.Lazy as LBS |
| 25 | 27 | ||
| 26 | import GHC.Generics (Generic) | 28 | import GHC.Generics (Generic) |
| 27 | import Type.Reflection (Typeable) | ||
| 28 | 29 | ||
| 29 | import Control.Applicative | 30 | import Control.Applicative |
| 30 | import Control.Monad | 31 | import Control.Monad |
| @@ -101,7 +102,7 @@ hSslClientSDn = "SSL-Client-S-DN" | |||
| 101 | data SSLClientVerify | 102 | data SSLClientVerify |
| 102 | = SSLClientVerifySuccess | 103 | = SSLClientVerifySuccess |
| 103 | | SSLClientVerifyOther Text | 104 | | SSLClientVerifyOther Text |
| 104 | deriving (Eq, Ord, Read, Show, Generic, Typeable) | 105 | deriving (Eq, Ord, Read, Show, Generic) |
| 105 | instance FromHttpApiData SSLClientVerify where | 106 | instance FromHttpApiData SSLClientVerify where |
| 106 | parseUrlPiece = (left Text.pack .) . parseOnly $ p <* endOfInput | 107 | parseUrlPiece = (left Text.pack .) . parseOnly $ p <* endOfInput |
| 107 | where | 108 | where |
| @@ -163,7 +164,7 @@ data ServerCtxError | |||
| 163 | | ServerCtxNoCredentialsDirectory | 164 | | ServerCtxNoCredentialsDirectory |
| 164 | | ServerCtxJwkSetDecodeError String | 165 | | ServerCtxJwkSetDecodeError String |
| 165 | | ServerCtxJwkSetEmpty | 166 | | ServerCtxJwkSetEmpty |
| 166 | deriving stock (Eq, Ord, Read, Show, Generic, Typeable) | 167 | deriving stock (Eq, Ord, Read, Show, Generic) |
| 167 | deriving anyclass (Exception) | 168 | deriving anyclass (Exception) |
| 168 | 169 | ||
| 169 | mkSpmApp :: (MonadUnliftIO m, MonadThrow m) => m Application | 170 | mkSpmApp :: (MonadUnliftIO m, MonadThrow m) => m Application |
diff --git a/overlays/spm/server/Spm/Server/Ctx.hs b/overlays/spm/server/Spm/Server/Ctx.hs index 18452a0a..1d228043 100644 --- a/overlays/spm/server/Spm/Server/Ctx.hs +++ b/overlays/spm/server/Spm/Server/Ctx.hs | |||
| @@ -11,7 +11,6 @@ import Database.Persist.Postgresql | |||
| 11 | import UnliftIO.Pool | 11 | import UnliftIO.Pool |
| 12 | import Control.Lens.TH | 12 | import Control.Lens.TH |
| 13 | 13 | ||
| 14 | import Type.Reflection (Typeable) | ||
| 15 | import GHC.Generics (Generic) | 14 | import GHC.Generics (Generic) |
| 16 | 15 | ||
| 17 | 16 | ||
| @@ -19,6 +18,6 @@ data ServerCtx = ServerCtx | |||
| 19 | { _sctxSqlPool :: Pool SqlBackend | 18 | { _sctxSqlPool :: Pool SqlBackend |
| 20 | , _sctxInstanceId :: UUID | 19 | , _sctxInstanceId :: UUID |
| 21 | , _sctxJwkSet :: JWKSet | 20 | , _sctxJwkSet :: JWKSet |
| 22 | } deriving (Generic, Typeable) | 21 | } deriving (Generic) |
| 23 | makeLenses ''ServerCtx | 22 | makeLenses ''ServerCtx |
| 24 | 23 | ||
diff --git a/overlays/spm/server/Spm/Server/Database.hs b/overlays/spm/server/Spm/Server/Database.hs index 3156e920..4405452f 100644 --- a/overlays/spm/server/Spm/Server/Database.hs +++ b/overlays/spm/server/Spm/Server/Database.hs | |||
| @@ -13,7 +13,6 @@ import Database.Persist.Sql | |||
| 13 | import Database.Persist.TH | 13 | import Database.Persist.TH |
| 14 | 14 | ||
| 15 | import GHC.Generics (Generic) | 15 | import GHC.Generics (Generic) |
| 16 | import Type.Reflection (Typeable) | ||
| 17 | 16 | ||
| 18 | import Data.Text (Text) | 17 | import Data.Text (Text) |
| 19 | 18 | ||
| @@ -33,22 +32,22 @@ import Web.HttpApiData | |||
| 33 | 32 | ||
| 34 | newtype MailMailbox = MailMailbox | 33 | newtype MailMailbox = MailMailbox |
| 35 | { unMailMailbox :: CI Text | 34 | { unMailMailbox :: CI Text |
| 36 | } deriving stock (Eq, Ord, Read, Show, Generic, Typeable) | 35 | } deriving stock (Eq, Ord, Read, Show, Generic) |
| 37 | deriving newtype (PersistField, PersistFieldSql) | 36 | deriving newtype (PersistField, PersistFieldSql) |
| 38 | makeWrapped ''MailMailbox | 37 | makeWrapped ''MailMailbox |
| 39 | newtype MailLocal = MailLocal | 38 | newtype MailLocal = MailLocal |
| 40 | { unMailLocal :: CI Text | 39 | { unMailLocal :: CI Text |
| 41 | } deriving stock (Eq, Ord, Read, Show, Generic, Typeable) | 40 | } deriving stock (Eq, Ord, Read, Show, Generic) |
| 42 | deriving newtype (PersistField, PersistFieldSql) | 41 | deriving newtype (PersistField, PersistFieldSql) |
| 43 | makeWrapped ''MailLocal | 42 | makeWrapped ''MailLocal |
| 44 | newtype MailExtension = MailExtension | 43 | newtype MailExtension = MailExtension |
| 45 | { unMailExtension :: CI Text | 44 | { unMailExtension :: CI Text |
| 46 | } deriving stock (Eq, Ord, Read, Show, Generic, Typeable) | 45 | } deriving stock (Eq, Ord, Read, Show, Generic) |
| 47 | deriving newtype (PersistField, PersistFieldSql) | 46 | deriving newtype (PersistField, PersistFieldSql) |
| 48 | makeWrapped ''MailExtension | 47 | makeWrapped ''MailExtension |
| 49 | newtype MailDomain = MailDomain | 48 | newtype MailDomain = MailDomain |
| 50 | { unMailDomain :: CI Text | 49 | { unMailDomain :: CI Text |
| 51 | } deriving stock (Eq, Ord, Read, Show, Generic, Typeable) | 50 | } deriving stock (Eq, Ord, Read, Show, Generic) |
| 52 | deriving newtype (PersistField, PersistFieldSql) | 51 | deriving newtype (PersistField, PersistFieldSql) |
| 53 | makeWrapped ''MailDomain | 52 | makeWrapped ''MailDomain |
| 54 | 53 | ||
