snaplet-sqlite-simple-jwt-auth 0.1.1.0 → 0.2.0.0

raw patch · 4 files changed

+50/−28 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• snaplet-sqlite-simple-jwt-auth.cabal +1/−1
• src/Snap/Snaplet/SqliteSimple/JwtAuth.hs +2/−2
• src/Snap/Snaplet/SqliteSimple/JwtAuth/JwtAuth.hs +28/−23
• src/Snap/Snaplet/SqliteSimple/JwtAuth/Types.hs +19/−2

@@ -1,5 +1,5 @@ name:                snaplet-sqlite-simple-jwt-auth-version:             0.1.1.0+version:             0.2.0.0 synopsis:            Snaplet for JWT authentication with snaplet-sqlite-simple description:     JWT authentication snaplet for snaplet-sqlite-simple.

@@ -8,9 +8,11 @@    -- * Types     SqliteJwt(..)+  , Options(..)   , User(..)   , AuthFailure(..)   -- * Initialization+  , defaults   , sqliteJwtInit   -- * High-level handlers @@ -54,8 +56,6 @@ import Snap.Snaplet.SqliteSimple.JwtAuth.JwtAuth  -- $intro--- NOTE: This is still very much a work-in-progress project!--- -- A snap middleware for implementing JWT-based authentication with user -- accounts persisted in a SQLite3 database.  It's intended use is to protect -- server API routes used in single-page web applications (SPA) and mobile

