I have a simple snaplet, which has its own routing and pretty much independent of the whole application behavior. However, as for most of the application, I want to hide the new simple snaplet under the restricted area, where only logged in users can enter.
For the root snaplet the problem solved by using simple function restricted which accepts a handler and checks if the user logged in, proceeding further with the given handler or redirecting to the login screen.
Here is the whole configuration:
appInit :: SnapletInit App App
appInit = makeSnaplet "myapp" "My Example Application" Nothing $ do
fs <- nestSnaplet "foo" foo fooInit
ss <- nestSnaplet "sess" sess $
initCookieSessionManager "site_key.txt" "sess" (Just 3600)
as <- nestSnaplet "auth" auth $
initJsonFileAuthManager defAuthSettings sess "users.json"
addRoutes [("content", restricted $ render "content"),
("login", login)]
return $ App ss as fs
restricted :: Handler App App () -> Handler App App ()
restricted = requireUser auth (redirect "/login")
fooInit :: SnapletInit b Foo
fooInit = makeSnaplet "foo" "A nested snaplet" Nothing $ do
addRoutes [("info", writeText "Only registered users can have acess to it")]
return Foo
If I enter http://mywebsite/foo/info, I will be able to see the content of the subsnaplet without logging it. It seems to me, that I cannot protect all of the handlers implemented inside of my new Foo without changing that snaplet and modifying its routing. Or am I wrong?
P.S.: There is an option to use weapSite and check the request URL, but since it implies verification based on URL, not on the recourse, (handler in this case) it doesn't seem right to me.
The answer here is to use the wrapSite function. It takes an argument (Handler b v () -> Handler b v ()), which is exactly the type signature of your restricted function.
Related
My Yesod-Application should get it's approot via an Envoirement-Variable. This seems describe exactly this situation. But: When doing so, only links generated by Yesod will consider the approot, but the Route-definitions in the Quasiquoter parseRoutes will stay absolute:
mkYesod "App" [parseRoutes|
/ HomeR GET
|]
So setting APPROOT to "domain.com/path" will not work, since there's no route for "/path" but only for "/".
Is there a way to make the routes relative to the approot?
Update:
I tried to modify cleanPath accordingly too, but Routes to the Home-Route are still wrong…
instance Yesod Browser where
approot = ApprootMaster myApproot
cleanPath site s = do
if corrected == s
then Right $ dropprefix (Data.List.map dropDash s)
else Left $ dropprefix corrected
where
corrected = Data.List.filter (not . Data.Text.null) s
dropDash t
| Data.Text.all (== '-') t = Data.Text.drop 1 t
| otherwise = t
r = Data.Text.drop 1 $ myApproot site
l = Data.Text.length r
dropprefix l
| Data.List.take 1 l == [r] = Data.List.drop 1 l
| otherwise = l
If I set approot to "/foo" it works, except for "#{HomeR}" leading to "/foo/" which redirects to "/foo/foo"…
It's not completely clear what problem you're running into. I think what you're saying is, if you simply set APPROOT, then:
The URLs generated by Yesod will include the /path prefix
But incoming requests with the /path prefix will not be parsed correctly
The usual use case for this kind of prefix is that you have a reverse proxy in front of your app, such as Apache or Nginx, which is delegating only part of the domain to your app. In this case: APPROOT works fine.
I'm not sure what other use case you're trying to address, but in general you can just drop a part of the request path by overriding the cleanPath method. Or you could use a WAI middleware to modify the request itself if you wanted.
I'm trying to make the chat example from the Yesod book working in the scaffolding site.
I think I've corrected almost all I had to correct, but all of that is completely new to me (it's my first "real" Haskell project) and I'm not very confident in all my modifications; moreover, I'm really stuck at the point 7. Could you comment all the following points if necessary, and helping me for the 7. (in bold some questions/remarks)?
Copy/paste the Chat.hs and Chat/Data.hs in the root of my site,
add import Chat as Import and import Chat.Data as Import to Import.NoFoundation,
add import of IO, Bool, return, Maybe(Nothing), ($) in Data.hs, since the extension NoImplicitPrelude is on Seems very clumsy... Do we have to import all the standard operators on each new file?
in Fundation.hs, add getChat in the App record (after appHttpManager and appLogger)
in Fundation.hs, add YesodChat instance for App: I had to modify the getUserName on the Just uid case (in the original example of Chat, it was just Just uid -> return uid):
Just uid -> do
muser <- runDB $ get uid
case muser of
Nothing -> error "uid not in the DB"
Just user -> return $ userIdent user
This seems very long and nested... Can we do better?
In Fundation.hs, add chatWidget ChatR after the line pc <- widgetToPageContent $ do in the defaultLayout definition.
Now, I have the following warning :
Application.hs:60:36: Warning:
Fields of ‘App’ not initialised: getChat
In the expression: App {..}
I think I have to write something like getChat <- newChan >>=Chat after the appLogger <- newStdoutLoggerSet defaultBufSize >>= makeYesodLogger and appStatic <- ... in the makeFundation definition, but the type doesn't match. I'm a totally lost here, I don't really understand how this function makeFundation works.
You actually got almost the entire way there. I think you just need to change the line to:
getChat <- fmap Chat newChan
Alternatively, if you're not familiar with he fmap function yet, you can use do notation and get:
chan <- newChan
let getChat = Chat chan
I have an acid-state backend that complements my snap website. It is running in its own process and my snap web server requires an IP address to connect to it. For debugging and deployment purposes I would like to be able to pass in the IP address as a command line argument when running my compiled snap application. This IP address would be accessible inside the SnapletInit monad where the acid state handler gets called.
How can I extend the command line parameter system in Snap to account for this?
Ideally, I'd like something like.
./app -ip 192.168.0.2 -p 8080 -e prod +RTS -I0 -A4M -qg1
Then apply it like this.
app :: SnapletInit App App
app = makeSnaplet "app" "Snapplication" Nothing $ do
ip <- getConfig "ip"
d <- nestSnaplet "acid" acid $ acidInitRemote ip
return $ App d
I would recommend changing the Acid State snaplet to read it's IP from a config instead of the command line. The configs in Snap are set up so that it'll load whatever you pass as the -e argument on the command line. For example, starting with -e prod will load snaplet/acidstate/prod.conf and starting with no -e or -e devel will load snaplet/acidstate/devel.conf. This helps keep all your environmental settings together instead of allowing any possible combination of command line flags.
Here's an example from one of my snaplets:
initStripe :: SnapletInit b StripeState
initStripe = makeSnaplet "stripe" "Stripe credit card payment" Nothing $ do
config <- getSnapletUserConfig
(stripeState, errors) <- runWriterT $ do
secretKey <- logErr "Must specify Strip secret key" $ C.lookup config "secret_key"
publicKey <- logErr "Must specify Strip public key" $ C.lookup config "public_key"
clientId <- logErr "Must specify Strip client ID" $ C.lookup config "client_id"
version <- Just . maybe V20110915d OtherVersion <$> liftIO (C.lookup config "version")
let caFilePath = Just "" -- This is unused by Stripe but vestigial in the Haskell library.
return $ StripeState <$> (StripeConfig <$> (SecretKey <$> secretKey) <*> caFilePath <*> version) <*> (PublicKey <$> publicKey) <*> clientId
return $ fromMaybe (error $ intercalate "\n" errors) stripeState
Check out snap-server's Config module. Specifically, extendedCommandLineConfig.
You could use getEnv, lookupEnv or getArgs from System.Environment
Personally, I'd go with the ENV variables approach.
I wrote a CRUD application to interface with JIRA. I ended up upgrading my haskell enviornment, because cabal-dev doesn't solve everything. As a result, I've got some breakage, with this error anytime I try to use any code that interfaces with JIRA.
Spike: HandshakeFailed (Error_Misc "user error (unexpected type received. expecting
handshake and got: Alert [(AlertLevel_Warning,UnrecognizedName)])")
After a little googling, I think this either has to do with tls or http-conduit which uses tls.
I'm currently using tls-1.1.2 and http-conduit-1.8.7.1
previously I was using
tls-0.9.11 and http-conduit >= 1.5 && < 1.7 (not sure which exactly, old install is gone.
This is where I believe the break is happening
manSettings :: ManagerSettings
manSettings = def { managerCheckCerts = \ _ _ _-> return CertificateUsageAccept }
this is what it used to look like
manSettings :: ManagerSettings
manSettings = def { managerCheckCerts = \ _ _ -> return CertificateUsageAccept }
Here's the code that uses it
initialRequest :: forall (m :: * -> *). URI -> IO (Request m,Manager)
initialRequest uri = do
initReq <- parseUrl uri -- let the server tell you what the request header
-- should look like
manager <- newManager manSettings -- a Manager manages http connections
-- we mod the settings to handle
-- the SSL cert. See manSettings below.
return (modReq initReq,manager)
where modReq initReq = applyBasicAuth username password initReq
Let me know if I'm left something out. I'm not sure at this point what broke between then and now.
It's a good guess about the error source, but very unlikely: managerCheckCerts simply uses the certificate package to inspect certificates for validity. The error message you're seeing seems to be coming from tls itself and indicates a failure in the data transport. It's probably a good idea to file a bug report with tls, preferably first by narrowing down the issue to a single HTTPS call that fails (or even better, using tls alone and demonstrating the same failure).
So here i was, barely able to install the libzmq on a windows desktop and then zeromq-haskell with cabal. I wanted to test the api by binding a python program with a haskell program in a hello-world type application.
So the most basic pattern i see is the request-reply pattern . First i tried to make the server in haskell (REP) and the client in python (REQ), witch failed miserably no matter what i did. The generated exception message was Exception: receive: failed (No error).
So i look inside the System.ZMQ and System.ZMQ.Base source code and i see that receive throws an error on calling c_zmq_recv , witch in turn maps directly to a ffi (?) call to the C api. So i think perhaps i didn't do the installation properly , but then i try to make the client in Haskell and the server in python and i notice it works without any problem, so perhaps the recv interface isn't the problem here.
Here is the haskell code below , with both client and server functions
import System.ZMQ
import Control.Monad (forM_,forever)
import Data.ByteString.Char8 (pack,unpack)
import Control.Concurrent (threadDelay)
clientMain :: IO ()
clientMain = withContext 1 (\context->do
putStrLn "Connecting to server"
withSocket context Req $ (\socket-> do
connect socket "tcp://127.0.0.1:5554"
putStrLn $ unwords ["Sending request"]
send socket (pack "Hello...") []
threadDelay (1*1000*1000)
reply<-receive socket []
putStrLn $ unwords ["Received response : ",unpack reply]))
serverMain :: IO ()
serverMain = withContext 1 (\context-> do
putStrLn "Listening at 5554"
withSocket context Rep $ (\socket-> do
connect socket "tcp://127.0.0.1:5554"
forever $ do
message<-receive socket [] -- this throws an IO Exception
putStrLn $ unwords ["Received request : ",unpack message]
threadDelay (1*1000*1000)
send socket (pack "World") [] ))
main :: IO ()
main = serverMain -- replace with clientMain and it works
Now i really didn't get around to testing all other modes of communication (push/pull, subscribe/publish, pair etc.) and for what i need the python server/haskell client is probably better but i am curious about weather i'm doing something wrong or if any part of my code is broken in any way.
Thanks in advance
You need to make one of the sockets (usually the server) bind, you seem to have them both connecting.
Try changing connect socket "tcp://127.0.0.1:5554" to bind socket "tcp://127.0.0.1:5554" in the serverMain function.