I'm using the yesod scaffold. I'm struggeling a bit with how to get a value from the settings.yml file,
The relevant part of the settings.yml file looks like this,
Default: &defaults
host: "*4" # any IPv4 host
port: 3000
approot: "http://localhost:3000"
admins: ["someEmail#gmail.com", "someOtherEmail#gmail.com"]
And then in my Foundation.hs file I have a method to check if the users email (using googleauth) matches a pre-specified email,
admins = ["someEmail#gmail.com", "someOtherEmail#gmail.com"]
isAdmin (Just (Entity _ user)) | elem (userIdent user) admins = Authorized
| otherwise = AuthenticationRequired
isAdmin Nothing = AuthenticationRequired
My goal is to replace the admins function with the one from the the settings.yml file because it seems more appropriate.
Any help on doing this would be greatly appreciated!
EDIT:
Okay, I've come as far as fetching the newly made "extra" with the following method,
admins = do
madmins <- extraAdmins getExtra
case madmins of
Nothing -> return Nothing
Just admins -> return admins
But the GHC throws this at me,
Foundation.hs:161:28:
Couldn't match expected type `Extra'
with actual type `Handler Extra'
In the first argument of `extraAdmins', namely `getExtra'
In a stmt of a 'do' block: madmins <- extraAdmins getExtra
In the expression:
do { madmins <- extraAdmins getExtra;
case madmins of {
Nothing -> return Nothing
Just admins -> return admins } }
Is there a way to convert it from Handler Extra to Extra, or am I simply doing it the wrong way?
At the end of the Settings.hs file in the scaffolding, there's the definition of Extra and how to parse it:
data Extra = Extra
{ extraCopyright :: Text
, extraAnalytics :: Maybe Text -- ^ Google Analytics
} deriving Show
parseExtra :: DefaultEnv -> Object -> Parser Extra
parseExtra _ o = Extra
<$> o .: "copyright"
<*> o .:? "analytics"
You can add the extra data you want to this structure and parse it there. From the rest of your app, you can access this value with getExtra (defined in Foundation.hs).
You're a bit confused about the types of getExtra and extraAdmins.
I'm guessing they're like this:
getExtra :: Handler Extra
extraAdmins :: Extra -> [Text] -- maybe?
If so, something like this should work:
isAdmin :: User -> Handler Bool
isAdmin u = do
extra <- getExtra
return $ userIdent u `elem` extraAdmins extra
Related
In Maguire's Thinking with Types, p. 29, there's an example of how to use a promoted data constructor as a phantom parameter. Here's a module that I wrote based on the example in the book.
{-# LANGUAGE DataKinds #-}
module Main where
import Data.Maybe
import Data.Proxy
-- | The only purpose of this constructor is to give us access to its
-- promoted data constructors.
data UserType = DummyUser | Admin
-- | Give some users an administration token.
data User = User
{ userAdminToken :: Maybe (Proxy 'Admin),
name :: String
}
doSensitiveThings :: Proxy 'Admin -> IO ()
doSensitiveThings _ = putStrLn "you did something sensitive"
trustedUser :: User
trustedUser = User (Just (Proxy :: Proxy Admin)) "Trust me"
main = do
doSensitiveThings (fromJust . userAdminToken $ trustedUser)
I understand that this makes it impossible to call doSensitiveThings without an administration token. But I feel I'm missing something important.
How is the code above better than the code below?
module Main where
import Data.Maybe
data Admin = Admin
data User a = User String
doSensitiveThings :: User Admin -> IO ()
doSensitiveThings _ = putStrLn "you did something sensitive"
trustedUser :: User Admin
trustedUser = User "Trust me"
untrustedUser :: User ()
untrustedUser = User "Don't trust me"
main = do
doSensitiveThings trustedUser
-- doSensitiveThings untrustedUser -- won't compile
Well, now there's no such thing as "a User". A User Admin and a User () now have different types, so you cannot treat them the same as e.g. elements of a list:
users :: [User] -- ill-kinded!
users = [User "untrusted" :: User (), User "trusted" :: User Admin] -- ill-typed!
You also can no longer branch based on whether a user is an admin or not (remember that Haskell is type-erased!):
displayActions :: User a -> [String]
displayActions (User name) =
["Delete My Account (" ++ name ++ ")"] ++ (if isAdmin u then ["Delete Someone Else's Account"] else [])
isAdmin :: User a -> Bool -- this function can take either User Admin or User ()...
isAdmin = ??? -- ...but how's it supposed to branch on that?
So maybe try
data SomeUser = SomeAdmin (User Admin) | SomeNormalUser (User ())
But now we're basically doing the same thing in your first example (where User Admin becomes the token type instead of Proxy Admin) except it's just worse. There's just a lot code noise.
name :: SomeUser -> String -- having to write your own accessor functions over pattern matching/record fields; ew
name (SomeAdmin (User x)) = x
name (SomeNormalUser (User x)) = x -- ugly pattern matching and same code twice; ew
isAdmin :: SomeUser -> Bool
isAdmin (SomeAdmin _) = True
isAdmin _ = False
displayActions :: SomeUser -> [String] -- having both SomeUser and User instead of just one type and having to know which one to use in any given situation; ew
displayActions u =
["Delete My Account (" ++ name u ++ ")"] ++ (if isAdmin u then ["Delete Someone Else's Account"] else [])
I do see something wrong with the original, and I believe it's what confused you. The "only" "good thing" in the original code is the existence of the token type. Using Proxy with a type parameter to construct the token type instead of doing
data AdminToken = AdminToken
is (IMO) pointless and confusing (both for understanding the technique and also in the resulting code). The type parameter is irrelevant to what makes the idea good, and you gain nothing by keeping the type parameter and not the token. I consider the following to be an actual improvement to the original while keeping its good idea.
data User = { userAdminToken :: Maybe AdminToken; userName :: String }
isAdmin :: User -> Bool
isAdmin = isJust . userAdminToken
displayActions :: User -> [String]
displayActions u
["Delete My Account (" ++ userName u ++ ")"] ++ (if isAdmin u then ["Delete Someone Else's Account"] else [])
With the original code, you can write:
trustedUser = User (Just Proxy) "trusted"
untrustedUser = User Nothing "untrusted"
twoUsers :: [User] -- or Map Username User or whatever
twoUsers = [trustedUser, untrustedUser]
You can't make a similar twoUsers list with the second code snippet, because your trusted and untrusted users have different types.
I'm new to Haskell so apologies in advance for the potentially stupid question.
I'd like to build a data structure that is constructed from two http requests in my application.
My first request gets a basic list of users which I could choose to decode to Maybe [User]
r <- getWith opts "https://www.example.com/users"
let users = decode $ r ^. responseBody :: Maybe [User]
But if I'd like to enrich my user data by calling a second endpoint for each of the users that respond by doing something like
r2 <- getWth opts "https://www.example.com/users/{userid}/addresses"
let enrichedUser = decode $ r2 ^. responseBody :: Maybe EnrichedUser
I can't quite piece these parts together at the minute. I'm in a do block thats expecting an IO ()
Any help would be appreciated!
I'm assuming that the type of enrichedUser is supposed to be Maybe EnrichedUser and not Maybe [EnrichedUser], right?
If so, after extracting the [User] list from users :: Maybe [User], the problem you're facing is running a monadic action (to fetch the web page) for each User. There's a handy combinator for this in Control.Monad:
mapM :: (Monad m) => (a -> m b) -> ([a] -> m [b])
which can be specialized in your situation to:
mapM :: (User -> IO EnrichedUser) -> ([User] -> IO [EnrichedUser])
This says, if you know how to write a function that takes a User and creates an IO action that will create an EnrichedUser, you can use mapM to turn this into a function that takes a list [User] and creates an IO action to create a whole list [EnrichedUser].
In your application, I imagine the former function would look something like:
enrich :: User -> IO EnrichedUser
enrich u = do
let opts = ...
let url = "https://www.example.com/users/"
++ userToUserID u ++ "/addresses"
r2 <- getWith opts url
let Just enrichedUser = decode $ r2 ^. responseBody
return enrichedUser
where decode = ...
and then you can write (in your IO do-block):
r <- getWith opts "https://www.example.com/users"
let Just users = decode $ r ^. responseBody
enrichedUsers <- mapM enrich users
-- here, enrichedUsers :: [EnrichedUser]
...etc...
I've omitted the Maybe processing here for simplicity. If enriching fails, you probably want to somehow coerce a regular User into a default EnrichedUser anyway, so you'd modify the bottom of the enrich function to read:
let enrichedUser = case decode $ r2 ^. responseBody of
Nothing -> defaultEnrichment u
Just e -> e
return enrichedUser
and everything else would stay the same.
I am developing my first application with Yesod and I am creating some CRUD api to start.
I have a model that looks like
User json
...
Activity json
userId UserId
...
where userId is a foreign key.
I need to create an endpoint to be able to create a new Activity and the client needs to be able to specify the userId.
To do this I am using a form like
postCreateActivityR :: Hadler Value
postCreateActivityR = do
activity <- runInputPost $ Activity
<$> ...
<*> ireq textField "userId"
...
Doing so I get an error like the following:
Couldn't match type ‘Text’ with ‘Key User’ expected type: FormInput (HandlerT App IO) (Key User)
Is there a standard way to solve this?
If you are working with a SQL backend, there is toSqlKey in Database.Persist.Sql module. Since you are given Text, you first need to convert it into Int64 using Data.Text.Read.
For the records, this is how I solved it in the end
I had to create a new field
userIdField :: (Monad m, RenderMessage (HandlerSite m) FormMessage) => Field m UserId
userIdField = Field
{ fieldParse = parseHelper $ \s ->
case signed decimal s of
Right (a, "") -> Right $ toSqlKey a
_ -> Left $ MsgInvalidInteger s
, fieldView = \_ _ _ _ _ -> ""
, fieldEnctype = UrlEncoded
}
and then use it like
<*> ireq userIdField "userId"
I am having issues with types matching up in persistent. I have a module called Storage.Mongo like so:
type FieldMap = Map.Map T.Text T.Text
let mongoSettings = (mkPersistSettings (ConT ''MongoBackend)) {mpsGeneric = False}
in share [mkPersist mongoSettings] [persistLowerCase|
Notice
rawData FieldMap
deriving Show
|]
-- | This is the default database pool
defaultPool = createMongoDBPool
"system_of_record"
"localhost"
(PortNumber 33107)
(Just (MongoAuth "reader" "password"))
10
10
30
-- | Save notice to database
saveNotices x = do pool <- defaultPool
runMongoDBPoolDef save pool
where save = mapM_ (insert.Notice) x
I am trying to pass the saveNotices command a field map, which it will convert to a Notice entity and save to a MongoDb database. To wit:
main = do files <- getArgs
mapM_ parseNotice files
where parseNotice f = do x <- parseFromFile fboFile f
case x of
Left err -> print err
Right notices -> mapM_ saveNotices notices
The parseNotice function returns a list of Maps:
notice = do noticeType <- openingTag
fields <- manyTill (try complexField <|> simpleField) (try closingTag)
return $ (Map.fromList(concat ([("NOTICETYPE", noticeType)]:fields)))
fboFile = many notice
I am not sure where the problem is. I believe I should let the compiler the know the type of
mapM_ (insert.Notice) x
is, but I am not sure what the type should be
This is the error I am getting
Couldn't match type 'PersistEntityBackend Notice' with 'MongoBackend' Expected type: PersistEntityBackend Notice Actual type: PersistMonadBackend (Action m) In the first argument of '(.)', namely 'insert' In the first argument of 'mapM_', namely '(insert . Notice)' In the expression: mapM_ (insert . Notice) x
It is failing trying to apply insert . Notice (space added for emphasis)
insert :: MonadIO' m => Collection -> Document -> Action m Value
type Collection = Text
It looks like insert expects a name as its first argument. The following might work.
mapM_ (insert "Notice" $ Notice) x
Would it be possible to give checkM the following type instead:
checkM :: RenderMessage master msg =>
(a -> GHandler sub master (Either msg b)) ->
Field sub master a -> Field sub master b
The reason is the following:
I have a form that asks for a user name. Using checkM, I immediately look up in the database whether the entered user exists:
userField = checkM userexists textField
userexists input = do
mbuser <- runDB $ getBy $ UniqueName input
return $ case mbuser of
Nothing -> Left ("This user does not exist!" :: Text)
(Just (Entity uid _)) -> Right input
-- I would like to write "return Right uid" above!
However, I can only return input::Text, so right after the form has accepted the user input, I need to do another database lookup for the same name to get the database key for that user, which is what I really wanted.
(This example is largely simplified. Essentially, I want to get the database keys for a series of different user inputs (all in one form), which I can only ask as TextFields, or not?)
The reason the type signature looks that way is that there are two aspects to a Field: how you parse it, and how you render it. checkM only changes how you parse the field, but the rendering function (fieldView) remains unmodified. Therefore, the value needs to keep the same type.
The simplest way I can think of to get the behavior you want is to have a function which can get a value of the old type from a value of the new type. That way, given a new value, we can just apply that function to it and get the old value for rendering purposes. Here's what the code would look like:
checkM' :: RenderMessage master msg
=> (a -> GHandler sub master (Either msg b))
-> (b -> a)
-> Field sub master a
-> Field sub master b
checkM' f inv field = field
{ fieldParse = \ts -> do
e1 <- fieldParse field ts
case e1 of
Left msg -> return $ Left msg
Right Nothing -> return $ Right Nothing
Right (Just a) -> fmap (either (Left . SomeMessage) (Right . Just)) $ f a
, fieldView = \i n a eres req -> fieldView field i n a (fmap inv eres) req
}
So in your case, you could use it by changing the last line in userexists to:
(Just (Entity uid _)) -> Right (input, uid)
and then defining userField as
userField = checkM' userexists fst textField
I think a function like checkM makes sense to include in yesod-form, but hopefully with a better name ;).