Permalink
Browse files

Support meta fields (+unordered-containers dep)

  • Loading branch information...
1 parent 294b19f commit 92e1e2c77e9e6129ee2d9c5ff48a61552d390fd2 @dzhus committed Feb 22, 2012
Showing with 52 additions and 23 deletions.
  1. +26 −11 README.org
  2. +10 −8 snap-auth-cli.cabal
  3. +16 −4 src/Main.hs
View
37 README.org
@@ -3,9 +3,12 @@
create, view and delete users in database. Currently only JsonFile
backend is supported.
- Passwords for new users are provided in plain text. By default the
- database resides in current directory in `users.json` file. Note
- that if database file doesn't exist, it will be created from
+ Passwords for new users are provided in plain text.
+
+ By default the database resides in current directory in `users.json`
+ file.
+
+ Note that if database file doesn't exist, it will be created from
scratch. A different db may be specified using `-j` flag.
@@ -18,22 +21,33 @@
User roles may be set when creating account:
- : ./snap-auth-cli --create -u TwasBrillig -p SlithyToves1855 -r gyre -r gimble
+ : ./snap-auth-cli --create -u TwasBrillig2 -p SlithyToves1855 -r gyre -r gimble
+
+ A user may have arbitary number of key-value pairs attached in meta
+ field (currently all fields are stored in Strings):
+
+ : ./snap-auth-cli --create -u AlexP -p 1234 -k number -v 3214 -k foo -v bar -r admin
- Read the user from DB:
+ Read the user from DB (`--read` flag may be omitted):
- : ./snap-auth-cli --read -u TwasBrillig
+ : ./snap-auth-cli --read -u AlexP
: {
- : "meta": {},
+ : "meta": {
+ : "number": "3214",
+ : "foo": "bar"
+ : },
: "suspended_at": null,
- : "pw": "sha256|12|izRmgu++a+Hw1V48gQtiDw==|FNo/Os+Z+r2QsxXTqRyV61LDPPEibMC9U3Pbp2D/ujU=",
+ : "roles": [
+ : "admin"
+ : ],
+ : "pw": "sha256|12|VpUGBg2O/NBkDTVTSqqYuA==|TIDuc3ToAPmALXCHBxTA8SjlUBztPS8nH6qiV63a+f4=",
: "activated_at": null,
: "current_ip": null,
: "locked_until": null,
- : "updated_at": "2012-02-19T22:15:47.911Z",
+ : "updated_at": "2012-02-22T09:00:29.377Z",
: "login_count": 0,
: "current_login_at": null,
- : "login": "TwasBrillig",
+ : "login": "AlexP",
: "remember_token": null,
: "failed_login_count": 0,
: "last_ip": null,
@@ -50,5 +64,6 @@
in Snap doesn't support the operation yet.
* To do
-** IN PROGRESS More fields
+** DONE More fields
+ CLOSED: [2012-02-22 Срд 12:53]
Support setting AuthUser's userMeta and other fields.
View
18 snap-auth-cli.cabal
@@ -19,11 +19,13 @@ executable snap-auth-cli
ghc-options: -Wall
build-depends:
- aeson-pretty == 0.6.*,
- base >= 4 && < 5,
- bytestring == 0.9.*,
- clientsession == 0.7.*,
- cmdargs == 0.9.*,
- snap >= 0.7.1 && < 0.8,
- text == 0.11.*,
- utf8-string == 0.3.*
+ aeson == 0.6.*,
+ aeson-pretty == 0.6.*,
+ base >= 4 && < 5,
+ bytestring == 0.9.*,
+ clientsession == 0.7.*,
+ cmdargs == 0.9.*,
+ snap >= 0.7.1 && < 0.8,
+ text == 0.11.*,
+ unordered-containers == 0.1.*,
+ utf8-string == 0.3.*
View
20 src/Main.hs
@@ -15,11 +15,13 @@ where
import Data.Functor
import Data.Aeson.Encode.Pretty
+import qualified Data.Aeson.Types as A
import qualified Data.Text as T (pack)
import qualified Data.ByteString as B (ByteString)
import qualified Data.ByteString.Lazy as LB (putStr)
import qualified Data.ByteString.UTF8 as BU (fromString)
+import qualified Data.HashMap.Lazy as M
import System.Console.CmdArgs.Implicit
@@ -35,15 +37,18 @@ type AuthUserAction = IAuthBackend r => r -> AuthUser -> IO ()
-- | Save new user in auth backend given user login, password and roles
mgrNewUser :: IAuthBackend r => r
- -> (String, String, [String])
+ -> (String, String, [String], [(String, String)])
-> IO AuthUser
-mgrNewUser amgr (l, p, rs) =
+mgrNewUser amgr (l, p, rs, mt) =
let
login = T.pack l
pass = BU.fromString p
roles = map (Role . BU.fromString) $ rs
+ meta = M.fromList $
+ map (\(k, v) -> (T.pack k, A.String $ T.pack v)) mt
au' = defAuthUser{ userLogin = login
- , userRoles = roles}
+ , userRoles = roles
+ , userMeta = meta}
in
do
au <- setPassword au' pass
@@ -83,6 +88,8 @@ data Options = Options
, password :: Maybe String
, json :: String
, role :: [String]
+ , key :: [String]
+ , value :: [String]
}
deriving (Show, Data, Typeable)
@@ -98,6 +105,10 @@ main =
, password = def
, role = def &= name "r"
&= help "User role. May be specified multiple times"
+ , key = def &= name "k"
+ &= help "User meta key. Must be followed by value option"
+ , value = def &= name "v"
+ &= help "User meta value."
, json = "users.json"
&= typFile
&= help "Path to JsonFile database"
@@ -112,6 +123,7 @@ main =
(Read, Just l, _) -> mgrOldUser amgr l
(\_ au -> LB.putStr $ encodePretty au)
(Delete, Just l, _) -> mgrOldUser amgr l destroy
- (Create, Just l, Just pw) -> mgrNewUser amgr (l, pw, role)
+ (Create, Just l, Just pw) -> mgrNewUser amgr (l, pw, role, meta)
>> return ()
+ where meta = zip key value
(Create, _, Nothing) -> ioError $ userError "No password set"

0 comments on commit 92e1e2c

Please sign in to comment.