packages feed

polysemy-account-api 0.1.0.0 → 0.2.0.0

raw patch · 12 files changed

+40/−46 lines, 12 filesdep −polysemy-logdep ~aesondep ~exondep ~fast-logger

Dependencies removed: polysemy-log

Dependency ranges changed: aeson, exon, fast-logger, jose, polysemy-conc, servant, servant-auth, servant-auth-server, servant-server, uuid, wai, wai-extra, warp

Files

lib/Polysemy/Account/Api.hs view
@@ -10,6 +10,7 @@   genJwk,    Authorize (Authorize),+  AuthorizeP,   authorize,    -- * Interpreters@@ -58,8 +59,7 @@   adminOnly2_, ) where -import Polysemy.Account.Api.Data.Authed (Authed, AuthedP)-import Polysemy.Account.Api.Effect.Authorize (Authorize (Authorize), authorize)+import Polysemy.Account.Api.Effect.Authorize (Authorize (Authorize), AuthorizeP, authorize) import Polysemy.Account.Api.Effect.Jwt (GenJwk, Jwt, genJwk, key, makeToken, settings) import Polysemy.Account.Api.Interpreter.Accounts (   interpretAccountAuthStore,@@ -97,3 +97,4 @@   adminOnly_,   authorizeEndpoint,   )+import Polysemy.Account.Data.Authed (Authed, AuthedP)
− lib/Polysemy/Account/Api/Data/Authed.hs 
@@ -1,13 +0,0 @@--- | Description: Servant API markers for JWT auth with 'AuthedAccount'-module Polysemy.Account.Api.Data.Authed where--import Servant.Auth (Auth, JWT)--import Polysemy.Account.Data.AuthedAccount (AuthedAccount)-import Polysemy.Account.Data.Privilege (Privilege)---- | A Servant API marker for JWT auth with 'AuthedAccount'-type Authed i p = Auth '[JWT] (AuthedAccount i p)---- | Convenience alias for using the default privilege type with 'Authed'.-type AuthedP i = Authed i [Privilege]
lib/Polysemy/Account/Api/Effect/Authorize.hs view
@@ -2,6 +2,7 @@ module Polysemy.Account.Api.Effect.Authorize where  import Polysemy.Account.Data.AuthedAccount (AuthedAccount)+import Polysemy.Account.Data.Privilege (Privilege)  -- | This effect is used by the combinators in "Polysemy.Account.Api.Server.AuthEndpoint" to decide whether an account -- is authorized to access an endpoint.@@ -17,3 +18,6 @@   Authorize :: param -> AuthedAccount i priv -> Authorize i param priv m (Maybe Text)  makeSem ''Authorize++-- | Convenience alias for using the default privilege type with 'Authorize'.+type AuthorizeP i = Authorize i [Privilege] [Privilege]
lib/Polysemy/Account/Api/Interpreter/Jwt.hs view
@@ -4,9 +4,9 @@ -- | Interpreters for 'Jwt' module Polysemy.Account.Api.Interpreter.Jwt where +import Conc (interpretAtomic) import qualified Crypto.JOSE as JOSE import Crypto.JOSE (JWK, KeyMaterialGenParam (OKPGenParam), OKPCrv (Ed25519), genJWK)-import Polysemy.Conc.AtomicState (interpretAtomic) import Polysemy.Db (DbError, InitDbError) import Polysemy.Hasql (Database, interpretAtomicStateDb, interpretTable) import Servant.Auth.JWT (ToJWT)
lib/Polysemy/Account/Api/Native.hs view
@@ -40,9 +40,7 @@   Sem r () runServerJwtWith ctx srv port = do   jwtSettings <- Jwt.settings !>> throw "Jwt initialization failed"-  runServer @api srv (context jwtSettings) port-  where-    context jwtSettings = jwtSettings :. defaultCookieSettings :. ctx+  runServer @api srv (jwtSettings :. defaultCookieSettings :. ctx) port  -- | Run a Servant server with JSON Web Token authentication using settings from 'Jwt'. runServerJwt ::
lib/Polysemy/Account/Api/NativeContext.hs view
@@ -5,6 +5,7 @@  import Control.Monad.Trans.Except (ExceptT (ExceptT)) import Exon.Quote (exon)+import qualified Log import Network.Wai (Application) import qualified Network.Wai.Handler.Warp as Warp import Network.Wai.Handler.Warp (@@ -18,9 +19,7 @@ import qualified Network.Wai.Middleware.RequestLogger as Logger import Network.Wai.Middleware.RequestLogger (destination, mkRequestLogger) import qualified Polysemy.Conc.Effect.Interrupt as Interrupt-import qualified Polysemy.Conc.Effect.Sync as Sync import Polysemy.Final (withWeavingToFinal)-import qualified Polysemy.Log as Log import Servant (   Context,   DefaultErrorFormatters,@@ -36,6 +35,7 @@   serveWithContext,   type (.++),   )+import qualified Sync import System.Log.FastLogger (fromLogStr)  import Polysemy.Account.Data.Port (Port (Port))@@ -74,8 +74,8 @@     handle ma =       cons (err <$> lower (handleErrors ma <$ s))       where-        err x =-          ins x & \case+        err =+          ins >>> \case             Just a -> a             Nothing -> Left err500
lib/Polysemy/Account/Api/Routes.hs view
@@ -4,7 +4,7 @@ import Servant.API (Capture, Get, JSON, NoContent, PostCreated, PostResetContent, Put, ReqBody, (:<|>), (:>)) import Sqel (Uid) -import Polysemy.Account.Api.Data.Authed (Authed)+import Polysemy.Account.Data.Authed (Authed) import Polysemy.Account.Data.Account (Account) import Polysemy.Account.Data.AccountCredentials (AccountCredentials) import Polysemy.Account.Data.AuthToken (AuthToken)
lib/Polysemy/Account/Api/Server/AuthEndpoint.hs view
@@ -4,7 +4,7 @@ module Polysemy.Account.Api.Server.AuthEndpoint where  import Exon (exon)-import qualified Polysemy.Log as Log+import qualified Log import Servant (ServerError) import Servant.Auth.Server (AuthResult (Authenticated))
lib/Polysemy/Account/Api/Server/Error.hs view
@@ -5,7 +5,7 @@  import qualified Data.Aeson as Aeson import Exon.Quote (exon)-import qualified Polysemy.Log as Log+import qualified Log import Servant (ServerError, err401, err409, err500, errBody)  import Polysemy.Account.Data.AccountsError (
lib/Polysemy/Account/Db/Dd.hs view
@@ -43,6 +43,7 @@ import Polysemy.Account.Data.AccountAuth (AccountAuth) import Polysemy.Account.Data.AccountName (AccountName) import Polysemy.Account.Data.AccountStatus (AccountStatus)+import Polysemy.Account.Data.Privilege (Privilege)  type DdAccount i p s =   UidDd (Mod PrimaryKey (Prim "id" i)) (@@ -52,6 +53,10 @@     s   ) +privileges :: Sqel [Privilege] _+privileges =+  named @"privileges" (array enum)+ account ::   Column p "privileges" s s =>   Dd s ->@@ -61,7 +66,7 @@  accountP :: Sqel (Uid i AccountP) _ accountP =-  account (named @"privileges" (array enum))+  account privileges  accountSchema ::   PrimColumn i =>
polysemy-account-api.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           polysemy-account-api-version:        0.1.0.0+version:        0.2.0.0 synopsis:       Account management with Servant and Polysemy description:    See https://hackage.haskell.org/package/polysemy-account-api/docs/Polysemy-Account-Api.html category:       Web@@ -22,7 +22,6 @@ library   exposed-modules:       Polysemy.Account.Api-      Polysemy.Account.Api.Data.Authed       Polysemy.Account.Api.Effect.Authorize       Polysemy.Account.Api.Effect.Jwt       Polysemy.Account.Api.Interpreter.Accounts@@ -38,6 +37,8 @@       Polysemy.Account.Db.Dd       Polysemy.Account.Db.Interpreter.AccountByName       Polysemy.Account.Db.Interpreter.AuthForAccount+  reexported-modules:+      Polysemy.Account   hs-source-dirs:       lib   default-extensions:@@ -107,29 +108,28 @@       ViewPatterns   ghc-options: -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Widentities -Wunused-packages -fplugin=Polysemy.Plugin   build-depends:-      aeson+      aeson ==2.0.*     , base >=4.12 && <5-    , exon-    , fast-logger-    , jose+    , exon ==1.4.*+    , fast-logger ==3.1.*+    , jose ==0.9.*     , polysemy     , polysemy-account-    , polysemy-conc+    , polysemy-conc ==0.12.*     , polysemy-db     , polysemy-hasql-    , polysemy-log     , polysemy-plugin     , prelate >=0.5-    , servant-    , servant-auth-    , servant-auth-server-    , servant-server+    , servant ==0.19.*+    , servant-auth ==0.4.*+    , servant-auth-server ==0.4.*+    , servant-server ==0.19.*     , sqel     , transformers-    , uuid-    , wai-    , wai-extra-    , warp+    , uuid ==1.3.*+    , wai ==3.2.*+    , wai-extra ==3.1.*+    , warp ==3.3.*   mixins:       base hiding (Prelude)     , prelate (Prelate as Prelude)
test/Polysemy/Account/Api/Test/Request.hs view
@@ -19,7 +19,7 @@   ) import Servant.Auth.Server (IsSecure (NotSecure), cookieIsSecure, defaultCookieSettings) import Sqel (Uid)-import Zeugma (TestStack, runTestFrozen)+import Zeugma (TestStack, resumeTest, runTestFrozen)  import Polysemy.Account.Accounts (register) import Polysemy.Account.Api.Effect.Authorize (Authorize)@@ -129,14 +129,13 @@ run ctx srv method path headers body =   runSessionSemJwtCtx @api ctx srv (srequest (reqJson method path headers body)) --- TODO resumeTest makeAccount ::   Members [Accounts Int [Privilege] !! AccountsError, Jwt (AuthedAccount Int [Privilege]) !! (), Error TestError] r =>   AccountCredentials ->   [Privilege] ->   Sem r (Text, (ByteString, ByteString)) makeAccount creds privs =-  resumeHoistError @AccountsError (TestError . show) do+  resumeTest @AccountsError do     root <- register creds     let i = root ^. #id     Accounts.setStatus i AccountStatus.Active