@@ -3,17 +3,11 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} -{---Minimal proof of concept JWT authentication snaplet using snaplet-sqlite--simple.---}- module Snap.Snaplet.SqliteSimple.JwtAuth.JwtAuth (     SqliteJwt(..)   , User(..)   , AuthFailure(..)+  , defaults   , sqliteJwtInit   , requireAuth   , registerUser@@ -41,6 +35,7 @@ import           Data.HashMap.Strict as HM import qualified Data.Text as T import qualified Data.Text.Encoding as LT+import           Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime) import           Snap import           Snap.Snaplet.SqliteSimple (Sqlite, sqliteConn) import qualified Web.JWT as JWT@@ -49,8 +44,13 @@ import           Snap.Snaplet.SqliteSimple.JwtAuth.Types import qualified Snap.Snaplet.SqliteSimple.JwtAuth.Db as Db -bcryptPolicy :: BC.HashingPolicy-bcryptPolicy = BC.fastBcryptHashingPolicy+-- | Default settings for the snaplet+defaults :: Options+defaults = Options {+    hashingPolicy      = BC.fastBcryptHashingPolicy+  , signingKeyFilename = "jwt_secret.txt"+  , maxTokenExpiration = 60*60*24*14 -- two weeks+  }  ------------------------------------------------------------------------- -- | Initializer for the sqlite-simple JwtAuth snaplet.@@ -63,14 +63,14 @@ -- Initialization will automatically setup SQL tables used to store user -- accounts.  It will also automatically upgrade the SQL schema if necessary. sqliteJwtInit-  :: String         -- ^ JWT secret signing key filename+  :: Options        -- ^ Site policy options   -> Snaplet Sqlite -- ^ The sqlite-simple snaplet   -> SnapletInit b SqliteJwt-sqliteJwtInit jwtSigningKeyFname db = makeSnaplet "sqlite-simple-jwt" description Nothing $ do-    k <- liftIO $ (JWT.binarySecret <$> getKey jwtSigningKeyFname)+sqliteJwtInit options db = makeSnaplet "sqlite-simple-jwt" description Nothing $ do+    k <- liftIO $ (JWT.binarySecret <$> getKey (signingKeyFilename options))     let conn = sqliteConn $ db ^# snapletValue     liftIO $ Db.createTableIfMissing conn-    return $ SqliteJwt k conn+    return $ SqliteJwt k conn options   where     description = "sqlite-simple jwt auth" @@ -82,9 +82,10 @@   -> Handler b SqliteJwt (Either AuthFailure User) createUser loginName password = do   user <- Db.queryUser loginName+  hashPolicy <- hashingPolicy <$> gets options   case user of     Nothing -> do-      hashedPass <- liftIO $ BC.hashPasswordUsingPolicy bcryptPolicy (LT.encodeUtf8 password)+      hashedPass <- liftIO $ BC.hashPasswordUsingPolicy hashPolicy (LT.encodeUtf8 password)       -- TODO don't use fromJust       Db.insertUser loginName (fromJust hashedPass)       u <- Db.queryUser loginName@@ -120,11 +121,12 @@     payload = LT.decodeUtf8 <$> AP.takeWhile1 (AP.inClass base64)     base64 = "A-Za-z0-9+/_=.-" -jwtFromUser :: User -> Handler b SqliteJwt JWT.JSON-jwtFromUser (User uid loginName) = do+jwtFromUser :: User -> POSIXTime -> Handler b SqliteJwt JWT.JSON+jwtFromUser (User uid loginName) expiresOn = do   key <- gets siteSecret   let cs = JWT.def {             JWT.unregisteredClaims = M.fromList [("id", Number (fromIntegral uid)), ("login", String loginName)]+          , JWT.exp = JWT.intDate $ expiresOn           }   return $ JWT.encodeSigned JWT.HS256 key cs @@ -149,14 +151,15 @@   key <- gets siteSecret   req <- getRequest   res <- runExceptT $ do-    authHdr     <- getHeader "Authorization" (rqHeaders req) ?? "Missing Authorization header"+    curTime     <- liftIO $ getPOSIXTime+    authHdr     <- getHeader "Authorization" (rqHeaders req) ?? "missing Authorization header"     encPayload  <- hoistEither . parseBearerJwt $ authHdr-    jwt         <- JWT.decode encPayload     ?? "Malformed JWT"-    verifJwt    <- JWT.verify key jwt        ?? "JWT verification failed"+    jwt         <- JWT.decode encPayload           ?? "malformed JWT"+    verifJwt    <- JWT.verify key jwt              ?? "JWT verification failed"+    exp         <- JWT.exp (JWT.claims verifJwt)   ?? "exp not set in JWT"+    assertZ (JWT.secondsSinceEpoch exp >= curTime) ?? "token has expired"     let unregClaims = JWT.unregisteredClaims (JWT.claims verifJwt)-    -- TODO verify expiration too-    user        <- hoistEither . parseEither parseJSON $ (toObject unregClaims)-    return user+    hoistEither . parseEither parseJSON $ (toObject unregClaims)   either (finishEarly 401 . BS8.pack) action res   where     toObject = Object . HM.fromList . M.toList@@ -179,7 +182,9 @@  loginOK :: User -> Handler b SqliteJwt () loginOK user = do-  jwt <- jwtFromUser user+  expiresIn <- maxTokenExpiration <$> gets options+  curTime   <- liftIO getPOSIXTime+  jwt       <- jwtFromUser user (curTime + (fromIntegral expiresIn))   writeJSON $ object [ "token" .= jwt ]  -- | Create a new user.

@@ -4,6 +4,7 @@  import           Control.Concurrent import           Control.Monad+import qualified Crypto.BCrypt as BC import           Data.Aeson import qualified Data.Text as T import           Database.SQLite.Simple@@ -13,10 +14,26 @@ data SqliteJwt = SqliteJwt {     siteSecret    :: JWT.Secret   , sqliteJwtConn :: MVar Connection+  , options       :: Options   } --- | User account--- User ID and login name.+-- | Site configuration options+--+-- Tokens will expire after 'maxTokenExpiration' seconds.  The login handler+-- may be extended in the future to allow setting a lower expiration time.  In+-- that case, 'maxTokenExpiration' will be used as the upper limit for expiry.+-- Otherwise someone might modify login requests to set an infinitely long+-- expiration time and JWTs would never expire.+--+-- You can use the 'Snap.Snaplet.SqliteSimple.JwtAuth.defaults' value as your+-- basis, overriding individual fields as necessary.+data Options = Options {+    hashingPolicy      :: BC.HashingPolicy  -- ^ Which bcrypt hashing policy to use+  , signingKeyFilename :: String            -- ^ Where to save site JWT key+  , maxTokenExpiration :: Int               -- ^ Maximum expiration time for a JWT+  } deriving (Show)++-- | User ID and login name. -- -- If you need to store additional fields for your user accounts, persist them -- in your application SQL tables and key them by 'userId'.