Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Fix types for role JSON decode

Too much was happening behind the curtains and thus roles JSON decode
was returning Nothing.  Fix by making the types more constrained.
  • Loading branch information...
commit 42abdc6c73ba55df49c3346f59bd2b5c9aea8f23 1 parent 704f9ff
@nurpax authored
Showing with 9 additions and 3 deletions.
  1. +8 −2 src/Snap/Snaplet/Auth/Backends/SqliteSimple.hs
  2. +1 −1  test/Tests.hs
View
10 src/Snap/Snaplet/Auth/Backends/SqliteSimple.hs
@@ -40,9 +40,10 @@ module Snap.Snaplet.Auth.Backends.SqliteSimple
------------------------------------------------------------------------------
import Control.Concurrent
import qualified Data.Aeson as A
+import Data.ByteString (ByteString)
import qualified Data.Configurator as C
-import Data.Maybe
import qualified Data.HashMap.Lazy as HM
+import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
@@ -231,14 +232,19 @@ instance FromRow AuthUser where
!_userRoles = field :: RowParser (Maybe LT.Text)
!_userMeta = field :: RowParser (Maybe LT.Text)
+ decodeRoles :: RowParser [Role]
decodeRoles = do
- roles <- fmap (fmap (maybeToList . A.decode' . LT.encodeUtf8)) _userRoles
+ roles <- fmap (fmap (map Role) . textDecodeBS) _userRoles
return $ fromMaybe [] roles
decodeMeta = do
meta <- fmap (fmap (fromMaybe HM.empty . A.decode' . LT.encodeUtf8)) _userMeta
return $ fromMaybe HM.empty meta
+ textDecodeBS :: Maybe LT.Text -> Maybe [ByteString]
+ textDecodeBS Nothing = Nothing
+ textDecodeBS (Just t) = A.decode' . LT.encodeUtf8 $ t
+
querySingle :: (ToRow q, FromRow a)
=> MVar S.Connection -> Query -> q -> IO (Maybe a)
View
2  test/Tests.hs
@@ -166,7 +166,7 @@ testUpdateUser = testCase "createUser + update good params" assertGoodUser
A.toJSON $ T.pack "yes")
, (T.pack "suppress-products",
A.toJSON [T.pack "Kryptonite"]) ]
-
+
checkUpdatedUser (Left _) = assertBool "failed saveUser" False
checkUpdatedUser (Right u) = do
assertEqual "login rename ok?" "bar" (userLogin u)
Please sign in to comment.
Something went wrong with that request. Please try again.