diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Alexander Krupenkin (c) 2016-2017
+
+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 Alexander Krupenkin 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.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,56 @@
+## Haskell Bot it :: Message bot framework
+
+[![Build Status](https://travis-ci.org/airalab/habit.svg?branch=master)](https://travis-ci.org/airalab/habit)
+[![Build status](https://ci.appveyor.com/api/projects/status/jgydugfn3tx8o56g?svg=true)](https://ci.appveyor.com/project/akru/habit)
+[![Hackage](https://img.shields.io/hackage/v/habit.svg)](http://hackage.haskell.org/package/habit)
+![Hackage Dependencies](https://img.shields.io/hackage-deps/v/habit.svg)
+![Haskell Programming Language](https://img.shields.io/badge/language-Haskell-blue.svg)
+![BSD3 License](http://img.shields.io/badge/license-BSD3-brightgreen.svg)
+
+### Install
+
+    $ git clone https://github.com/airalab/habit && cd habit
+    $ stack setup
+    $ stack ghci
+
+### Run your story
+
+The `Story` is an abstraction about sparsed data getted from user
+though dialogue.
+
+```haskell
+helloStory :: Story a
+helloStory _ = hello <$> question "How your name?"
+                     <*> question "How your surname?"
+                     <*> question "How old are you?"
+```
+
+As you see the story handler `hello` is apply though the questions
+to user responses.
+
+```haskell
+type Name    = Text
+type Surname = Text
+type Age     = Int
+
+hello :: Monad m => Name -> Surname -> Age -> m BotMessage
+hello name surname age = do
+    return . toMessage $ "Hello, " <> name <> " " <> surname <> "!\n"
+                      <> "You lost " <> (pack $ show age) <> " years =)"
+```
+
+To run the `Story` simple pass it to `storyBot` as value of mapping between
+command an story. `APIToken` type class defines token for given platform,
+e.g. Telegram platform.
+
+```haskell
+instance APIToken Telegram where
+    apiToken = "bot..."
+
+main :: IO ()
+main = runBot myBot
+  where myBot :: Bot Telegram ()
+        myBot = storyBot helpMsg [("/hello", helloStory)]
+```
+
+Full example [text](examples/Hello.hs).
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/examples/Hello.hs b/examples/Hello.hs
new file mode 100644
--- /dev/null
+++ b/examples/Hello.hs
@@ -0,0 +1,35 @@
+{-# LANGUAGE OverloadedLists #-}
+module Main where
+
+import Data.Text (Text, pack)
+import Data.Monoid ((<>))
+import Web.Bot
+
+type Name    = Text
+type Surname = Text
+type Age     = Int
+
+hello :: Name -> Surname -> Age -> Message
+hello name surname age =
+    toMessage $ "Hello, " <> name <> " " <> surname <> "!\n"
+             <> "You lost " <> (pack $ show age) <> " years =)"
+
+helloStory :: Story a
+helloStory _ = hello <$> question "How your name?"
+                     <*> question "How your surname?"
+                     <*> question "How old are you?"
+
+helpMsg :: Text
+helpMsg = "Hello, I'm hello bot!"
+
+instance APIToken Telegram where
+    apiToken = return "bot308165623:AAGeMyzyedc787LZSpzlhwTCWQcO5CAZpAo"
+
+instance Persist Telegram where
+    persist = return $ Sqlite "storage.db"
+
+main :: IO ()
+main = runBot myStory
+  where
+    myStory :: Bot Telegram ()
+    myStory = storyBot helpMsg [("/hello", helloStory)]
diff --git a/habit.cabal b/habit.cabal
new file mode 100644
--- /dev/null
+++ b/habit.cabal
@@ -0,0 +1,68 @@
+name: habit
+version: 0.2.1.2
+cabal-version: >=1.10
+build-type: Simple
+license: BSD3
+license-file: LICENSE
+copyright: Alexander Krupenkin
+maintainer: mail@akru.me
+homepage: https://github.com/airalab/habit#readme
+synopsis: Haskell message bot framework
+description:
+    Framework for building text message bots for popular platforms
+category: Web
+author: Alexander Krupenkin
+extra-source-files:
+    README.md
+
+source-repository head
+    type: git
+    location: https://github.com/airalab/habit
+
+library
+    exposed-modules:
+        Web.Bot
+        Web.Bot.Log
+        Web.Bot.User
+        Web.Bot.Story
+        Web.Bot.Message
+        Web.Bot.Metrics
+        Web.Bot.Persist
+        Web.Bot.Platform
+        Web.Bot.Platform.Telegram
+    build-depends:
+        base ==4.9.*,
+        persistent-postgresql ==2.6.*,
+        persistent-template >=2.5.1.6 && <2.6,
+        persistent-sqlite ==2.6.*,
+        persistent-mysql ==2.6.*,
+        persistent ==2.6.*,
+        transformers-base >=0.4.4 && <0.5,
+        http-client-tls >=0.2.4.1 && <0.3,
+        monad-control >=1.0.1.0 && <1.1,
+        transformers >=0.5.2.0 && <0.6,
+        monad-logger >=0.3.20.1 && <0.4,
+        telegram-api >=0.5.0.1 && <0.6,
+        http-client >=0.4.31.2 && <0.5,
+        containers >=0.5.7.1 && <0.6,
+        cryptonite ==0.19.*,
+        resourcet >=1.1.8.1 && <1.2,
+        pipes >=4.1.9 && <4.2,
+        text >=1.2.2.1 && <1.3
+    default-language: Haskell2010
+    default-extensions: OverloadedStrings
+    hs-source-dirs: src
+    other-modules:
+        Web.Bot.Story.Internal
+
+executable hello-bot
+    main-is: Hello.hs
+    build-depends:
+        base >=4.7 && <5,
+        habit >=0.2.1.2 && <0.3,
+        text >=1.2.2.1 && <1.3
+    default-language: Haskell2010
+    default-extensions: OverloadedStrings
+    hs-source-dirs: examples
+    ghc-options: -threaded -rtsopts -with-rtsopts=-N
+
diff --git a/src/Web/Bot.hs b/src/Web/Bot.hs
new file mode 100644
--- /dev/null
+++ b/src/Web/Bot.hs
@@ -0,0 +1,58 @@
+-- |
+-- Module      :  Web.Bot
+-- Copyright   :  Alexander Krupenkin 2016
+-- License     :  BSD3
+--
+-- Maintainer  :  email@something.com
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Text message bot framework for creating story like:
+--
+-- @
+--      helloStory :: BotConfig a => Story a
+--      helloStory _ = hello <$> question "How your name?"
+--                           <*> question "How your surname?"
+--                           <*> question "How old are you?"
+-- @
+--
+module Web.Bot (
+  -- ** Story & message types
+    ToMessage(..)
+  , Answer(..)
+  , Message
+  , StoryT
+  , Story
+  , User
+  -- ** Story makers
+  , question
+  , replica
+  , select
+  -- ** Bot monad & configuration classes
+  , Bot
+  , Platform(..)
+  , APIToken(..)
+  -- ** Bot platforms
+  , Telegram
+  -- ** Bot storage
+  , Persist(..)
+  , Connection(..)
+  , ConnectInfo(..)
+  -- ** Bot runners
+  , storyBot
+  , forkBot
+  , runBot
+  -- ** Re-exports
+  , yield
+  , await
+  , lift
+  ) where
+
+import Pipes (yield, await, lift)
+import Web.Bot.Story.Internal
+import Web.Bot.Platform.Telegram
+import Web.Bot.Platform
+import Web.Bot.Persist
+import Web.Bot.Message
+import Web.Bot.Story
+import Web.Bot.User
diff --git a/src/Web/Bot/Log.hs b/src/Web/Bot/Log.hs
new file mode 100644
--- /dev/null
+++ b/src/Web/Bot/Log.hs
@@ -0,0 +1,23 @@
+-- |
+-- Module      :  Web.Bot.Log
+-- Copyright   :  Alexander Krupenkin 2017
+-- License     :  BSD3
+--
+-- Maintainer  :  mail@akru.me
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Logging utils.
+--
+module Web.Bot.Log (
+    logDebug
+  , logInfo
+  , logWarn
+  , logError
+  , logDebugS
+  , logInfoS
+  , logWarnS
+  , logErrorS
+) where
+
+import Control.Monad.Logger
diff --git a/src/Web/Bot/Message.hs b/src/Web/Bot/Message.hs
new file mode 100644
--- /dev/null
+++ b/src/Web/Bot/Message.hs
@@ -0,0 +1,38 @@
+-- |
+-- Module      :  Web.Bot.Message
+-- Copyright   :  Alexander Krupenkin 2017
+-- License     :  BSD3
+--
+-- Maintainer  :  mail@akru.me
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Common used message type.
+--
+module Web.Bot.Message where
+
+import Data.String (IsString(..))
+import Data.Text (Text)
+
+-- | Generalized message type
+data Message
+  = MsgTyping
+  -- ^ When is typing
+  | MsgText Text
+  -- ^ Simple text
+  | MsgKeyboard Text [[Text]]
+  -- ^ Interactive keyboard
+  deriving (Eq, Ord, Show)
+
+instance IsString Message where
+    fromString = MsgText . fromString
+
+-- | Convert any data to message
+class ToMessage a where
+    toMessage :: a -> Message
+
+instance ToMessage Message where
+    toMessage = id
+
+instance ToMessage Text where
+    toMessage = MsgText
diff --git a/src/Web/Bot/Metrics.hs b/src/Web/Bot/Metrics.hs
new file mode 100644
--- /dev/null
+++ b/src/Web/Bot/Metrics.hs
@@ -0,0 +1,38 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE TemplateHaskell            #-}
+{-# LANGUAGE TypeFamilies               #-}
+{-# LANGUAGE QuasiQuotes                #-}
+{-# LANGUAGE GADTs                      #-}
+-- |
+-- Module      :  Web.Bot.Metrics
+-- Copyright   :  Alexander Krupenkin 2017
+-- License     :  BSD3
+--
+-- Maintainer  :  mail@akru.me
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Bot metrics utils.
+--
+module Web.Bot.Metrics where
+
+import Database.Persist.TH
+import Database.Persist
+import Data.Text (Text)
+import Web.Bot.User
+
+share [mkPersist sqlSettings, mkMigrate "migrateMetrics"] [persistLowerCase|
+UserStat
+    ident      Text Unique
+    messageOut Int
+    messageIn  Int
+    StatUser ident
+    deriving Show
+
+StoryStat
+    name      Text Unique
+    calls     Int
+    StatStory name
+    deriving Show
+|]
diff --git a/src/Web/Bot/Persist.hs b/src/Web/Bot/Persist.hs
new file mode 100644
--- /dev/null
+++ b/src/Web/Bot/Persist.hs
@@ -0,0 +1,71 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TemplateHaskell  #-}
+-- |
+-- Module      :  Web.Bot.Persist
+-- Copyright   :  Alexander Krupenkin 2017
+-- License     :  BSD3
+--
+-- Maintainer  :  mail@akru.me
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Bot storage utils.
+--
+module Web.Bot.Persist (
+    Persist(..)
+  , Connection(..)
+  , ConnectInfo(..)
+  , runDB
+  , module Database.Persist
+  ) where
+
+import Control.Monad.Trans.Control (MonadBaseControl)
+import Control.Monad.Trans.Resource (ResourceT)
+import Control.Monad.Trans.Reader (ReaderT)
+import Control.Monad.Logger (NoLoggingT)
+import Control.Monad.IO.Class (liftIO)
+import qualified Data.Text as T
+import Data.Text (Text)
+
+import Database.Persist.Postgresql (withPostgresqlConn,
+                                    ConnectionString)
+import Database.Persist.Sqlite (withSqliteConn)
+import Database.Persist.MySQL (withMySQLConn,
+                               ConnectInfo(..))
+import Database.Persist.Sql (SqlBackend,
+                             runSqlPersistM, runMigration)
+import Database.Persist
+
+import Web.Bot.Platform
+import Web.Bot.Log
+
+-- Models
+import Web.Bot.Metrics
+import Web.Bot.User
+
+-- | Database connection information
+data Connection = Postgresql ConnectionString
+                | Sqlite Text
+                | MySQL ConnectInfo
+  deriving (Eq, Show)
+
+-- | Connection info provider
+class Platform a => Persist a where
+    persist :: Bot a Connection
+
+-- | Run some staff with database connection
+runDB :: Persist a
+      => ReaderT SqlBackend (NoLoggingT (ResourceT IO)) b
+      -> Bot a b
+runDB ma = do
+    db <- persist
+    $logDebugS "Persist" (T.append "Connection: " $ T.pack (show db))
+
+    let runConnection = case db of
+            Postgresql conn -> withPostgresqlConn conn
+            Sqlite conn     -> withSqliteConn conn
+            MySQL conn      -> withMySQLConn conn
+
+    runConnection $ \backend ->
+        liftIO $ flip runSqlPersistM backend $
+            runMigration (migrateMetrics >> migrateUser) >> ma
diff --git a/src/Web/Bot/Platform.hs b/src/Web/Bot/Platform.hs
new file mode 100644
--- /dev/null
+++ b/src/Web/Bot/Platform.hs
@@ -0,0 +1,121 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ConstrainedClassMethods    #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE TemplateHaskell            #-}
+{-# LANGUAGE TypeFamilies               #-}
+-- |
+-- Module      :  Web.Bot.Platform
+-- Copyright   :  Alexander Krupenkin 2017
+-- License     :  BSD3
+--
+-- Maintainer  :  mail@akru.me
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Bot platform type class.
+--
+module Web.Bot.Platform (
+    Bot
+  , Platform(..)
+  , APIToken(..)
+  , getManager
+  , forkFinallyBot
+  , forkBot
+  , runBot
+  ) where
+
+import Control.Monad.Logger (MonadLogger(..), LoggingT, runStderrLoggingT)
+import Control.Monad.Trans.Reader (ReaderT, runReaderT, ask)
+import Control.Monad.Trans.Control (MonadBaseControl(..))
+import Control.Concurrent (forkIO, forkFinally, ThreadId)
+import Network.HTTP.Client.TLS (tlsManagerSettings)
+import Control.Exception (throwIO, SomeException)
+import Network.HTTP.Client (newManager, Manager)
+import Control.Monad.IO.Class (MonadIO(..))
+import Control.Monad.Base (MonadBase(..))
+import qualified Data.Text as T
+import Data.Monoid ((<>))
+import Data.Text (Text)
+
+import Web.Bot.Message (Message, ToMessage)
+import Web.Bot.User (User)
+import Web.Bot.Log
+
+-- | Message bot monad
+newtype Bot a b = Bot { unBot :: ReaderT Manager (LoggingT IO) b }
+  deriving (Functor, Applicative, Monad, MonadIO)
+
+instance MonadLogger (Bot a) where
+    monadLoggerLog a b c d = Bot (monadLoggerLog a b c d)
+
+instance MonadBase IO (Bot a) where
+    liftBase = liftIO
+
+instance MonadBaseControl IO (Bot a) where
+    type StM (Bot a) b = b
+    liftBaseWith f = Bot $ liftBaseWith $ \r -> f (r . unBot)
+    restoreM = return
+
+-- | Message bot platform.
+-- Different platforms provide message bot API,
+-- e.g. Telegram, Viber, Facebook Messenger etc.
+-- This is generalized interface to it.
+class Platform a where
+    -- | Try connection to platform API
+    trySelf :: APIToken a => Bot a ()
+
+    -- | Send message to user by platform API
+    sendMessage :: (ToMessage msg, APIToken a) => User -> msg -> Bot a ()
+
+    -- | Get user updates by platform API
+    messageHandler :: APIToken a
+                   => (User -> Message -> Bot a b)
+                   -- ^ Incoming message handler
+                   -> Bot a c
+                   -- ^ Blocking event processing
+
+    -- | Short description of platform
+    platformName :: a -> Text
+
+-- | Bot authentification in platform
+-- Instance of it should be writen by user
+class Platform a => APIToken a where
+    apiToken :: Bot a Text
+    -- ^ Platform API token
+
+-- | TCP-connection manager getter
+getManager :: Bot a Manager
+{-# INLINE getManager #-}
+getManager = Bot ask
+
+-- | Run bot monad
+runBot :: (APIToken a, MonadIO m)
+       => Bot a b -> m b
+runBot bot = liftIO $ do
+    -- Init connection manager
+    manager <- newManager tlsManagerSettings
+    -- Run bot monad
+    runStderrLoggingT (runReaderT mBot manager)
+  where Bot mBot = trySelf >> bot
+
+-- | Fork bot thread
+forkBot :: APIToken a
+        => Bot a () -> Bot a ThreadId
+forkBot (Bot bot) = do
+    t <- Bot (ask >>= forkReader)
+    $logDebugS "Bot" ("Forked " <> T.pack (show t))
+    return t
+  where forkReader = liftIO . forkIO
+                   . runStderrLoggingT . runReaderT bot
+
+-- | Fork bot thread with finalizer
+forkFinallyBot :: APIToken a
+               => Bot a b
+               -> (Either SomeException b -> IO ())
+               -> Bot a ThreadId
+forkFinallyBot (Bot bot) f = do
+    t <- Bot (ask >>= forkFinallyReader)
+    $logDebugS "Bot" ("Forked finally " <> T.pack (show t))
+    return t
+  where forkFinallyReader = liftIO . flip forkFinally f
+                          . runStderrLoggingT . runReaderT bot
diff --git a/src/Web/Bot/Platform/Telegram.hs b/src/Web/Bot/Platform/Telegram.hs
new file mode 100644
--- /dev/null
+++ b/src/Web/Bot/Platform/Telegram.hs
@@ -0,0 +1,133 @@
+{-# LANGUAGE TemplateHaskell #-}
+-- |
+-- Module      :  Web.Bot.Platform.Telegram
+-- Copyright   :  Alexander Krupenkin 2016-2017
+-- License     :  BSD3
+--
+-- Maintainer  :  mail@akru.me
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Telegram bot API support.
+--
+module Web.Bot.Platform.Telegram (Telegram) where
+
+import Crypto.Hash (hash, Digest, Keccak_256)
+import qualified Web.Telegram.API.Bot as API
+import Control.Monad.IO.Class (liftIO)
+import Data.Text.Encoding (encodeUtf8)
+import Control.Exception (throwIO)
+import qualified Data.Text as T
+import Data.Monoid ((<>))
+import Data.Text (Text)
+
+import Web.Bot.Platform
+import Web.Bot.Message
+import Web.Bot.User
+import Web.Bot.Log
+
+-- | Telegram Bot API 2.0 platform
+data Telegram
+
+instance Platform Telegram where
+    trySelf        = _trySelf
+    sendMessage    = _sendMessage
+    messageHandler = _messageHandler
+    platformName   = const "Telegram Bot API 2.0"
+
+_trySelf :: APIToken a => Bot a ()
+_trySelf = do
+    token   <- apiToken
+    manager <- getManager
+    self    <- liftIO (API.getMe (API.Token token) manager)
+    name    <- fmap platformName returnPlatform
+    $logInfoS "Telegram" ("Platform: " <> name)
+    case self of
+        Left e -> do $logErrorS "Telegram" ("Init failure: " <> T.pack (show e))
+                     liftIO (throwIO e)
+        Right (API.Response u) ->
+            $logInfoS "Telegram" ("Init success, bot name: " <> API.user_first_name u)
+  where returnPlatform :: Bot a a
+        returnPlatform = return undefined
+
+-- | Updates pull timeout in seconds
+-- So it should be large number, but less TCP timeout
+pullTimeout :: Num a => a
+pullTimeout = 10
+
+-- | Infinity loop for getting updates from API
+_messageHandler :: APIToken a
+                => (User -> Message -> Bot a b)
+                -> Bot a c
+_messageHandler handler = go 0
+  where updates o t = API.getUpdates t (Just o) Nothing . Just
+        go offset = do
+            manager <- getManager
+            token   <- apiToken
+            -- Take updates
+            upd <- liftIO (updates offset (API.Token token) pullTimeout manager)
+            -- Check for errors
+            case API.result <$> upd of
+                Left e   -> do $logDebugS "Telegram"
+                                          ("Pull updates failure: " <> T.pack (show e))
+                               go offset
+                Right [] -> go offset
+                Right xs -> do
+                    -- Run handler for any update
+                    mapM_ (withUpdate handler) xs
+                    -- Step for the new offset
+                    go (maximum (API.update_id <$> xs) + 1)
+
+sha3 :: Text -> Text
+sha3 x = T.pack (show digest)
+  where digest :: Digest Keccak_256
+        digest = hash (encodeUtf8 x)
+
+withUpdate :: APIToken a
+           => (User -> Message -> Bot a b)
+           -> API.Update
+           -> Bot a ()
+withUpdate f update = case go of
+    Just (user, msg) -> f user msg >> return ()
+    Nothing -> return ()
+  where
+    go = (,) <$> mkUser <*> mkMessage
+    formatUserName u = API.user_first_name u <>
+        case API.user_last_name u of
+            Just last_name -> " " <> last_name
+            Nothing -> ""
+    formatUserHash u = sha3 ("telegram-" <> T.pack (show $ API.user_id u))
+    mkUser = User <$> (fmap (API.chat_id . API.chat) $ API.message update)
+                  <*> (fmap formatUserName (API.message update >>= API.from))
+                  <*> (fmap formatUserHash (API.message update >>= API.from))
+    mkMessage = MsgText <$> (API.message update >>= API.text)
+
+_sendMessage :: (ToMessage msg, APIToken a) => User -> msg -> Bot a ()
+_sendMessage user msg = do
+    manager <- getManager
+    token   <- apiToken
+    res <- liftIO (send (API.Token token) manager $ toMessage msg)
+    case res of
+        Right _ -> return ()
+        Left e -> do $logErrorS "Telegram" ("Failure send to " <> userName user
+                                            <> " with " <> T.pack (show e))
+                     _sendMessage user msg
+  where cid = T.pack $ show $ userChat user
+
+        send tok mgr MsgTyping =
+            let r = API.sendChatActionRequest cid API.Typing
+             in API.sendChatAction tok r mgr >>= return . fmap (const ())
+
+        send tok mgr (MsgText t) =
+            let r = (API.sendMessageRequest cid t)
+                  { API.message_reply_markup = Just API.replyKeyboardHide
+                  , API.message_parse_mode   = Just API.Markdown }
+             in API.sendMessage tok r mgr >>= return . fmap (const ())
+
+        send tok mgr (MsgKeyboard txt btnTexts) =
+            let btns     = fmap API.keyboardButton <$> btnTexts
+                keyboard = API.replyKeyboardMarkup btns
+                r = (API.sendMessageRequest cid txt)
+                  { API.message_reply_markup = Just keyboard
+                  , API.message_parse_mode   = Just API.Markdown }
+             in API.sendMessage tok r mgr >>= return . fmap (const ())
diff --git a/src/Web/Bot/Story.hs b/src/Web/Bot/Story.hs
new file mode 100644
--- /dev/null
+++ b/src/Web/Bot/Story.hs
@@ -0,0 +1,101 @@
+-- |
+-- Module      :  Web.Bot.Story
+-- Copyright   :  Alexander Krupenkin 2016
+-- License     :  BSD3
+--
+-- Maintainer  :  mail@akru.me
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Story is a dialog like abstraction for processing sparsed
+-- by messages data from user.
+--
+-- @
+--      hello :: Monad m => Text -> Text -> Int -> m BotMessage
+--      hello name surname age = toMessage $
+--          "Hello, " <> name <> " " <> surname <> "!\n"
+--       <> "You lost " <> (T.pack $ show age) <> " years =)"
+--
+--      helloStory :: BotConfig a => Story a
+--      helloStory _ = hello <$> question "How your name?"
+--                           <*> question "How your surname?"
+--                           <*> question "How old are you?"
+-- @
+--
+module Web.Bot.Story where
+
+import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)
+import Data.Text.Read (signed, decimal, double)
+import Control.Monad.IO.Class (MonadIO)
+import Pipes (Pipe, await, yield)
+import qualified Data.Text as T
+import Data.Text (Text)
+
+import Web.Bot.Message (Message(..), ToMessage(..))
+import Web.Bot.Platform (Bot)
+import Web.Bot.User (User)
+
+-- | Story is a pipe from user message to bot message
+-- and result is a final bot message.
+type Story a = User -> StoryT (Bot a) Message
+
+-- | Story transformer is based on 'Pipe'
+-- with fixed 'Message' in/out.
+type StoryT = Pipe Message Message
+
+-- | User message reply parser.
+class Answer a where
+    parse :: MonadIO m => Message -> ExceptT Text m a
+
+instance Answer Text where
+    parse (MsgText x) = return x
+    parse _           = throwE "Please send text message."
+
+instance Answer Double where
+    parse x = do
+        t <- parse x
+        case signed double t of
+            Left e -> throwE (T.pack e)
+            Right (v, "") -> return v
+            Right _       -> throwE "Please use only 0-9 and '.' chars."
+
+instance Answer Integer where
+    parse x = do
+        t <- parse x
+        case signed decimal t of
+            Left e -> throwE (T.pack e)
+            Right (v, x) -> if T.null x
+                            then return v
+                            else throwE "Please use only 0-9 chars."
+
+instance Answer Int where
+    parse x = do
+        v <- parse x
+        return (fromIntegral (v :: Integer))
+
+instance Answer Word where
+    parse x = do
+        v <- parse x
+        return (fromIntegral (v :: Integer))
+
+-- | Reply keyboard selection
+select :: (MonadIO m, Answer a) => Text -> [[Text]] -> StoryT m a
+{-# INLINE select #-}
+select q = replica . MsgKeyboard q
+
+-- | Bot text question.
+question :: (MonadIO m, Answer a) => Text -> StoryT m a
+{-# INLINE question #-}
+question = replica
+
+-- | Generalized story maker.
+-- The replica send message to user, when answer isn't parsed
+-- the error be sended and wait for correct answer.
+replica :: (ToMessage a, MonadIO m, Answer b) => a -> StoryT m b
+replica msg = do
+    yield (toMessage msg)
+    res <- runExceptT . parse =<< await
+    yield MsgTyping
+    case res of
+        Left e  -> replica e
+        Right a -> return a
diff --git a/src/Web/Bot/Story/Internal.hs b/src/Web/Bot/Story/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Web/Bot/Story/Internal.hs
@@ -0,0 +1,129 @@
+{-# LANGUAGE TemplateHaskell #-}
+-- |
+-- Module      :  Web.Bot.Story.Internal
+-- Copyright   :  Alexander Krupenkin 2016-2017
+-- License     :  BSD3
+--
+-- Maintainer  :  mail@akru.me
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Story bot implementation.
+--
+module Web.Bot.Story.Internal (storyBot) where
+
+import Control.Concurrent (killThread, ThreadId)
+import Data.IntMap.Strict as I
+import Control.Concurrent.Chan
+import Control.Concurrent.MVar
+import Control.Monad (forever)
+import qualified Data.Text as T
+import Data.Map.Strict as M
+import Data.Monoid ((<>))
+import Data.Text (Text)
+import Pipes
+
+import Web.Bot.Platform
+import Web.Bot.Metrics
+import Web.Bot.Persist
+import Web.Bot.Message
+import Web.Bot.Story
+import Web.Bot.User
+import Web.Bot.Log
+
+-- | 'Producer' from 'Chan' creator
+fromChan :: MonadIO m => Chan b -> Producer b m ()
+fromChan c = forever $ liftIO (readChan c) >>= yield
+
+-- | Incoming messages will be sended
+toSender :: (APIToken a, Persist a)
+         => User
+         -> (User -> Message -> Bot a ())
+         -> Consumer Message (Bot a) ()
+toSender u sender = forever $ do
+    await >>= lift . sender u
+    -- Metrics
+    lift $ runDB $ upsertBy (StatUser $ userIdent u)
+                            (UserStat (userIdent u) 0 1)
+                            [UserStatMessageOut +=. 1]
+
+
+-- | Chat ID based message splitter
+storyHandler :: (Persist a, APIToken a, ToMessage help)
+             => MVar (IntMap (Chan Message, ThreadId))
+             -> Map Message (Story a)
+             -> help
+             -> User -> Message -> Bot a ()
+storyHandler chats stories help user msg = do
+    -- Get a chat id
+    let newStory item = modifyMVar_ chats
+                                    (return . I.insert (userChat user) item)
+        deleteStory   = modifyMVar_ chats
+                                    (return . I.delete (userChat user))
+    -- Metrics
+    runDB $ do
+        upsertBy (StatUser $ userIdent user)
+                 (UserStat (userIdent user) 0 1)
+                 [UserStatMessageIn +=. 1]
+        upsertBy (UserIdentity $ userIdent user)
+                 user
+                 [ UserName =. userName user
+                 , UserChat =. userChat user ]
+
+    chatMap <- liftIO (readMVar chats)
+    -- Lookup chat id in the map
+    case I.lookup (userChat user) chatMap of
+        -- Chat exist => story is run now
+        Just (chan, tid) ->
+            -- Want to cancel it?
+            case msg of
+                "/cancel" -> do
+                    $logDebugS "Story" ("Cancel request, story "
+                                        <> T.pack (show tid) <> " killed.")
+                    liftIO (killThread tid)
+                    sendMessage user help
+
+                _ -> liftIO (writeChan chan msg)
+
+        -- Is no runned stories
+        Nothing ->
+            case M.lookup msg stories of
+                -- Unknown story, try to help
+                Nothing -> do
+                    sendMessage user help
+                    $logDebugS "Story" ("Unknown story "
+                                        <> T.pack (show msg) <> ".")
+
+                -- Story exist
+                Just story -> do
+                    -- Create chan
+                    chan <- liftIO newChan
+                    -- Story pipeline
+                    let pipeline = fromChan chan
+                                >-> (story user >>= yield)
+                                >-> toSender user sendMessage
+                    -- Run story in separate thread
+                    tid <- forkFinallyBot (runEffect pipeline)
+                                          (const deleteStory)
+                    -- Update userMap
+                    liftIO (newStory (chan, tid))
+
+                    -- Log and update metrics
+                    let sname = T.pack (show msg)
+                    runDB $ upsertBy (StatStory sname)
+                                     (StoryStat sname 1)
+                                     [StoryStatCalls +=. 1]
+                    $logDebugS "Story" ("Story " <> sname
+                                        <> " spawned at "
+                                        <> T.pack (show tid) <> ".")
+
+
+-- | User story handler
+storyBot :: (Persist a, APIToken a, ToMessage help)
+         => help -> Map Message (Story a) -> Bot a ()
+storyBot help stories = do
+    -- Create map from user chat to it story
+    chats <- liftIO (newMVar I.empty)
+    -- Run update loop
+    $logDebugS "Story" "Init success."
+    messageHandler $ storyHandler chats stories help
diff --git a/src/Web/Bot/User.hs b/src/Web/Bot/User.hs
new file mode 100644
--- /dev/null
+++ b/src/Web/Bot/User.hs
@@ -0,0 +1,31 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE TemplateHaskell            #-}
+{-# LANGUAGE TypeFamilies               #-}
+{-# LANGUAGE QuasiQuotes                #-}
+{-# LANGUAGE GADTs                      #-}
+-- |
+-- Module      :  Web.Bot.User
+-- Copyright   :  Alexander Krupenkin 2017
+-- License     :  BSD3
+--
+-- Maintainer  :  mail@akru.me
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Common used user model.
+--
+module Web.Bot.User where
+
+import Database.Persist.TH
+import Database.Persist
+import Data.Text (Text)
+
+share [mkPersist sqlSettings, mkMigrate "migrateUser"] [persistLowerCase|
+User
+    chat  Int
+    name  Text
+    ident Text Unique
+    UserIdentity ident
+    deriving Show
+|]
