Remove servant-examples
This commit is contained in:
Julian K. Arni
parent
637de9d63f
commit
c23a5ce90e
23 changed files with 0 additions and 1038 deletions
|
|
@ -1 +0,0 @@
|
|||
../servant-examples/tutorial
|
||||
|
|
@ -1,30 +0,0 @@
|
|||
Copyright (c) 2015-2016, Servant Contributors
|
||||
|
||||
All rights reserved.
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
|
||||
* Redistributions of source code must retain the above copyright
|
||||
notice, this list of conditions and the following disclaimer.
|
||||
|
||||
* Redistributions in binary form must reproduce the above
|
||||
copyright notice, this list of conditions and the following
|
||||
disclaimer in the documentation and/or other materials provided
|
||||
with the distribution.
|
||||
|
||||
* Neither the name of Alp Mestanogullari nor the names of other
|
||||
contributors may be used to endorse or promote products derived
|
||||
from this software without specific prior written permission.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
||||
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
|
||||
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
|
||||
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
||||
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
|
||||
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
|
||||
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
|
||||
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
||||
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
import Distribution.Simple
|
||||
main = defaultMain
|
||||
|
|
@ -1,96 +0,0 @@
|
|||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
import Data.Aeson
|
||||
import Data.ByteString (ByteString)
|
||||
import Data.IORef
|
||||
import Data.Text (Text)
|
||||
import GHC.Generics
|
||||
import Network.Wai
|
||||
import Network.Wai.Handler.Warp
|
||||
import Servant
|
||||
import Servant.Server.Internal
|
||||
|
||||
-- Pretty much stolen/adapted from
|
||||
-- https://github.com/haskell-servant/HaskellSGMeetup2015/blob/master/examples/authentication-combinator/AuthenticationCombinator.hs
|
||||
|
||||
type DBConnection = IORef [ByteString]
|
||||
type DBLookup = DBConnection -> ByteString -> IO Bool
|
||||
|
||||
initDB :: IO DBConnection
|
||||
initDB = newIORef ["good password"]
|
||||
|
||||
isGoodCookie :: DBLookup
|
||||
isGoodCookie ref password = do
|
||||
allowed <- readIORef ref
|
||||
return (password `elem` allowed)
|
||||
|
||||
data AuthProtected
|
||||
|
||||
instance (HasConfigEntry config DBConnection, HasServer rest config)
|
||||
=> HasServer (AuthProtected :> rest) config where
|
||||
|
||||
type ServerT (AuthProtected :> rest) m = ServerT rest m
|
||||
|
||||
route Proxy config subserver = WithRequest $ \ request ->
|
||||
route (Proxy :: Proxy rest) config $ addAcceptCheck subserver $ cookieCheck request
|
||||
where
|
||||
cookieCheck req = case lookup "Cookie" (requestHeaders req) of
|
||||
Nothing -> return $ FailFatal err401 { errBody = "Missing auth header" }
|
||||
Just v -> do
|
||||
let dbConnection = getConfigEntry config
|
||||
authGranted <- isGoodCookie dbConnection v
|
||||
if authGranted
|
||||
then return $ Route ()
|
||||
else return $ FailFatal err403 { errBody = "Invalid cookie" }
|
||||
|
||||
type PrivateAPI = Get '[JSON] [PrivateData]
|
||||
|
||||
type PublicAPI = Get '[JSON] [PublicData]
|
||||
|
||||
type API = "private" :> AuthProtected :> PrivateAPI
|
||||
:<|> PublicAPI
|
||||
|
||||
newtype PrivateData = PrivateData { ssshhh :: Text }
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
instance ToJSON PrivateData
|
||||
|
||||
newtype PublicData = PublicData { somedata :: Text }
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
instance ToJSON PublicData
|
||||
|
||||
api :: Proxy API
|
||||
api = Proxy
|
||||
|
||||
server :: Server API
|
||||
server = return prvdata :<|> return pubdata
|
||||
|
||||
where prvdata = [PrivateData "this is a secret"]
|
||||
pubdata = [PublicData "this is a public piece of data"]
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
dbConnection <- initDB
|
||||
let config = dbConnection :. EmptyConfig
|
||||
run 8080 (serve api config server)
|
||||
|
||||
{- Sample session:
|
||||
$ curl http://localhost:8080/
|
||||
[{"somedata":"this is a public piece of data"}]
|
||||
$ curl http://localhost:8080/private
|
||||
Missing auth header.
|
||||
$ curl -H "Cookie: good password" http://localhost:8080/private
|
||||
[{"ssshhh":"this is a secret"}]
|
||||
$ curl -H "Cookie: bad password" http://localhost:8080/private
|
||||
Invalid cookie.
|
||||
-}
|
||||
|
|
@ -1,90 +0,0 @@
|
|||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
|
||||
import Control.Applicative
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Monad.Trans.Except
|
||||
import Data.Aeson
|
||||
import Data.Monoid
|
||||
import Data.Proxy
|
||||
import Data.Text (Text)
|
||||
import GHC.Generics
|
||||
import Network.HTTP.Client (Manager, defaultManagerSettings,
|
||||
newManager)
|
||||
import System.IO.Unsafe (unsafePerformIO)
|
||||
import Servant.API
|
||||
import Servant.Client
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
|
||||
type HackageAPI =
|
||||
"users" :> Get '[JSON] [UserSummary]
|
||||
:<|> "user" :> Capture "username" Username :> Get '[JSON] UserDetailed
|
||||
:<|> "packages" :> Get '[JSON] [Package]
|
||||
|
||||
type Username = Text
|
||||
|
||||
data UserSummary = UserSummary
|
||||
{ summaryUsername :: Username
|
||||
, summaryUserid :: Int
|
||||
} deriving (Eq, Show)
|
||||
|
||||
instance FromJSON UserSummary where
|
||||
parseJSON (Object o) =
|
||||
UserSummary <$> o .: "username"
|
||||
<*> o .: "userid"
|
||||
|
||||
parseJSON _ = mzero
|
||||
|
||||
type Group = Text
|
||||
|
||||
data UserDetailed = UserDetailed
|
||||
{ username :: Username
|
||||
, userid :: Int
|
||||
, groups :: [Group]
|
||||
} deriving (Eq, Show, Generic)
|
||||
|
||||
instance FromJSON UserDetailed
|
||||
|
||||
newtype Package = Package { packageName :: Text }
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
instance FromJSON Package
|
||||
|
||||
hackageAPI :: Proxy HackageAPI
|
||||
hackageAPI = Proxy
|
||||
|
||||
|
||||
{-# NOINLINE manager #-}
|
||||
manager :: Manager
|
||||
manager = unsafePerformIO $ newManager defaultManagerSettings
|
||||
|
||||
getUsers :: ExceptT ServantError IO [UserSummary]
|
||||
getUser :: Username -> ExceptT ServantError IO UserDetailed
|
||||
getPackages :: ExceptT ServantError IO [Package]
|
||||
getUsers :<|> getUser :<|> getPackages =
|
||||
client hackageAPI (BaseUrl Http "hackage.haskell.org" 80 "") manager
|
||||
|
||||
main :: IO ()
|
||||
main = print =<< uselessNumbers
|
||||
|
||||
uselessNumbers :: IO (Either ServantError ())
|
||||
uselessNumbers = runExceptT $ do
|
||||
users <- getUsers
|
||||
liftIO . putStrLn $ show (length users) ++ " users"
|
||||
|
||||
user <- liftIO $ do
|
||||
putStrLn "Enter a valid hackage username"
|
||||
T.getLine
|
||||
userDetailed <- getUser user
|
||||
liftIO . T.putStrLn $ user <> " maintains " <> T.pack (show (length $ groups userDetailed)) <> " packages"
|
||||
|
||||
packages <- getPackages
|
||||
let monadPackages = filter (isMonadPackage . packageName) packages
|
||||
liftIO . putStrLn $ show (length monadPackages) ++ " monad packages"
|
||||
|
||||
where isMonadPackage = T.isInfixOf "monad"
|
||||
|
|
@ -1,8 +0,0 @@
|
|||
#if __GLASGOW_HASKELL__ >= 710
|
||||
#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
|
||||
#define OVERLAPPING_ {-# OVERLAPPING #-}
|
||||
#else
|
||||
{-# LANGUAGE OverlappingInstances #-}
|
||||
#define OVERLAPPABLE_
|
||||
#define OVERLAPPING_
|
||||
#endif
|
||||
|
|
@ -1,130 +0,0 @@
|
|||
name: servant-examples
|
||||
version: 0.5
|
||||
synopsis: Example programs for servant
|
||||
description: Example programs for servant,
|
||||
showcasing solutions to common needs.
|
||||
homepage: http://haskell-servant.github.io/
|
||||
license: BSD3
|
||||
license-file: LICENSE
|
||||
author: Servant Contributors
|
||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||
copyright: 2015-2016 Servant Contributors
|
||||
category: Web
|
||||
build-type: Simple
|
||||
cabal-version: >=1.10
|
||||
bug-reports: http://github.com/haskell-servant/servant/issues
|
||||
source-repository head
|
||||
type: git
|
||||
location: http://github.com/haskell-servant/servant.git
|
||||
|
||||
executable tutorial
|
||||
main-is: tutorial.hs
|
||||
other-modules: T1, T2, T3, T4, T5, T6, T7, T8, T9, T10
|
||||
ghc-options: -Wall -fno-warn-unused-binds -fno-warn-name-shadowing -fno-warn-orphans -fno-warn-unused-imports
|
||||
build-depends:
|
||||
aeson >= 0.8
|
||||
, base >= 4.7 && < 5
|
||||
, bytestring
|
||||
, directory
|
||||
, http-types
|
||||
, js-jquery
|
||||
, lucid
|
||||
, random
|
||||
, servant == 0.5.*
|
||||
, servant-docs == 0.5.*
|
||||
, servant-js == 0.5.*
|
||||
, servant-lucid == 0.5.*
|
||||
, servant-server == 0.5.*
|
||||
, text
|
||||
, time
|
||||
, transformers
|
||||
, transformers-compat
|
||||
, wai
|
||||
, warp
|
||||
hs-source-dirs: tutorial
|
||||
default-language: Haskell2010
|
||||
|
||||
executable t8-main
|
||||
main-is: t8-main.hs
|
||||
other-modules: T3, T8
|
||||
hs-source-dirs: tutorial
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall -fno-warn-unused-binds -fno-warn-name-shadowing
|
||||
build-depends:
|
||||
aeson
|
||||
, base >= 4.7 && < 5
|
||||
, http-client > 0.4 && < 0.5
|
||||
, servant == 0.5.*
|
||||
, servant-client == 0.5.*
|
||||
, servant-server == 0.5.*
|
||||
, transformers
|
||||
, transformers-compat
|
||||
, wai
|
||||
|
||||
executable hackage
|
||||
main-is: hackage.hs
|
||||
build-depends:
|
||||
aeson >= 0.8
|
||||
, base >=4.7 && < 5
|
||||
, http-client > 0.4 && < 0.5
|
||||
, servant == 0.5.*
|
||||
, servant-client == 0.5.*
|
||||
, text
|
||||
, transformers
|
||||
, transformers-compat
|
||||
hs-source-dirs: hackage
|
||||
default-language: Haskell2010
|
||||
|
||||
executable wai-middleware
|
||||
main-is: wai-middleware.hs
|
||||
build-depends:
|
||||
aeson >= 0.8
|
||||
, base >= 4.7 && < 5
|
||||
, servant == 0.5.*
|
||||
, servant-server == 0.5.*
|
||||
, text
|
||||
, wai
|
||||
, wai-extra
|
||||
, warp
|
||||
hs-source-dirs: wai-middleware
|
||||
default-language: Haskell2010
|
||||
|
||||
executable auth-combinator
|
||||
main-is: auth-combinator.hs
|
||||
ghc-options: -Wall -fno-warn-unused-binds -fno-warn-name-shadowing
|
||||
build-depends:
|
||||
aeson >= 0.8
|
||||
, base >= 4.7 && < 5
|
||||
, bytestring
|
||||
, http-types
|
||||
, servant == 0.5.*
|
||||
, servant-server == 0.5.*
|
||||
, text
|
||||
, wai
|
||||
, warp
|
||||
hs-source-dirs: auth-combinator
|
||||
default-language: Haskell2010
|
||||
|
||||
executable socket-io-chat
|
||||
main-is: socket-io-chat.hs
|
||||
ghc-options: -Wall -fno-warn-unused-binds -fno-warn-name-shadowing
|
||||
other-modules: Chat
|
||||
build-depends:
|
||||
aeson >= 0.8
|
||||
, base >= 4.7 && < 5
|
||||
, bytestring
|
||||
, http-types
|
||||
, servant == 0.5.*
|
||||
, servant-server == 0.5.*
|
||||
, socket-io
|
||||
, engine-io
|
||||
, engine-io-wai
|
||||
, text
|
||||
, wai
|
||||
, warp
|
||||
, transformers
|
||||
, stm
|
||||
, mtl
|
||||
ghc-options: -Wall -O2 -threaded
|
||||
hs-source-dirs: socket-io-chat
|
||||
default-language: Haskell2010
|
||||
|
|
@ -1,109 +0,0 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE KindSignatures #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
|
||||
module Chat (eioServer, ServerState (..)) where
|
||||
|
||||
import Prelude hiding (mapM_)
|
||||
|
||||
#if !MIN_VERSION_base(4,8,0)
|
||||
import Control.Applicative ((<$>), pure)
|
||||
#endif
|
||||
import Control.Monad.State.Class (MonadState)
|
||||
import Control.Monad.IO.Class (MonadIO)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Data.Aeson ((.=))
|
||||
import Data.Foldable (mapM_)
|
||||
|
||||
import qualified Control.Concurrent.STM as STM
|
||||
import qualified Data.Aeson as Aeson
|
||||
import qualified Data.Text as Text
|
||||
import qualified Network.SocketIO as SocketIO
|
||||
|
||||
|
||||
data AddUser = AddUser Text.Text
|
||||
|
||||
instance Aeson.FromJSON AddUser where
|
||||
parseJSON = Aeson.withText "AddUser" $ pure . AddUser
|
||||
|
||||
|
||||
data NumConnected = NumConnected !Int
|
||||
|
||||
instance Aeson.ToJSON NumConnected where
|
||||
toJSON (NumConnected n) = Aeson.object [ "numUsers" .= n]
|
||||
|
||||
|
||||
data NewMessage = NewMessage Text.Text
|
||||
|
||||
instance Aeson.FromJSON NewMessage where
|
||||
parseJSON = Aeson.withText "NewMessage" $ pure . NewMessage
|
||||
|
||||
|
||||
data Said = Said Text.Text Text.Text
|
||||
|
||||
instance Aeson.ToJSON Said where
|
||||
toJSON (Said username message) = Aeson.object
|
||||
[ "username" .= username
|
||||
, "message" .= message
|
||||
]
|
||||
|
||||
data UserName = UserName Text.Text
|
||||
|
||||
instance Aeson.ToJSON UserName where
|
||||
toJSON (UserName un) = Aeson.object [ "username" .= un ]
|
||||
|
||||
|
||||
data UserJoined = UserJoined Text.Text Int
|
||||
|
||||
instance Aeson.ToJSON UserJoined where
|
||||
toJSON (UserJoined un n) = Aeson.object
|
||||
[ "username" .= un
|
||||
, "numUsers" .= n
|
||||
]
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
data ServerState = ServerState { ssNConnected :: STM.TVar Int }
|
||||
|
||||
--server :: ServerState -> StateT SocketIO.RoutingTable Snap.Snap ()
|
||||
eioServer :: forall (m :: * -> *). (MonadState SocketIO.RoutingTable m, MonadIO m) => ServerState -> m ()
|
||||
eioServer state = do
|
||||
userNameMVar <- liftIO STM.newEmptyTMVarIO
|
||||
let forUserName m = liftIO (STM.atomically (STM.tryReadTMVar userNameMVar)) >>= mapM_ m
|
||||
|
||||
SocketIO.on "new message" $ \(NewMessage message) ->
|
||||
forUserName $ \userName ->
|
||||
SocketIO.broadcast "new message" (Said userName message)
|
||||
|
||||
SocketIO.on "add user" $ \(AddUser userName) -> do
|
||||
n <- liftIO $ STM.atomically $ do
|
||||
n <- (+ 1) <$> STM.readTVar (ssNConnected state)
|
||||
STM.putTMVar userNameMVar userName
|
||||
STM.writeTVar (ssNConnected state) n
|
||||
return n
|
||||
|
||||
SocketIO.emit "login" (NumConnected n)
|
||||
SocketIO.broadcast "user joined" (UserJoined userName n)
|
||||
|
||||
SocketIO.appendDisconnectHandler $ do
|
||||
(n, mUserName) <- liftIO $ STM.atomically $ do
|
||||
n <- (+ (-1)) <$> STM.readTVar (ssNConnected state)
|
||||
mUserName <- STM.tryReadTMVar userNameMVar
|
||||
STM.writeTVar (ssNConnected state) n
|
||||
return (n, mUserName)
|
||||
|
||||
case mUserName of
|
||||
Nothing -> return ()
|
||||
Just userName ->
|
||||
SocketIO.broadcast "user left" (UserJoined userName n)
|
||||
|
||||
SocketIO.on "typing" $
|
||||
forUserName $ \userName ->
|
||||
SocketIO.broadcast "typing" (UserName userName)
|
||||
|
||||
SocketIO.on "stop typing" $
|
||||
forUserName $ \userName ->
|
||||
SocketIO.broadcast "stop typing" (UserName userName)
|
||||
|
||||
|
|
@ -1,28 +0,0 @@
|
|||
<!doctype html>
|
||||
<html lang="en">
|
||||
<head>
|
||||
<meta charset="UTF-8">
|
||||
<title>Socket.IO Chat Example</title>
|
||||
<link rel="stylesheet" href="style.css">
|
||||
</head>
|
||||
<body>
|
||||
<ul class="pages">
|
||||
<li class="chat page">
|
||||
<div class="chatArea">
|
||||
<ul class="messages"></ul>
|
||||
</div>
|
||||
<input class="inputMessage" placeholder="Type here..."/>
|
||||
</li>
|
||||
<li class="login page">
|
||||
<div class="form">
|
||||
<h3 class="title">What's your nickname?</h3>
|
||||
<input class="usernameInput" type="text" maxlength="14" />
|
||||
</div>
|
||||
</li>
|
||||
</ul>
|
||||
|
||||
<script src="https://cdn.socket.io/socket.io-1.2.1.js"></script>
|
||||
<script src="https://code.jquery.com/jquery-1.10.2.min.js"></script>
|
||||
<script src="/main.js"></script>
|
||||
</body>
|
||||
</html>
|
||||
|
|
@ -1,274 +0,0 @@
|
|||
$(function() {
|
||||
var FADE_TIME = 150; // ms
|
||||
var TYPING_TIMER_LENGTH = 400; // ms
|
||||
var COLORS = [
|
||||
'#e21400', '#91580f', '#f8a700', '#f78b00',
|
||||
'#58dc00', '#287b00', '#a8f07a', '#4ae8c4',
|
||||
'#3b88eb', '#3824aa', '#a700ff', '#d300e7'
|
||||
];
|
||||
|
||||
// Initialize varibles
|
||||
var $window = $(window);
|
||||
var $usernameInput = $('.usernameInput'); // Input for username
|
||||
var $messages = $('.messages'); // Messages area
|
||||
var $inputMessage = $('.inputMessage'); // Input message input box
|
||||
|
||||
var $loginPage = $('.login.page'); // The login page
|
||||
var $chatPage = $('.chat.page'); // The chatroom page
|
||||
|
||||
// Prompt for setting a username
|
||||
var username;
|
||||
var connected = false;
|
||||
var typing = false;
|
||||
var lastTypingTime;
|
||||
var $currentInput = $usernameInput.focus();
|
||||
|
||||
var socket = io();
|
||||
|
||||
function addParticipantsMessage (data) {
|
||||
var message = '';
|
||||
if (data.numUsers === 1) {
|
||||
message += "there's 1 participant";
|
||||
} else {
|
||||
message += "there're " + data.numUsers + " participants";
|
||||
}
|
||||
log(message);
|
||||
}
|
||||
|
||||
// Sets the client's username
|
||||
function setUsername () {
|
||||
username = cleanInput($usernameInput.val().trim());
|
||||
|
||||
// If the username is valid
|
||||
if (username) {
|
||||
$loginPage.fadeOut();
|
||||
$chatPage.show();
|
||||
$loginPage.off('click');
|
||||
$currentInput = $inputMessage.focus();
|
||||
|
||||
// Tell the server your username
|
||||
socket.emit('add user', username);
|
||||
}
|
||||
}
|
||||
|
||||
// Sends a chat message
|
||||
function sendMessage () {
|
||||
var message = $inputMessage.val();
|
||||
// Prevent markup from being injected into the message
|
||||
message = cleanInput(message);
|
||||
// if there is a non-empty message and a socket connection
|
||||
if (message && connected) {
|
||||
$inputMessage.val('');
|
||||
addChatMessage({
|
||||
username: username,
|
||||
message: message
|
||||
});
|
||||
// tell server to execute 'new message' and send along one parameter
|
||||
socket.emit('new message', message);
|
||||
}
|
||||
}
|
||||
|
||||
// Log a message
|
||||
function log (message, options) {
|
||||
var $el = $('<li>').addClass('log').text(message);
|
||||
addMessageElement($el, options);
|
||||
}
|
||||
|
||||
// Adds the visual chat message to the message list
|
||||
function addChatMessage (data, options) {
|
||||
// Don't fade the message in if there is an 'X was typing'
|
||||
var $typingMessages = getTypingMessages(data);
|
||||
options = options || {};
|
||||
if ($typingMessages.length !== 0) {
|
||||
options.fade = false;
|
||||
$typingMessages.remove();
|
||||
}
|
||||
|
||||
var $usernameDiv = $('<span class="username"/>')
|
||||
.text(data.username)
|
||||
.css('color', getUsernameColor(data.username));
|
||||
var $messageBodyDiv = $('<span class="messageBody">')
|
||||
.text(data.message);
|
||||
|
||||
var typingClass = data.typing ? 'typing' : '';
|
||||
var $messageDiv = $('<li class="message"/>')
|
||||
.data('username', data.username)
|
||||
.addClass(typingClass)
|
||||
.append($usernameDiv, $messageBodyDiv);
|
||||
|
||||
addMessageElement($messageDiv, options);
|
||||
}
|
||||
|
||||
// Adds the visual chat typing message
|
||||
function addChatTyping (data) {
|
||||
data.typing = true;
|
||||
data.message = 'is typing';
|
||||
addChatMessage(data);
|
||||
}
|
||||
|
||||
// Removes the visual chat typing message
|
||||
function removeChatTyping (data) {
|
||||
getTypingMessages(data).fadeOut(function () {
|
||||
$(this).remove();
|
||||
});
|
||||
}
|
||||
|
||||
// Adds a message element to the messages and scrolls to the bottom
|
||||
// el - The element to add as a message
|
||||
// options.fade - If the element should fade-in (default = true)
|
||||
// options.prepend - If the element should prepend
|
||||
// all other messages (default = false)
|
||||
function addMessageElement (el, options) {
|
||||
var $el = $(el);
|
||||
|
||||
// Setup default options
|
||||
if (!options) {
|
||||
options = {};
|
||||
}
|
||||
if (typeof options.fade === 'undefined') {
|
||||
options.fade = true;
|
||||
}
|
||||
if (typeof options.prepend === 'undefined') {
|
||||
options.prepend = false;
|
||||
}
|
||||
|
||||
// Apply options
|
||||
if (options.fade) {
|
||||
$el.hide().fadeIn(FADE_TIME);
|
||||
}
|
||||
if (options.prepend) {
|
||||
$messages.prepend($el);
|
||||
} else {
|
||||
$messages.append($el);
|
||||
}
|
||||
$messages[0].scrollTop = $messages[0].scrollHeight;
|
||||
}
|
||||
|
||||
// Prevents input from having injected markup
|
||||
function cleanInput (input) {
|
||||
return $('<div/>').text(input).text();
|
||||
}
|
||||
|
||||
// Updates the typing event
|
||||
function updateTyping () {
|
||||
if (connected) {
|
||||
if (!typing) {
|
||||
typing = true;
|
||||
socket.emit('typing');
|
||||
}
|
||||
lastTypingTime = (new Date()).getTime();
|
||||
|
||||
setTimeout(function () {
|
||||
var typingTimer = (new Date()).getTime();
|
||||
var timeDiff = typingTimer - lastTypingTime;
|
||||
if (timeDiff >= TYPING_TIMER_LENGTH && typing) {
|
||||
socket.emit('stop typing');
|
||||
typing = false;
|
||||
}
|
||||
}, TYPING_TIMER_LENGTH);
|
||||
}
|
||||
}
|
||||
|
||||
// Gets the 'X is typing' messages of a user
|
||||
function getTypingMessages (data) {
|
||||
return $('.typing.message').filter(function (i) {
|
||||
return $(this).data('username') === data.username;
|
||||
});
|
||||
}
|
||||
|
||||
// Gets the color of a username through our hash function
|
||||
function getUsernameColor (username) {
|
||||
// Compute hash code
|
||||
var hash = 7;
|
||||
for (var i = 0; i < username.length; i++) {
|
||||
hash = username.charCodeAt(i) + (hash << 5) - hash;
|
||||
}
|
||||
// Calculate color
|
||||
var index = Math.abs(hash % COLORS.length);
|
||||
return COLORS[index];
|
||||
}
|
||||
|
||||
// Keyboard events
|
||||
|
||||
$window.keydown(function (event) {
|
||||
// Auto-focus the current input when a key is typed
|
||||
if (!(event.ctrlKey || event.metaKey || event.altKey)) {
|
||||
$currentInput.focus();
|
||||
}
|
||||
// When the client hits ENTER on their keyboard
|
||||
if (event.which === 13) {
|
||||
if (username) {
|
||||
sendMessage();
|
||||
socket.emit('stop typing');
|
||||
typing = false;
|
||||
} else {
|
||||
setUsername();
|
||||
}
|
||||
}
|
||||
});
|
||||
|
||||
$inputMessage.on('input', function() {
|
||||
updateTyping();
|
||||
});
|
||||
|
||||
// Click events
|
||||
|
||||
// Focus input when clicking anywhere on login page
|
||||
$loginPage.click(function () {
|
||||
$currentInput.focus();
|
||||
});
|
||||
|
||||
// Focus input when clicking on the message input's border
|
||||
$inputMessage.click(function () {
|
||||
$inputMessage.focus();
|
||||
});
|
||||
|
||||
// Socket events
|
||||
socket.on('connected', function (data) {
|
||||
console.log('connected:', data);
|
||||
});
|
||||
|
||||
// Socket events
|
||||
socket.on('changes', function (data) {
|
||||
console.log('changes:', data);
|
||||
});
|
||||
|
||||
// Whenever the server emits 'login', log the login message
|
||||
socket.on('login', function (data) {
|
||||
connected = true;
|
||||
// Display the welcome message
|
||||
var message = "Welcome to Socket.IO Chat — ";
|
||||
log(message, {
|
||||
prepend: true
|
||||
});
|
||||
addParticipantsMessage(data);
|
||||
});
|
||||
|
||||
// Whenever the server emits 'new message', update the chat body
|
||||
socket.on('new message', function (data) {
|
||||
addChatMessage(data);
|
||||
});
|
||||
|
||||
// Whenever the server emits 'user joined', log it in the chat body
|
||||
socket.on('user joined', function (data) {
|
||||
log(data.username + ' joined');
|
||||
addParticipantsMessage(data);
|
||||
});
|
||||
|
||||
// Whenever the server emits 'user left', log it in the chat body
|
||||
socket.on('user left', function (data) {
|
||||
log(data.username + ' left');
|
||||
addParticipantsMessage(data);
|
||||
removeChatTyping(data);
|
||||
});
|
||||
|
||||
// Whenever the server emits 'typing', show the typing message
|
||||
socket.on('typing', function (data) {
|
||||
addChatTyping(data);
|
||||
});
|
||||
|
||||
// Whenever the server emits 'stop typing', kill the typing message
|
||||
socket.on('stop typing', function (data) {
|
||||
removeChatTyping(data);
|
||||
});
|
||||
});
|
||||
|
|
@ -1,150 +0,0 @@
|
|||
/* Fix user-agent */
|
||||
|
||||
* {
|
||||
box-sizing: border-box;
|
||||
}
|
||||
|
||||
html {
|
||||
font-weight: 300;
|
||||
-webkit-font-smoothing: antialiased;
|
||||
}
|
||||
|
||||
html, input {
|
||||
font-family:
|
||||
"HelveticaNeue-Light",
|
||||
"Helvetica Neue Light",
|
||||
"Helvetica Neue",
|
||||
Helvetica,
|
||||
Arial,
|
||||
"Lucida Grande",
|
||||
sans-serif;
|
||||
}
|
||||
|
||||
html, body {
|
||||
height: 100%;
|
||||
margin: 0;
|
||||
padding: 0;
|
||||
}
|
||||
|
||||
ul {
|
||||
list-style: none;
|
||||
word-wrap: break-word;
|
||||
}
|
||||
|
||||
/* Pages */
|
||||
|
||||
.pages {
|
||||
height: 100%;
|
||||
margin: 0;
|
||||
padding: 0;
|
||||
width: 100%;
|
||||
}
|
||||
|
||||
.page {
|
||||
height: 100%;
|
||||
position: absolute;
|
||||
width: 100%;
|
||||
}
|
||||
|
||||
/* Login Page */
|
||||
|
||||
.login.page {
|
||||
background-color: #000;
|
||||
}
|
||||
|
||||
.login.page .form {
|
||||
height: 100px;
|
||||
margin-top: -100px;
|
||||
position: absolute;
|
||||
|
||||
text-align: center;
|
||||
top: 50%;
|
||||
width: 100%;
|
||||
}
|
||||
|
||||
.login.page .form .usernameInput {
|
||||
background-color: transparent;
|
||||
border: none;
|
||||
border-bottom: 2px solid #fff;
|
||||
outline: none;
|
||||
padding-bottom: 15px;
|
||||
text-align: center;
|
||||
width: 400px;
|
||||
}
|
||||
|
||||
.login.page .title {
|
||||
font-size: 200%;
|
||||
}
|
||||
|
||||
.login.page .usernameInput {
|
||||
font-size: 200%;
|
||||
letter-spacing: 3px;
|
||||
}
|
||||
|
||||
.login.page .title, .login.page .usernameInput {
|
||||
color: #fff;
|
||||
font-weight: 100;
|
||||
}
|
||||
|
||||
/* Chat page */
|
||||
|
||||
.chat.page {
|
||||
display: none;
|
||||
}
|
||||
|
||||
/* Font */
|
||||
|
||||
.messages {
|
||||
font-size: 150%;
|
||||
}
|
||||
|
||||
.inputMessage {
|
||||
font-size: 100%;
|
||||
}
|
||||
|
||||
.log {
|
||||
color: gray;
|
||||
font-size: 70%;
|
||||
margin: 5px;
|
||||
text-align: center;
|
||||
}
|
||||
|
||||
/* Messages */
|
||||
|
||||
.chatArea {
|
||||
height: 100%;
|
||||
padding-bottom: 60px;
|
||||
}
|
||||
|
||||
.messages {
|
||||
height: 100%;
|
||||
margin: 0;
|
||||
overflow-y: scroll;
|
||||
padding: 10px 20px 10px 20px;
|
||||
}
|
||||
|
||||
.message.typing .messageBody {
|
||||
color: gray;
|
||||
}
|
||||
|
||||
.username {
|
||||
float: left;
|
||||
font-weight: 700;
|
||||
overflow: hidden;
|
||||
padding-right: 15px;
|
||||
text-align: right;
|
||||
}
|
||||
|
||||
/* Input */
|
||||
|
||||
.inputMessage {
|
||||
border: 10px solid #000;
|
||||
bottom: 0;
|
||||
height: 60px;
|
||||
left: 0;
|
||||
outline: none;
|
||||
padding-left: 10px;
|
||||
position: absolute;
|
||||
right: 0;
|
||||
width: 100%;
|
||||
}
|
||||
|
|
@ -1,54 +0,0 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
|
||||
import Data.Monoid ((<>))
|
||||
#if !MIN_VERSION_base(4,8,0)
|
||||
import Control.Applicative ((<$>))
|
||||
#endif
|
||||
import Network.EngineIO.Wai
|
||||
import Network.Wai
|
||||
import Network.Wai.Handler.Warp (run)
|
||||
import Servant
|
||||
|
||||
|
||||
import qualified Control.Concurrent.STM as STM
|
||||
import qualified Network.SocketIO as SocketIO
|
||||
|
||||
|
||||
import Chat (ServerState (..), eioServer)
|
||||
|
||||
|
||||
type API = "socket.io" :> Raw
|
||||
:<|> Raw
|
||||
|
||||
|
||||
api :: Proxy API
|
||||
api = Proxy
|
||||
|
||||
|
||||
server :: WaiMonad () -> Server API
|
||||
server sHandler = socketIOHandler
|
||||
:<|> serveDirectory "socket-io-chat/resources"
|
||||
|
||||
where
|
||||
socketIOHandler req respond = toWaiApplication sHandler req respond
|
||||
|
||||
|
||||
app :: WaiMonad () -> Application
|
||||
app sHandler = serve api EmptyConfig $ server sHandler
|
||||
|
||||
port :: Int
|
||||
port = 3001
|
||||
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
state <- ServerState <$> STM.newTVarIO 0
|
||||
sHandler <- SocketIO.initialize waiAPI (eioServer state)
|
||||
putStrLn $ "Running on " <> show port
|
||||
run port $ app sHandler
|
||||
|
||||
|
||||
|
|
@ -1,15 +0,0 @@
|
|||
dependencies:
|
||||
- name: servant
|
||||
path: ../servant
|
||||
- name: servant-server
|
||||
path: ../servant-server
|
||||
- name: servant-client
|
||||
path: ../servant-client
|
||||
- name: servant-js
|
||||
path: ../servant-js
|
||||
- name: servant-lucid
|
||||
path: ../servant-lucid
|
||||
- name: servant-docs
|
||||
path: ../servant-docs
|
||||
- name: servant-foreign
|
||||
path: ../servant-foreign
|
||||
|
|
@ -1,51 +0,0 @@
|
|||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
import Data.Aeson
|
||||
import Data.Text
|
||||
import GHC.Generics
|
||||
import Network.Wai
|
||||
import Network.Wai.Handler.Warp
|
||||
import Network.Wai.Middleware.RequestLogger
|
||||
import Servant
|
||||
|
||||
data Product = Product
|
||||
{ name :: Text
|
||||
, brand :: Text
|
||||
, current_price_eur :: Double
|
||||
, available :: Bool
|
||||
} deriving (Eq, Show, Generic)
|
||||
|
||||
instance ToJSON Product
|
||||
|
||||
products :: [Product]
|
||||
products = [p1, p2]
|
||||
|
||||
where p1 = Product "Haskell laptop sticker"
|
||||
"GHC Industries"
|
||||
2.50
|
||||
True
|
||||
|
||||
p2 = Product "Foldable USB drive"
|
||||
"Well-Typed"
|
||||
13.99
|
||||
False
|
||||
|
||||
type SimpleAPI = Get '[JSON] [Product]
|
||||
|
||||
simpleAPI :: Proxy SimpleAPI
|
||||
simpleAPI = Proxy
|
||||
|
||||
server :: Server SimpleAPI
|
||||
server = return products
|
||||
|
||||
-- logStdout :: Middleware
|
||||
-- i.e, logStdout :: Application -> Application
|
||||
-- serve :: Proxy api -> Config config -> Server api -> Application
|
||||
-- so applying a middleware is really as simple as
|
||||
-- applying a function to the result of 'serve'
|
||||
app :: Application
|
||||
app = logStdout (serve simpleAPI EmptyConfig server)
|
||||
|
||||
main :: IO ()
|
||||
main = run 8080 app
|
||||
Loading…
Reference in a new issue