packages feed

servant-auth-token-api 0.1.2.0 → 0.2.0.0

raw patch · 3 files changed

+93/−34 lines, 3 filesdep ~aeson-injectorPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: aeson-injector

API changes (from Hackage documentation)

- Servant.API.Auth.Token: instance (GHC.TypeLits.KnownSymbol x, Servant.API.Auth.Token.PermsList xs) => Servant.API.Auth.Token.PermsList (x : xs)
+ Servant.API.Auth.Token: PermConcat :: PermSymbol -> PermSymbol -> PermSymbol
+ Servant.API.Auth.Token: PermLabel :: Symbol -> PermSymbol
+ Servant.API.Auth.Token: data PermSymbol
+ Servant.API.Auth.Token: instance (Servant.API.Auth.Token.UnliftPermSymbol p1, Servant.API.Auth.Token.UnliftPermSymbol p2) => Servant.API.Auth.Token.UnliftPermSymbol ('Servant.API.Auth.Token.PermConcat p1 p2)
+ Servant.API.Auth.Token: instance (Servant.API.Auth.Token.UnliftPermSymbol x, Servant.API.Auth.Token.PermsList xs) => Servant.API.Auth.Token.PermsList (x : xs)
+ Servant.API.Auth.Token: instance GHC.TypeLits.KnownSymbol s => Servant.API.Auth.Token.UnliftPermSymbol ('Servant.API.Auth.Token.PermLabel s)
+ Servant.API.Auth.Token: instance Servant.Docs.Internal.ToSample Data.Aeson.Unit.Unit
+ Servant.API.Auth.Token: type MToken' (perms :: [Symbol]) = MToken (PlainPerms perms)
+ Servant.API.Auth.Token: type Token' (perms :: [Symbol]) = Token (PlainPerms perms)
+ Servant.API.Auth.Token: type TokenHeader' (perms :: [Symbol]) = TokenHeader (PlainPerms perms)
- Servant.API.Auth.Token: class PermsList (a :: [Symbol])
+ Servant.API.Auth.Token: class PermsList (a :: [PermSymbol])
- Servant.API.Auth.Token: newtype Token (perms :: [Symbol])
+ Servant.API.Auth.Token: newtype Token (perms :: [PermSymbol])
- Servant.API.Auth.Token: type AuthDeleteGroupMethod = "auth" :> ("group" :> (Capture "group-id" UserGroupId :> (TokenHeader '["auth-delete"] :> Delete '[JSON] ())))
+ Servant.API.Auth.Token: type AuthDeleteGroupMethod = "auth" :> ("group" :> (Capture "group-id" UserGroupId :> (TokenHeader' '["auth-delete"] :> Delete '[JSON] Unit)))
- Servant.API.Auth.Token: type AuthDeleteUserMethod = "auth" :> ("user" :> (Capture "user-id" UserId :> (TokenHeader '["auth-delete"] :> Delete '[JSON] ())))
+ Servant.API.Auth.Token: type AuthDeleteUserMethod = "auth" :> ("user" :> (Capture "user-id" UserId :> (TokenHeader' '["auth-delete"] :> Delete '[JSON] Unit)))
- Servant.API.Auth.Token: type AuthGetGroupMethod = "auth" :> ("group" :> (Capture "group-id" UserGroupId :> (TokenHeader '["auth-info"] :> Get '[JSON] UserGroup)))
+ Servant.API.Auth.Token: type AuthGetGroupMethod = "auth" :> ("group" :> (Capture "group-id" UserGroupId :> (TokenHeader' '["auth-info"] :> Get '[JSON] UserGroup)))
- Servant.API.Auth.Token: type AuthGetUserMethod = "auth" :> ("user" :> (Capture "user-id" UserId :> (TokenHeader '["auth-info"] :> Get '[JSON] RespUserInfo)))
+ Servant.API.Auth.Token: type AuthGetUserMethod = "auth" :> ("user" :> (Capture "user-id" UserId :> (TokenHeader' '["auth-info"] :> Get '[JSON] RespUserInfo)))
- Servant.API.Auth.Token: type AuthGroupsMethod = "auth" :> ("group" :> (PageParam :> (PageSizeParam :> (TokenHeader '["auth-info"] :> Get '[JSON] (PagedList UserGroupId UserGroup)))))
+ Servant.API.Auth.Token: type AuthGroupsMethod = "auth" :> ("group" :> (PageParam :> (PageSizeParam :> (TokenHeader' '["auth-info"] :> Get '[JSON] (PagedList UserGroupId UserGroup)))))
- Servant.API.Auth.Token: type AuthPatchGroupMethod = "auth" :> ("group" :> (Capture "group-id" UserGroupId :> (ReqBody '[JSON] PatchUserGroup :> (TokenHeader '["auth-update"] :> Patch '[JSON] ()))))
+ Servant.API.Auth.Token: type AuthPatchGroupMethod = "auth" :> ("group" :> (Capture "group-id" UserGroupId :> (ReqBody '[JSON] PatchUserGroup :> (TokenHeader' '["auth-update"] :> Patch '[JSON] Unit))))
- Servant.API.Auth.Token: type AuthPatchUserMethod = "auth" :> ("user" :> (Capture "user-id" UserId :> (ReqBody '[JSON] PatchUser :> (TokenHeader '["auth-update"] :> Patch '[JSON] ()))))
+ Servant.API.Auth.Token: type AuthPatchUserMethod = "auth" :> ("user" :> (Capture "user-id" UserId :> (ReqBody '[JSON] PatchUser :> (TokenHeader' '["auth-update"] :> Patch '[JSON] Unit))))
- Servant.API.Auth.Token: type AuthPostGroupMethod = "auth" :> ("group" :> (ReqBody '[JSON] UserGroup :> (TokenHeader '["auth-update"] :> Post '[JSON] (OnlyId UserGroupId))))
+ Servant.API.Auth.Token: type AuthPostGroupMethod = "auth" :> ("group" :> (ReqBody '[JSON] UserGroup :> (TokenHeader' '["auth-update"] :> Post '[JSON] (OnlyId UserGroupId))))
- Servant.API.Auth.Token: type AuthPutGroupMethod = "auth" :> ("group" :> (Capture "group-id" UserGroupId :> (ReqBody '[JSON] UserGroup :> (TokenHeader '["auth-update"] :> Put '[JSON] ()))))
+ Servant.API.Auth.Token: type AuthPutGroupMethod = "auth" :> ("group" :> (Capture "group-id" UserGroupId :> (ReqBody '[JSON] UserGroup :> (TokenHeader' '["auth-update"] :> Put '[JSON] Unit))))
- Servant.API.Auth.Token: type AuthPutUserMethod = "auth" :> ("user" :> (Capture "user-id" UserId :> (ReqBody '[JSON] ReqRegister :> (TokenHeader '["auth-update"] :> Put '[JSON] ()))))
+ Servant.API.Auth.Token: type AuthPutUserMethod = "auth" :> ("user" :> (Capture "user-id" UserId :> (ReqBody '[JSON] ReqRegister :> (TokenHeader' '["auth-update"] :> Put '[JSON] Unit))))
- Servant.API.Auth.Token: type AuthRestoreMethod = "auth" :> ("restore" :> (Capture "user-id" UserId :> (QueryParam "code" RestoreCode :> (QueryParam "password" Password :> Post '[JSON] ()))))
+ Servant.API.Auth.Token: type AuthRestoreMethod = "auth" :> ("restore" :> (Capture "user-id" UserId :> (QueryParam "code" RestoreCode :> (QueryParam "password" Password :> Post '[JSON] Unit))))
- Servant.API.Auth.Token: type AuthSignoutMethod = "auth" :> ("signout" :> (TokenHeader '[] :> Post '[JSON] ()))
+ Servant.API.Auth.Token: type AuthSignoutMethod = "auth" :> ("signout" :> (TokenHeader '[] :> Post '[JSON] Unit))
- Servant.API.Auth.Token: type AuthSignupMethod = "auth" :> ("signup" :> (ReqBody '[JSON] ReqRegister :> (TokenHeader '["auth-register"] :> Post '[JSON] (OnlyField "user" UserId))))
+ Servant.API.Auth.Token: type AuthSignupMethod = "auth" :> ("signup" :> (ReqBody '[JSON] ReqRegister :> (TokenHeader' '["auth-register"] :> Post '[JSON] (OnlyField "user" UserId))))
- Servant.API.Auth.Token: type AuthTouchMethod = "auth" :> ("touch" :> (QueryParam "expire" Seconds :> (TokenHeader '[] :> Post '[JSON] ())))
+ Servant.API.Auth.Token: type AuthTouchMethod = "auth" :> ("touch" :> (QueryParam "expire" Seconds :> (TokenHeader '[] :> Post '[JSON] Unit)))
- Servant.API.Auth.Token: type AuthUsersMethod = "auth" :> ("users" :> (PageParam :> (PageSizeParam :> (TokenHeader '["auth-info"] :> Get '[JSON] RespUsersInfo))))
+ Servant.API.Auth.Token: type AuthUsersMethod = "auth" :> ("users" :> (PageParam :> (PageSizeParam :> (TokenHeader' '["auth-info"] :> Get '[JSON] RespUsersInfo))))
- Servant.API.Auth.Token: type MToken (perms :: [Symbol]) = Maybe (Token perms)
+ Servant.API.Auth.Token: type MToken (perms :: [PermSymbol]) = Maybe (Token perms)
- Servant.API.Auth.Token: type TokenHeader (perms :: [Symbol]) = Header "Authorization" (Token perms)
+ Servant.API.Auth.Token: type TokenHeader (perms :: [PermSymbol]) = Header "Authorization" (Token perms)

Files

CHANGELOG.md view
@@ -1,3 +1,15 @@+0.2.0.0+=======++* Moving tokens to `PermSymbol` instead of `Symbol` to allow complex permission labels to be used.+* Return `Unit` instead of `()`.+++0.1.2.0+=======++* Remove reexports.+ 0.1.1.0 ======= 
servant-auth-token-api.cabal view
@@ -1,5 +1,5 @@ name:                servant-auth-token-api-version:             0.1.2.0+version:             0.2.0.0 synopsis:            Servant based API for token based authorisation description:         Please see README.md homepage:            https://github.com/ncrashed/servant-auth-token-api#readme@@ -25,12 +25,12 @@   build-depends:              base >= 4.7 && < 5     , aeson >= 0.11 && < 0.12+    , aeson-injector >= 1.0.4 && < 1.1     , lens >= 4.13 && < 5-    , aeson-injector >= 1.0.3 && < 1.1-    , swagger2 >= 2.0 && <= 3     , servant >= 0.7 && < 0.9-    , servant-swagger >= 1.0 && < 2     , servant-docs >= 0.7 && < 0.9+    , servant-swagger >= 1.0 && < 2+    , swagger2 >= 2.0 && <= 3     , text >= 1.2 && < 2   default-language:    Haskell2010   default-extensions:
src/Servant/API/Auth/Token.hs view
@@ -33,9 +33,13 @@   , authAPI   , authDocs   -- ** Token+  , PermSymbol(..)   , Token(..)+  , Token'   , MToken+  , MToken'   , TokenHeader+  , TokenHeader'   , SimpleToken   , PermsList(..)   , downgradeToken'@@ -67,6 +71,7 @@   ) where   import Control.Lens+import Data.Aeson.Unit import Data.Aeson.WithField   import Data.Monoid  import Data.Proxy@@ -88,11 +93,42 @@ import Servant.API.Auth.Token.Internal.DeriveJson  import Servant.API.Auth.Token.Internal.Schema +instance ToSample Unit where +  toSamples _ = singleSample Unit++-- | Type level permission type that allows to +-- construct complex permission labels+data {- kind -} PermSymbol = +    PermLabel Symbol +  | PermConcat PermSymbol PermSymbol++-- | Convertation of permission symbol into runtim string+class UnliftPermSymbol (s :: PermSymbol) where +  unliftPermSymbol :: Proxy s -> String ++instance KnownSymbol s => UnliftPermSymbol ('PermLabel s) where +  unliftPermSymbol _ = symbolVal (Proxy :: Proxy s)++instance (UnliftPermSymbol p1, UnliftPermSymbol p2) => UnliftPermSymbol ('PermConcat p1 p2) where +  unliftPermSymbol _ = unliftPermSymbol (Proxy :: Proxy p1)+    ++ unliftPermSymbol (Proxy :: Proxy p2)++-- | Helper type family to wrap all symbols into 'PermLabel'+type family PlainPerms (p :: [Symbol]) :: [PermSymbol] where +  PlainPerms '[] = '[]+  PlainPerms (s ': ss) = 'PermLabel s ': PlainPerms ss+ -- | Token is simple string marked by permissions that are expected -- from the token to pass guarding functions.-newtype Token (perms :: [Symbol]) = Token { unToken :: Text }+newtype Token (perms :: [PermSymbol]) = Token { unToken :: Text }   deriving (Eq, Show) +-- | Token is simple string marked by permissions that are expected+-- from the token to pass guarding functions.+--+-- Simplified version that takes plain symbols as permissions.+type Token' (perms :: [Symbol]) = Token (PlainPerms perms)+ instance ToParamSchema (Token perms) where    toParamSchema _ = mempty { _paramSchemaType = SwaggerString } @@ -109,8 +145,13 @@ -- | Token that doesn't have attached compile-time permissions type SimpleToken = Text  -- | Shortcut for Maybe Token with attached permissions-type MToken (perms :: [Symbol]) = Maybe (Token perms)+type MToken (perms :: [PermSymbol]) = Maybe (Token perms) +-- | Shortcut for Maybe Token with attached permissions+--+-- Simplified version that takes plain symbols as permissions.+type MToken' (perms :: [Symbol]) = MToken (PlainPerms perms)+ -- | User name for login type Login = Text  -- | Password for login@@ -126,9 +167,15 @@  -- | Token header that we require for authorization marked  -- by permissions that are expected from the token to pass guarding functions.-type TokenHeader (perms :: [Symbol]) = +type TokenHeader (perms :: [PermSymbol]) =    Header "Authorization" (Token perms) +-- | Token header that we require for authorization marked +-- by permissions that are expected from the token to pass guarding functions.+--+-- Simplified version that takes plain symbols as permissions.+type TokenHeader' (perms :: [Symbol]) = TokenHeader (PlainPerms perms)+ -- | Id of user that is used in the API type UserId = Word  @@ -359,7 +406,7 @@ type AuthTouchMethod = "auth" :> "touch"    :> QueryParam "expire" Seconds   :> TokenHeader '[]-  :> Post '[JSON] ()+  :> Post '[JSON] Unit  -- | Get client info that is binded to the token type AuthTokenInfoMethod = "auth" :> "token"@@ -370,47 +417,47 @@ -- token in header is not valid. type AuthSignoutMethod = "auth" :> "signout"   :> TokenHeader '[]-  :> Post '[JSON] ()+  :> Post '[JSON] Unit  -- | Creation of new user, requires 'registerPerm' for token type AuthSignupMethod = "auth" :> "signup"   :> ReqBody '[JSON] ReqRegister-  :> TokenHeader '["auth-register"]+  :> TokenHeader' '["auth-register"]   :> Post '[JSON] (OnlyField "user" UserId)  -- | Getting list of all users, requires 'authInfoPerm' for token type AuthUsersMethod = "auth" :> "users"   :> PageParam   :> PageSizeParam-  :> TokenHeader '["auth-info"]+  :> TokenHeader' '["auth-info"]   :> Get '[JSON] RespUsersInfo  -- | Getting info about user, requires 'authInfoPerm' for token type AuthGetUserMethod = "auth" :> "user"   :> Capture "user-id" UserId -  :> TokenHeader '["auth-info"]+  :> TokenHeader' '["auth-info"]   :> Get '[JSON] RespUserInfo  -- | Updating login/email/password, requires 'authUpdatePerm' for token type AuthPatchUserMethod = "auth" :> "user"   :> Capture "user-id" UserId    :> ReqBody '[JSON] PatchUser-  :> TokenHeader '["auth-update"]-  :> Patch '[JSON] ()+  :> TokenHeader' '["auth-update"]+  :> Patch '[JSON] Unit  -- | Replace user with the user in the body, requires 'authUpdatePerm' for token type AuthPutUserMethod = "auth" :> "user"   :> Capture "user-id" UserId    :> ReqBody '[JSON] ReqRegister-  :> TokenHeader '["auth-update"]-  :> Put '[JSON] ()+  :> TokenHeader' '["auth-update"]+  :> Put '[JSON] Unit  -- | Delete user from DB, requires 'authDeletePerm' and will cause cascade -- deletion, that is your usually want type AuthDeleteUserMethod = "auth" :> "user"   :> Capture "user-id" UserId -  :> TokenHeader '["auth-delete"]-  :> Delete '[JSON] ()+  :> TokenHeader' '["auth-delete"]+  :> Delete '[JSON] Unit  -- | Generate new password for user. There is two phases, first, the method -- is called without 'code' parameter. The system sends email with a restore code@@ -420,45 +467,45 @@   :> Capture "user-id" UserId   :> QueryParam "code" RestoreCode    :> QueryParam "password" Password -  :> Post '[JSON] ()+  :> Post '[JSON] Unit  -- | Getting info about user group, requires 'authInfoPerm' for token type AuthGetGroupMethod = "auth" :> "group"   :> Capture "group-id" UserGroupId-  :> TokenHeader '["auth-info"]+  :> TokenHeader' '["auth-info"]   :> Get '[JSON] UserGroup  -- | Inserting new user group, requires 'authUpdatePerm' for token type AuthPostGroupMethod = "auth" :> "group"   :> ReqBody '[JSON] UserGroup-  :> TokenHeader '["auth-update"]+  :> TokenHeader' '["auth-update"]   :> Post '[JSON] (OnlyId UserGroupId)  -- | Replace info about given user group, requires 'authUpdatePerm' for token type AuthPutGroupMethod = "auth" :> "group"   :> Capture "group-id" UserGroupId   :> ReqBody '[JSON] UserGroup-  :> TokenHeader '["auth-update"]-  :> Put '[JSON] ()+  :> TokenHeader' '["auth-update"]+  :> Put '[JSON] Unit  -- | Patch info about given user group, requires 'authUpdatePerm' for token type AuthPatchGroupMethod = "auth" :> "group"   :> Capture "group-id" UserGroupId   :> ReqBody '[JSON] PatchUserGroup-  :> TokenHeader '["auth-update"]-  :> Patch '[JSON] ()+  :> TokenHeader' '["auth-update"]+  :> Patch '[JSON] Unit  -- | Delete all info about given user group, requires 'authDeletePerm' for token type AuthDeleteGroupMethod = "auth" :> "group"   :> Capture "group-id" UserGroupId-  :> TokenHeader '["auth-delete"]-  :> Delete '[JSON] ()+  :> TokenHeader' '["auth-delete"]+  :> Delete '[JSON] Unit  -- | Get list of user groups, requires 'authInfoPerm' for token  type AuthGroupsMethod = "auth" :> "group"   :> PageParam   :> PageSizeParam-  :> TokenHeader '["auth-info"]+  :> TokenHeader' '["auth-info"]   :> Get '[JSON] (PagedList UserGroupId UserGroup)  -- | Proxy type for auth API, used to pass the type-level info into @@ -532,24 +579,24 @@ #endif  -- | Unlifting compile-time permissions into list of run-time permissions-class PermsList (a :: [Symbol]) where +class PermsList (a :: [PermSymbol]) where    unliftPerms :: forall proxy . proxy a -> [Permission]  instance PermsList '[] where    unliftPerms _ = [] -instance (KnownSymbol x, PermsList xs) => PermsList (x ': xs) where -  unliftPerms _ = T.pack (symbolVal (Proxy :: Proxy x))+instance (UnliftPermSymbol x, PermsList xs) => PermsList (x ': xs) where +  unliftPerms _ = T.pack (unliftPermSymbol (Proxy :: Proxy x))     : unliftPerms (Proxy :: Proxy xs)  -- | Check whether a 'b' is contained in permission list of 'a'-type family ContainPerm (a :: [Symbol]) (b :: Symbol) where +type family ContainPerm (a :: [PermSymbol]) (b :: PermSymbol) where    ContainPerm '[] b = 'False   ContainPerm (a ': as) a = 'True   ContainPerm (a ': as) b = ContainPerm as b  -- | Check that first set of permissions is subset of second-type family ConatinAllPerm (a :: [Symbol]) (b :: [Symbol]) where +type family ConatinAllPerm (a :: [PermSymbol]) (b :: [PermSymbol]) where    ConatinAllPerm '[] bs = '[]   ConatinAllPerm (a ': as) bs = (ContainPerm bs a) ': (ConatinAllPerm as bs) @@ -560,7 +607,7 @@   TAll ('False ': as) = 'False   -- | Check that first set of permissions is subset of second, throw error if not-type PermsSubset (a :: [Symbol]) (b :: [Symbol]) = TAll (ConatinAllPerm a b)+type PermsSubset (a :: [PermSymbol]) (b :: [PermSymbol]) = TAll (ConatinAllPerm a b)  -- | Cast token to permissions that are lower than original one --