From fc6cf6169868e60c189e4b243330c3717ff159f3 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Thu, 26 May 2022 13:58:07 +0200 Subject: ... --- hosts/sif/default.nix | 4 +- hosts/surtr/email/default.nix | 13 +- hosts/surtr/email/spm/default.nix | 24 --- .../spm/lib/Data/CaseInsensitive/Instances.hs | 19 -- hosts/surtr/email/spm/lib/Data/UUID/Instances.hs | 18 -- hosts/surtr/email/spm/lib/Spm.hs | 5 - hosts/surtr/email/spm/lib/Spm/Api.hs | 40 ----- hosts/surtr/email/spm/package.yaml | 92 ---------- hosts/surtr/email/spm/provision/Spm/Provision.hs | 46 ----- .../email/spm/server/Crypto/JOSE/JWK/Instances.hs | 9 - .../spm/server/Data/CaseInsensitive/Instances.hs | 30 ---- .../surtr/email/spm/server/Data/UUID/Instances.hs | 31 ---- hosts/surtr/email/spm/server/Spm/Server.hs | 194 --------------------- .../surtr/email/spm/server/Spm/Server/Database.hs | 72 -------- hosts/surtr/email/spm/spm.nix | 28 --- 15 files changed, 11 insertions(+), 614 deletions(-) delete mode 100644 hosts/surtr/email/spm/default.nix delete mode 100644 hosts/surtr/email/spm/lib/Data/CaseInsensitive/Instances.hs delete mode 100644 hosts/surtr/email/spm/lib/Data/UUID/Instances.hs delete mode 100644 hosts/surtr/email/spm/lib/Spm.hs delete mode 100644 hosts/surtr/email/spm/lib/Spm/Api.hs delete mode 100644 hosts/surtr/email/spm/package.yaml delete mode 100644 hosts/surtr/email/spm/provision/Spm/Provision.hs delete mode 100644 hosts/surtr/email/spm/server/Crypto/JOSE/JWK/Instances.hs delete mode 100644 hosts/surtr/email/spm/server/Data/CaseInsensitive/Instances.hs delete mode 100644 hosts/surtr/email/spm/server/Data/UUID/Instances.hs delete mode 100644 hosts/surtr/email/spm/server/Spm/Server.hs delete mode 100644 hosts/surtr/email/spm/server/Spm/Server/Database.hs delete mode 100644 hosts/surtr/email/spm/spm.nix (limited to 'hosts') diff --git a/hosts/sif/default.nix b/hosts/sif/default.nix index a1220005..a79cfaa7 100644 --- a/hosts/sif/default.nix +++ b/hosts/sif/default.nix @@ -31,8 +31,8 @@ in { nvm0 = { device = "/dev/disk/by-uuid/fe641e81-0812-4181-a5f6-382ebba509bb"; bypassWorkqueues = true; }; nvm1 = { device = "/dev/disk/by-uuid/43df1ba8-1728-4193-8855-920a82d4494a"; bypassWorkqueues = true; }; }; - availableKernelModules = [ "drbg" "nvme" "xhci_pci" "usb_storage" "sd_mod" "rtsx_pci_sdmmc" ]; - kernelModules = [ "dm-raid" "dm-integrity" "dm-snapshot" "dm-thin-pool" ]; + availableKernelModules = [ "drbg" "nvme" "xhci_pci" "usb_storage" "sd_mod" "sr_mod" "rtsx_pci_sdmmc" ]; + kernelModules = [ "dm-raid" "dm-integrity" "dm-snapshot" "dm-thin-pool" "dm-mod" "dm-crypt" ]; }; blacklistedKernelModules = [ "nouveau" ]; diff --git a/hosts/surtr/email/default.nix b/hosts/surtr/email/default.nix index 947aa328..b952070b 100644 --- a/hosts/surtr/email/default.nix +++ b/hosts/surtr/email/default.nix @@ -21,8 +21,6 @@ let }; spmDomains = ["bouncy.email"]; - - spm = pkgs.callPackage ./spm {}; in { config = { nixpkgs.overlays = [ @@ -118,7 +116,14 @@ in { "reject_unverified_recipient" ]; unverified_recipient_reject_code = "550"; - unverified_recipient_reject_reason = "Recipient address rejected: undeliverable address"; + unverified_recipient_reject_reason = "Recipient address lookup failed"; + address_verify_map = "internal:address_verify_map"; + address_verify_positive_expire_time = "1h"; + address_verify_positive_refresh_time = "15m"; + address_verify_negative_expire_time = "15s"; + address_verify_negative_refresh_time = "5s"; + address_verify_cache_cleanup_interval = "5s"; + address_verify_poll_delay = "1s"; smtpd_relay_restrictions = [ "permit_mynetworks" @@ -643,7 +648,7 @@ in { systemd.services.spm = { serviceConfig = { Type = "notify"; - ExecStart = "${spm}/bin/spm-server"; + ExecStart = "${pkgs.spm}/bin/spm-server"; User = "spm"; Group = "spm"; diff --git a/hosts/surtr/email/spm/default.nix b/hosts/surtr/email/spm/default.nix deleted file mode 100644 index 75f99d8d..00000000 --- a/hosts/surtr/email/spm/default.nix +++ /dev/null @@ -1,24 +0,0 @@ -{ haskell, fetchFromGitHub }: - -let - # defaultPackages = (import ./stackage.nix {}); - # haskellPackages = defaultPackages // argumentPackages; - # haskellPackages = argumentPackages; - haskellPackages = haskell.packages.ghc922.override { - overrides = self: super: { - warp-systemd = haskell.lib.doJailbreak (super.warp-systemd.overrideAttrs (oldAttrs: { meta = oldAttrs.meta // { broken = false; }; })); - servant-server = super.servant-server.overrideAttrs (oldAttrs: { - patches = []; - }); - hpack = super.hpack.overrideAttrs (oldAttrs: rec { - version = "0.35.0"; - src = fetchFromGitHub { - owner = "sol"; - repo = "hpack"; - rev = "0.35.0"; - hash = "sha256-DMxCHwz9x2e4kSOIk1/qeW3aDFHw88LNW+4vXxDV9EI="; - }; - }); - }; - }; -in haskellPackages.callPackage ./spm.nix {} diff --git a/hosts/surtr/email/spm/lib/Data/CaseInsensitive/Instances.hs b/hosts/surtr/email/spm/lib/Data/CaseInsensitive/Instances.hs deleted file mode 100644 index 56cba98a..00000000 --- a/hosts/surtr/email/spm/lib/Data/CaseInsensitive/Instances.hs +++ /dev/null @@ -1,19 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} - -module Data.CaseInsensitive.Instances () where - -import Prelude - -import Data.CaseInsensitive (CI) -import qualified Data.CaseInsensitive as CI - -import Servant.API.ContentTypes - -import Data.Aeson - - -instance MimeRender PlainText a => MimeRender PlainText (CI a) where - mimeRender p = mimeRender p . CI.original - -instance ToJSON a => ToJSON (CI a) where - toJSON = toJSON . CI.original diff --git a/hosts/surtr/email/spm/lib/Data/UUID/Instances.hs b/hosts/surtr/email/spm/lib/Data/UUID/Instances.hs deleted file mode 100644 index 335937d8..00000000 --- a/hosts/surtr/email/spm/lib/Data/UUID/Instances.hs +++ /dev/null @@ -1,18 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} - -module Data.UUID.Instances () where - -import Prelude -import Data.UUID (UUID) -import qualified Data.UUID as UUID -import Servant.API.ContentTypes - - -instance MimeRender PlainText UUID where - mimeRender p = mimeRender p . UUID.toText - -instance MimeRender JSON UUID where - mimeRender p = mimeRender p . UUID.toText - -instance MimeRender OctetStream UUID where - mimeRender p = mimeRender p . UUID.toByteString diff --git a/hosts/surtr/email/spm/lib/Spm.hs b/hosts/surtr/email/spm/lib/Spm.hs deleted file mode 100644 index c7f7dfe5..00000000 --- a/hosts/surtr/email/spm/lib/Spm.hs +++ /dev/null @@ -1,5 +0,0 @@ -module Spm - ( module Spm.Api - ) where - -import Spm.Api diff --git a/hosts/surtr/email/spm/lib/Spm/Api.hs b/hosts/surtr/email/spm/lib/Spm/Api.hs deleted file mode 100644 index d9644222..00000000 --- a/hosts/surtr/email/spm/lib/Spm/Api.hs +++ /dev/null @@ -1,40 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - -module Spm.Api - ( SpmMailbox - , SpmApi, spmApi - ) where - -import Prelude - -import Servant.API - -import Data.Proxy (Proxy(..)) - -import Data.Text (Text) - -import GHC.Generics (Generic) -import Type.Reflection (Typeable) - -import Control.Lens.TH - -import Data.CaseInsensitive (CI) -import Data.CaseInsensitive.Instances () - -import Crypto.JOSE.JWK (JWKSet) - -import Data.UUID (UUID) -import Data.UUID.Instances () - - -newtype SpmMailbox = SpmMailbox { unSpmMailbox :: CI Text } - deriving stock (Eq, Ord, Read, Show, Generic, Typeable) - deriving newtype (MimeRender JSON, MimeRender PlainText) -makeWrapped ''SpmMailbox - -type SpmApi = "whoami" :> Get '[PlainText, JSON] SpmMailbox - :<|> ".well-known" :> "jwks.json" :> Get '[JSON] JWKSet - :<|> "instance-id" :> Get '[PlainText, JSON, OctetStream] UUID - -spmApi :: Proxy SpmApi -spmApi = Proxy diff --git a/hosts/surtr/email/spm/package.yaml b/hosts/surtr/email/spm/package.yaml deleted file mode 100644 index 4859e38c..00000000 --- a/hosts/surtr/email/spm/package.yaml +++ /dev/null @@ -1,92 +0,0 @@ -name: spm -version: 0.1.0 - -default-extensions: - - NoImplicitPrelude - - DerivingStrategies - - DeriveAnyClass - - DataKinds - - RecordWildCards - - TypeFamilies - - LambdaCase -other-extensions: - - OverloadedStrings - - TemplateHaskell - - QuasiQuotes - - UndecidableInstances -language: GHC2021 -license: AGPL-3.0-or-later -ghc-options: - - -Wall - - -Wmissing-home-modules - - -Wredundant-constraints - - -Widentities - - -Wincomplete-uni-patterns - - -Werror - - -fwarn-tabs - - -j -O - -library: - dependencies: - - base - - servant - - text - - lens - - case-insensitive - - aeson - - jose - - uuid - source-dirs: - - lib - -executables: - spm-server: - dependencies: - - spm - - base - - servant-server - - warp-systemd - - warp - - attoparsec - - text - - bytestring - - wai - - wai-extra - - lens - - case-insensitive - - http-types - - persistent - - persistent-postgresql - - uuid - - path-pieces - - transformers - - mtl - - resource-pool - - monad-logger - - mmorph - - unliftio-core - - http-api-data - - exceptions - - aeson - - filepath - - jose - - source-dirs: - - server - - main: Spm.Server - spm-provision: - dependencies: - - base - - jose - - uuid - - optparse-applicative - - text - - aeson - - bytestring - - lens - - source-dirs: - - provision - - main: Spm.Provision diff --git a/hosts/surtr/email/spm/provision/Spm/Provision.hs b/hosts/surtr/email/spm/provision/Spm/Provision.hs deleted file mode 100644 index ff18baa0..00000000 --- a/hosts/surtr/email/spm/provision/Spm/Provision.hs +++ /dev/null @@ -1,46 +0,0 @@ -module Spm.Provision - ( main - ) where - -import Prelude -import Options.Applicative -import Control.Monad - -import qualified Data.Text.IO as Text - -import qualified Data.UUID as UUID -import qualified Data.UUID.V4 as UUID - -import Crypto.JOSE.JWK - -import qualified Data.ByteString.Lazy.Char8 as CLBS -import qualified Data.Aeson as JSON - -import Control.Lens - - -data Command - = InstanceId - | JwkSet - deriving stock (Eq, Ord, Read, Show) - -cmdInstanceId :: IO () -cmdInstanceId = Text.putStrLn . UUID.toText =<< UUID.nextRandom - -cmdJwkSet :: IO () -cmdJwkSet = do - k' <- genJWK (OKPGenParam Ed25519) - kid <- UUID.nextRandom - let k = k' & jwkKid ?~ UUID.toText kid - & jwkUse ?~ Sig - & jwkKeyOps ?~ [Sign, Verify] - CLBS.putStrLn . JSON.encode . JWKSet $ pure k - -opts :: Parser (IO ()) -opts = subparser $ - command "instance-id" (info (pure cmdInstanceId) idm) - <> command "jwk-set" (info (pure cmdJwkSet) idm) - - -main :: IO () -main = join $ execParser (info opts idm) diff --git a/hosts/surtr/email/spm/server/Crypto/JOSE/JWK/Instances.hs b/hosts/surtr/email/spm/server/Crypto/JOSE/JWK/Instances.hs deleted file mode 100644 index 44a5cfe0..00000000 --- a/hosts/surtr/email/spm/server/Crypto/JOSE/JWK/Instances.hs +++ /dev/null @@ -1,9 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - -module Crypto.JOSE.JWK.Instances () where - -import Control.Lens.TH -import Crypto.JOSE.JWK - -makeWrapped ''JWKSet diff --git a/hosts/surtr/email/spm/server/Data/CaseInsensitive/Instances.hs b/hosts/surtr/email/spm/server/Data/CaseInsensitive/Instances.hs deleted file mode 100644 index 1f3f7a11..00000000 --- a/hosts/surtr/email/spm/server/Data/CaseInsensitive/Instances.hs +++ /dev/null @@ -1,30 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-# LANGUAGE OverloadedStrings #-} - -module Data.CaseInsensitive.Instances () where - -import Prelude -import Database.Persist -import Database.Persist.Sql - -import Data.CaseInsensitive (CI) -import qualified Data.CaseInsensitive as CI - -import Data.Text (Text) -import qualified Data.Text as Text -import qualified Data.Text.Encoding as Text - -import Control.Exception - - -instance PersistField (CI Text) where - toPersistValue = PersistLiteralEscaped . Text.encodeUtf8 . CI.original - fromPersistValue = \case - PersistText t -> Right $ CI.mk t - PersistLiteralEscaped bs -> case Text.decodeUtf8' bs of - Right t -> Right $ CI.mk t - Left err -> Left $ "Could not decode PersistLiteral as UTF-8: " <> Text.pack (displayException err) - o -> Left $ "Expected PersistText or PersistLiteral but got ‘" <> Text.pack (show o) <> "’" - -instance PersistFieldSql (CI Text) where - sqlType _ = SqlOther "citext" diff --git a/hosts/surtr/email/spm/server/Data/UUID/Instances.hs b/hosts/surtr/email/spm/server/Data/UUID/Instances.hs deleted file mode 100644 index b2268c96..00000000 --- a/hosts/surtr/email/spm/server/Data/UUID/Instances.hs +++ /dev/null @@ -1,31 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-# LANGUAGE OverloadedStrings #-} - -module Data.UUID.Instances () where - -import Prelude -import Database.Persist -import Database.Persist.Sql -import Data.UUID (UUID) -import qualified Data.UUID as UUID - -import qualified Data.ByteString.Char8 as CBS -import qualified Data.Text as Text - -import Web.PathPieces - - -instance PersistField UUID where - toPersistValue = PersistLiteralEscaped . CBS.pack . UUID.toString - fromPersistValue (PersistLiteralEscaped uuidB8) = - case UUID.fromString $ CBS.unpack uuidB8 of - Just uuid -> Right uuid - Nothing -> Left "Invalid UUID" - fromPersistValue v = Left $ "Expected PersistLiteral but got ‘" <> Text.pack (show v) <> "’" - -instance PersistFieldSql UUID where - sqlType _ = SqlOther "uuid" - -instance PathPiece UUID where - toPathPiece = Text.pack . UUID.toString - fromPathPiece = UUID.fromString . Text.unpack diff --git a/hosts/surtr/email/spm/server/Spm/Server.hs b/hosts/surtr/email/spm/server/Spm/Server.hs deleted file mode 100644 index 7690f51a..00000000 --- a/hosts/surtr/email/spm/server/Spm/Server.hs +++ /dev/null @@ -1,194 +0,0 @@ -{-# LANGUAGE OverloadedStrings, TemplateHaskell #-} - -module Spm.Server - ( main - ) where - -import Prelude -import Spm.Api -import Servant -import Servant.Server.Experimental.Auth - -import Network.Wai -import Network.Wai.Handler.Warp -import Network.Wai.Handler.Warp.Systemd -import Network.Wai.Middleware.RequestLogger - -import Network.HTTP.Types - -import Data.Text (Text) -import qualified Data.Text as Text -import qualified Data.Text.Encoding as Text -import Data.Attoparsec.Text - -import qualified Data.ByteString.Lazy as LBS - -import GHC.Generics (Generic) -import Type.Reflection (Typeable) - -import Control.Applicative -import Control.Monad -import Control.Arrow -import Control.Monad.IO.Class -import Control.Monad.IO.Unlift - -import Control.Lens hiding (Context) - -import qualified Data.CaseInsensitive as CI - -import System.IO - -import Spm.Server.Database - -import Database.Persist -import Database.Persist.Postgresql -import Data.Pool - -import Control.Monad.Trans.Reader (ReaderT, runReaderT) - -import Control.Monad.Logger - -import Control.Monad.Morph - -import System.Environment - -import Control.Monad.Catch (Exception, MonadThrow(..)) - -import Data.UUID (UUID) -import qualified Data.UUID as UUID - -import qualified Data.Aeson as JSON - -import System.FilePath ((), isRelative) - -import Crypto.JOSE.JWK hiding (Context) -import Crypto.JOSE.JWK.Instances () - -import Data.Maybe - - -hSslClientVerify, hSslClientSDn :: HeaderName -hSslClientVerify = "SSL-Client-Verify" -hSslClientSDn = "SSL-Client-S-DN" - - -data SSLClientVerify - = SSLClientVerifySuccess - | SSLClientVerifyOther Text - deriving (Eq, Ord, Read, Show, Generic, Typeable) -instance FromHttpApiData SSLClientVerify where - parseUrlPiece = (left Text.pack .) . parseOnly $ p <* endOfInput - where - p :: Parser SSLClientVerify - p = (SSLClientVerifySuccess <$ asciiCI "success") - <|> (SSLClientVerifyOther <$> takeText) - -type instance AuthServerData (AuthProtect "spm_mailbox") = MailMailbox - -type SpmServerApi = Header' '[Required, Strict] "SPM-Domain" MailDomain - :> AuthProtect "spm_mailbox" - :> SpmApi - -spmServerApi :: Proxy SpmServerApi -spmServerApi = Proxy - - -requestMailMailbox :: Request -> Either Text MailMailbox -requestMailMailbox req = do - clientVerify <- getHeader hSslClientVerify - clientSDN <- getHeader hSslClientSDn - - case clientVerify of - SSLClientVerifySuccess -> return () - o@(SSLClientVerifyOther _) -> Left $ "Expected “SSLClientVerifySuccess”, but got “" <> Text.pack (show o) <> "”" - spmMailbox <- left Text.pack $ parseOnly (asciiCI "CN=" *> (CI.mk <$> takeText) <* endOfInput) clientSDN - - return $ _Wrapped # spmMailbox - where - getHeader :: forall a. FromHttpApiData a => HeaderName -> Either Text a - getHeader hdrName = parseHeader <=< maybeToEither ("Missing “" <> Text.decodeUtf8 (CI.original hdrName) <> "”") . lookup hdrName $ requestHeaders req - - maybeToEither e = maybe (Left e) Right - -mailboxAuthHandler :: AuthHandler Request MailMailbox -mailboxAuthHandler = mkAuthHandler handler - where - throw401 msg = throwError $ err401 { errBody = LBS.fromStrict $ Text.encodeUtf8 msg } - handler = either throw401 return . requestMailMailbox - -mkSpmRequestLogger :: MonadIO m => m Middleware -mkSpmRequestLogger = liftIO $ mkRequestLogger loggerSettings - where - loggerSettings = defaultRequestLoggerSettings - { destination = Handle stderr - , outputFormat = ApacheWithSettings $ defaultApacheSettings - & setApacheUserGetter (preview (_Right . _Wrapped . to (Text.encodeUtf8. CI.original)) . requestMailMailbox) - & setApacheIPAddrSource FromFallback - } - -data ServerCtx = ServerCtx - { _sctxSqlPool :: Pool SqlBackend - , _sctxInstanceId :: UUID - , _sctxJwkSet :: JWKSet - } deriving (Generic, Typeable) -makeLenses ''ServerCtx - -type Handler' = ReaderT ServerCtx (LoggingT Handler) -type Server' api = ServerT api Handler' - -data ServerCtxError - = ServerCtxNoInstanceId | ServerCtxInvalidInstanceId - | ServerCtxJwkSetCredentialFileNotRelative - | ServerCtxNoCredentialsDirectory - | ServerCtxJwkSetDecodeError String - | ServerCtxJwkSetEmpty - deriving stock (Eq, Ord, Read, Show, Generic, Typeable) - deriving anyclass (Exception) - -mkSpmApp :: (MonadUnliftIO m, MonadThrow m) => m Application -mkSpmApp = do - requestLogger <- mkSpmRequestLogger - - connStr <- liftIO $ maybe mempty (Text.encodeUtf8 . Text.pack) <$> lookupEnv "PGCONNSTR" - _sctxInstanceId <- maybe (throwM ServerCtxInvalidInstanceId) return . UUID.fromString =<< maybe (throwM ServerCtxNoInstanceId) return =<< liftIO (lookupEnv "SPM_INSTANCE") - jwksetCredentialFile <- liftIO $ fromMaybe "spm-keys.json" <$> lookupEnv "SPM_KEYS_CREDENTIAL" - unless (isRelative jwksetCredentialFile) $ throwM ServerCtxJwkSetCredentialFileNotRelative - credentialsDir <- maybe (throwM ServerCtxNoCredentialsDirectory) return =<< liftIO (lookupEnv "CREDENTIALS_DIRECTORY") - _sctxJwkSet@(JWKSet jwks) <- either (throwM . ServerCtxJwkSetDecodeError) return =<< liftIO (JSON.eitherDecodeFileStrict' $ credentialsDir jwksetCredentialFile) - when (null jwks) $ throwM ServerCtxJwkSetEmpty - - runStderrLoggingT . withPostgresqlPool connStr 1 $ \_sctxSqlPool -> do - let - spmServerContext :: Context (AuthHandler Request MailMailbox ': '[]) - spmServerContext = mailboxAuthHandler :. EmptyContext - - spmServer' = spmServer - - logger <- askLoggerIO - return $ serveWithContextT spmServerApi spmServerContext ((runReaderT ?? ServerCtx{..}) . hoist (runLoggingT ?? logger)) spmServer' - & requestLogger - -spmSql :: ReaderT SqlBackend Handler' a -> Handler' a -spmSql act = do - sqlPool <- view sctxSqlPool - withResource sqlPool $ runReaderT act - -spmServer :: MailDomain -> MailMailbox -> Server' SpmApi -spmServer _dom mbox = whoami - :<|> jwkSet - :<|> instanceId - where - whoami = do - Entity _ Mailbox{mailboxIdent} <- maybe (throwError err404) return <=< spmSql . getBy $ UniqueMailbox mbox - return $ mailboxIdent ^. _Wrapped . re _Wrapped - - jwkSet = views sctxJwkSet $ over _Wrapped (^.. folded . asPublicKey . _Just) - - instanceId = view sctxInstanceId - -main :: IO () -main = runSystemdWarp systemdSettings warpSettings =<< mkSpmApp - where - systemdSettings = defaultSystemdSettings - & requireSocketActivation .~ True - warpSettings = defaultSettings diff --git a/hosts/surtr/email/spm/server/Spm/Server/Database.hs b/hosts/surtr/email/spm/server/Spm/Server/Database.hs deleted file mode 100644 index 09b4c67b..00000000 --- a/hosts/surtr/email/spm/server/Spm/Server/Database.hs +++ /dev/null @@ -1,72 +0,0 @@ -{-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, UndecidableInstances #-} - -module Spm.Server.Database - ( MailMailbox, MailLocal, MailExtension, MailDomain - , Mailbox(..), MailboxMapping(..) - , Unique(..) - ) where - -import Prelude - -import Database.Persist -import Database.Persist.Sql -import Database.Persist.TH - -import GHC.Generics (Generic) -import Type.Reflection (Typeable) - -import Data.Text (Text) - -import Data.CaseInsensitive (CI) -import qualified Data.CaseInsensitive as CI -import Data.CaseInsensitive.Instances () - -import Data.UUID (UUID) -import Data.UUID.Instances () - -import Data.Int (Int64) - -import Control.Lens - -import Web.HttpApiData - - -newtype MailMailbox = MailMailbox - { unMailMailbox :: CI Text - } deriving stock (Eq, Ord, Read, Show, Generic, Typeable) - deriving newtype (PersistField, PersistFieldSql) -makeWrapped ''MailMailbox -newtype MailLocal = MailLocal - { unMailLocal :: CI Text - } deriving stock (Eq, Ord, Read, Show, Generic, Typeable) - deriving newtype (PersistField, PersistFieldSql) -makeWrapped ''MailLocal -newtype MailExtension = MailExtension - { unMailExtension :: CI Text - } deriving stock (Eq, Ord, Read, Show, Generic, Typeable) - deriving newtype (PersistField, PersistFieldSql) -makeWrapped ''MailExtension -newtype MailDomain = MailDomain - { unMailDomain :: CI Text - } deriving stock (Eq, Ord, Read, Show, Generic, Typeable) - deriving newtype (PersistField, PersistFieldSql) -makeWrapped ''MailDomain - -instance FromHttpApiData MailDomain where - parseUrlPiece = fmap (review _Wrapped . CI.mk) . parseUrlPiece - - -share [mkPersist sqlSettings] [persistLowerCase| - Mailbox - Id UUID sqltype=uuid default=gen_random_uuid() - ident MailMailbox sql=mailbox - quota Int64 Maybe sql=quota_bytes MigrationOnly - UniqueMailbox ident - deriving Show - MailboxMapping - Id UUID sqltype=uuid default=gen_random_uuid() - local MailLocal Maybe - extension MailExtension Maybe - domain MailDomain - mailbox MailboxId -|] diff --git a/hosts/surtr/email/spm/spm.nix b/hosts/surtr/email/spm/spm.nix deleted file mode 100644 index ba7a5f0b..00000000 --- a/hosts/surtr/email/spm/spm.nix +++ /dev/null @@ -1,28 +0,0 @@ -{ mkDerivation, aeson, attoparsec, base, bytestring -, case-insensitive, exceptions, filepath, hpack, http-api-data -, http-types, jose, lens, lib, mmorph, monad-logger, mtl -, optparse-applicative, path-pieces, persistent -, persistent-postgresql, resource-pool, servant, servant-server -, text, transformers, unliftio-core, uuid, wai, wai-extra, warp -, warp-systemd -}: -mkDerivation { - pname = "spm"; - version = "0.1.0"; - src = ./.; - isLibrary = true; - isExecutable = true; - libraryHaskellDepends = [ - aeson base case-insensitive jose lens servant text - ]; - libraryToolDepends = [ hpack ]; - executableHaskellDepends = [ - aeson attoparsec base bytestring case-insensitive exceptions - filepath http-api-data http-types jose lens mmorph monad-logger mtl - optparse-applicative path-pieces persistent persistent-postgresql - resource-pool servant-server text transformers unliftio-core uuid - wai wai-extra warp warp-systemd - ]; - prePatch = "hpack"; - license = lib.licenses.agpl3Plus; -} -- cgit v1.2.3