According to this topic: https://stackoverflow.com/questions/14494922/examples-of-websocket-usage-in-haskell I have my first question. Why official example of WebSockets library doesn't run on my machine?
import Data.Char (isPunctuation, isSpace)
import Data.Monoid (mappend)
import Data.Text (Text)
import Control.Exception (fromException)
import Control.Monad (forM_, forever)
import Control.Concurrent (MVar, newMVar, modifyMVar_, readMVar)
import Control.Monad.IO.Class (liftIO)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Network.WebSockets
meow :: TextProtocol p => WebSockets p ()
meow = forever $ do
msg <- receiveData
sendTextData $ msg `T.append` ", meow."
main :: IO ()
main = runServer "0.0.0.0" 8000 meow
I get:
ciembor#freedom ~> ghc hchat.hs; and ./hchat
[1 of 1] Compiling Main ( hchat.hs, hchat.o )
hchat.hs:15:35:
Couldn't match expected type `Text' with actual type `[Char]'
In the second argument of `T.append', namely `", meow."'
In the second argument of `($)', namely `msg `T.append` ", meow."'
In a stmt of a 'do' block: sendTextData $ msg `T.append` ", meow."
hchat.hs:18:33:
Couldn't match expected type `Request -> WebSockets p0 ()'
with actual type `WebSockets p1 ()'
In the third argument of `runServer', namely `meow'
In the expression: runServer "0.0.0.0" 8000 meow
In an equation for `main': main = runServer "0.0.0.0" 8000 meow
The first error is because you didn't enable the OverloadedStrings language extension. Without that, a "xyz" is a String, but Data.Text.append takes two Texts as arguments. Add
{-# LANGUAGE OverloadedStrings #-}
to the top of the module to fix that one.
The second error is because the third argument to runServer must have type
Request -> WebSockets p0 ()
but you gave it a WebSockets p1 (). If you want to pass an action, you have to lift it to a function,
main = runServer "0.0.0.0" 8000 $ const meow
would compile (whether it would work [do what you want] is a question I cannot answer, that would just ignore all requests and always do the same thing).
Related
I need to start up my very simple webapp with Haskell's Scotty and I just can't seem to get the IO () ReaderT stuff workinng. I am basing this off of another example I found online, and am pretty new to Monads and Haskell overall.
My IDE is throwing this error:
Couldn't match expected type ‘IO t0’
with actual type ‘(m0 Network.Wai.Internal.Response
-> IO Network.Wai.Internal.Response)
-> IO ()’
• Probable cause: ‘Home.main’ is applied to too few arguments
In the expression: Home.main
When checking the type of the IO action ‘main’
It is also throwing this one but I think it should get fixed once I fixed the other one
Ambiguous occurrence ‘main’
It could refer to either ‘Home.main’,
imported from ‘Platform.Home’ at Main.hs:16:1-28
or ‘Main.main’, defined at Main.hs:28:1
I am leaving here the needed code, if there is anything else I should show please let me know.
In "Main.hs":
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Main
( main
) where
import Control.Monad (join)
import Control.Applicative ((<$>))
import Core.Item.Controller (routes)
import Core.Item.Controller as ItemController
import Core.Item.Service as ItemService
import Core.Item.DAO as ItemDAO
import Platform.Postgres as Postgres
import Platform.Home as Home
import Data.Maybe (fromMaybe)
import Network.Wai.Middleware.RequestLogger (logStdoutDev)
import Network.Wai.Middleware.Static (addBase, noDots, staticPolicy, (>->))
import System.Environment (lookupEnv)
import Text.Read (readMaybe)
import Web.Scotty (middleware, scotty)
import Language.Haskell.TH (Type(AppT))
import ClassyPrelude
main :: IO ()
main = do
pgEnv <- Postgres.init
let runner app = flip runReaderT pgEnv $ unAppT app
Home.main runner
type Environment = Postgres.Env
newtype AppT a = AppT
{ unAppT :: ReaderT Environment IO a
} deriving (Applicative, Functor, Monad, MonadIO, MonadReader Environment)
instance ItemController.Service AppT where
getItem = ItemService.getItem
getItems = ItemService.getItems
createItem = ItemService.createItem
instance ItemService.ItemRepo AppT where
findItems = ItemDAO.findItems
addItem = ItemDAO.addItem
instance ItemService.TimeRepo AppT where
currentTime = liftIO getCurrentTime
In "Postgres.hs"
type Env = Pool Connection
type Postgres r m = (MonadReader r m, Has Env r, MonadIO m)
init :: IO Env
init = do
pool <- acquirePool
migrateDb pool
return pool
And this is my "Home.hs":
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ConstraintKinds #-}
module Platform.Home
( main
) where
import ClassyPrelude (MonadIO, LText, fromMaybe, readMay)
import Web.Scotty.Trans
import Network.HTTP.Types.Status
import Network.Wai.Handler.WarpTLS (runTLS, tlsSettings)
import Network.Wai.Handler.Warp (defaultSettings, setPort)
import Network.Wai (Response)
import Network.Wai.Middleware.Cors
import qualified Core.Item.Controller as ItemController
import System.Environment (lookupEnv)
type App r m = (ItemController.Service m, MonadIO m)
main :: (App r m) => (m Response -> IO Response) -> IO ()
main runner = do
port <- acquirePort
mayTLSSetting <- acquireTLSSetting
case mayTLSSetting of
Nothing ->
scottyT port runner routes
Just tlsSetting -> do
app <- scottyAppT runner routes
runTLS tlsSetting (setPort port defaultSettings) app
where
acquirePort = do
port <- fromMaybe "" <$> lookupEnv "PORT"
return . fromMaybe 3000 $ readMay port
acquireTLSSetting = do
env <- (>>= readMay) <$> lookupEnv "ENABLE_HTTPS"
let enableHttps = fromMaybe True env
return $ if enableHttps
then Just $ tlsSettings "secrets/tls/certificate.pem" "secrets/tls/key.pem"
else Nothing
routes :: (App r m) => ScottyT LText m ()
routes = do
-- middlewares
middleware $ cors $ const $ Just simpleCorsResourcePolicy
{ corsRequestHeaders = "Authorization":simpleHeaders
, corsMethods = "PUT":"DELETE":simpleMethods
}
options (regex ".*") $ return ()
-- errors
defaultHandler $ \str -> do
status status500
json str
-- feature routes
ItemController.routes
-- health
get "/api/health" $
json True
Actually, the errors are related. In Main.hs, change the import of Home to:
import qualified Platform.Home as Home
^^^^^^^^^-- add this
and it should fix both errors. The following minimal example gives the same pair of errors:
-- contents of Home.hs
module Home where
main :: (Int -> Int) -> IO ()
main = undefined
-- contents of Main.hs
import Home
main = Home.main id
but works if you change import Home to import qualified Home.
The issue appears to be that GHC tries to type-check Home.main as the program's main function (perhaps simply because it was the first one defined, having been imported before the definition of Main.main in the body of the module), and it generates this extra error message because Home.main's type doesn't match the required signature of IO t for a main function. This happens before it gets around to noticing that there are two definitions of main (i.e., the "ambiguous occurrence" error), and it's typechecked the wrong one.
I have racy behavior with the following code
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Concurrent (threadDelay)
import qualified Control.Concurrent.Async as Async
import qualified System.Process.Typed as Proc
import qualified System.Process as P
import qualified GHC.IO.Handle as H
main :: IO ()
main = do
print "starting"
(readEnd, writeEnd) <- P.createPipe
let p1 = Proc.setStdout (Proc.useHandleClose writeEnd) "echo -n 'foo'"
let p2 = Proc.setStdin (Proc.useHandleClose readEnd) "base64 -"
Async.concurrently
(threadDelay 1000 *> Proc.runProcess_ p2) -- with the delay, it works
-- (Proc.runProcess_ p2) -- that line will make the program hang forever
(Proc.runProcess_ p1)
print "done"
I want to pipe stdout from the first subprocess to the second subprocess.
I tried using getStdout and setStdin but get into problem with the typechecker:
Proc.withProcess_ "echo -n foo" $ \r1 -> do
let p2 = Proc.setStdin (Proc.getStdout r1) "base64"
• Couldn't match expected type ‘Proc.StreamSpec
'Proc.STInput stdin0’
with actual type ‘()’
• In the first argument of ‘Proc.setStdin’, namely
‘(Proc.getStdout r1)’
In the expression: Proc.setStdin (Proc.getStdout r1) "base64"
Trying to make a HTTP request, I got the error:
{-# LANGUAGE OverloadedStrings #-}
import Network.HTTP.Conduit -- the main module
-- The streaming interface uses conduits
import Data.Conduit
import Data.Conduit.Binary (sinkFile)
import qualified Data.ByteString.Lazy as L
import Control.Monad.IO.Class (liftIO)
main :: IO ()
main = do
simpleHttp "http://www.example.com/foo.txt" >>= L.writeFile "foo.txt"
The error is:
Couldn't match type `L.ByteString'
with `bytestring-0.10.0.2:Data.ByteString.Lazy.Internal.ByteString'
Expected type: bytestring-0.10.0.2:Data.ByteString.Lazy.Internal.ByteString
-> IO ()
Actual type: L.ByteString -> IO ()
In the return type of a call of `L.writeFile'
In the second argument of `(>>=)', namely `L.writeFile "foo.txt"'
In a stmt of a 'do' block:
simpleHttp "http://www.example.com/foo.txt"
>>= L.writeFile "foo.txt"
I can't figure out how to solve it because the text of the error doesn't really make sense.
You have two conflicting versions on bytestring package. Try ghc-pkg list bytestring. I'd suggest you to cabalize your code and use cabal sandbox.
See also "Couldn't match expected type with actual type" error when using Codec.BMP
BTW, the error message should be better in ghc-7.8, see https://ghc.haskell.org/trac/ghc/ticket/8278
I am trying to write a simple program in Haskell which listens over Zero MQ socket and publishes it to websocket connection, below is my code
{-# LANGUAGE OverloadedStrings #-}
import Data.Char (isPunctuation, isSpace)
import Data.Monoid (mappend)
import Data.Text (Text)
import Control.Exception (fromException)
import Control.Monad (forM_, forever)
import Control.Concurrent (MVar, newMVar, modifyMVar_, readMVar)
import Control.Monad.IO.Class (liftIO)
import Control.Monad
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Network.WebSockets as WS
import System.ZMQ3.Monadic
import Data.ByteString.Char8 (pack, unpack)
import Control.Concurrent (threadDelay)
import Data.Text.Encoding
import Data.ByteString.Internal
main :: IO ()
main = do
liftIO $ putStrLn "starting main..."
WS.runServer "0.0.0.0" 9160 $ application
application :: WS.Request -> WS.WebSockets WS.Hybi00 ()
application rq = do
liftIO $ putStrLn "starting..."
WS.acceptRequest rq
sink <- WS.getSink
WS.getVersion >>= liftIO . putStrLn . ("Client version: " ++)
msg <- WS.receiveData
liftIO $ putStrLn $ show $ (msg:: Text)
WS.sendTextData (msg :: Text)
runZMQ $ do
repSocket<- socket Rep
s<-return $bind repSocket "tcp://*:6555"
msg2 <- receive repSocket
let quote = msg2
--msg2 <- WS.receiveData
--liftIO $ putStrLn $ quote
WS.sendTextData $ ("test"::Text)
But compiler fails at statement WS.sendTextData $ ("test"::Text) saying below error
websocket_server.hs:42:17:
Couldn't match expected type `ZMQ z a0'
with actual type `WS.WebSockets p0 ()'
In a stmt of a 'do' block: WS.sendTextData $ ("test" :: Text)
In the second argument of `($)', namely
`do { repSocket <- socket Rep;
s <- return $ bind repSocket "tcp://*:6555";
msg2 <- receive repSocket;
let quote = msg2;
.... }'
In a stmt of a 'do' block:
runZMQ
$ do { repSocket <- socket Rep;
s <- return $ bind repSocket "tcp://*:6555";
msg2 <- receive repSocket;
let quote = msg2;
.... }
I am not sure how to deal with this issue how can I make do block statements return same value when the values cannot be converted into each other?
A simple liftIO should be enough for that call, but I haven't tried.
The trouble is that both the ZMQ and Websockets libraries define a "top level monad" that is not a monad transformer. So there is no provided way to layer the monads. This is poor design on their parts.
My suggestion would be to A) write your own ZMQ transformer or B) use the nonmonadic interface provided by ZMQ at the top level.
Did lot of packing, unpacking and etc playing with Strings and Texts and still stuck,
the goal is simple as hello world with extra request info concatenated:
{-# LANGUAGE OverloadedStrings #-}
import Network.Wai
import Network.Wai.Handler.Warp (run)
import Network.HTTP.Types (statusOK)
import qualified Data.ByteString.Lazy as L
import Data.ByteString.Char8 (unpack)
import qualified Data.Text.Lazy as T
application req = do
return $ responseLBS statusOK [("Content-Type", "text/plain")]
$ L.pack $ "Hello World" ++ (unpack $ rawPathInfo req)
main = run 3000 application
produces:
Couldn't match expected type `GHC.Word.Word8'
against inferred type `Char'
Expected type: [GHC.Word.Word8]
Inferred type: [Char]
In the second argument of `(++)', namely
`(unpack $ rawPathInfo req)'
In the second argument of `($)', namely
`"Hello World" ++ (unpack $ rawPathInfo req)
Eagerly need hint how to make it work.
Use Data.ByteString.Lazy.Char8.pack instead of L.pack.
That's a lot of packing and unpacking. I don't have wai installed, so I can't test, but something like this should be simpler:
application req = do
return $ responseLBS statusOK [("Content-Type", "text/plain")]
$ L.append "Hello World" $ rawPathInfo req
i.e. simply use ByteString's append rather than String's (++).