Repository: therewillbecode/haskell-poker
Branch: master
Commit: 29f3717b3b8e
Files: 160
Total size: 443.2 KB

Directory structure:
gitextract_6a575bnu/

├── README.md
├── client/
│   ├── .babelrc
│   ├── .dockerignore
│   ├── .editorconfig
│   ├── .eslintignore
│   ├── .eslintrc
│   ├── .gitattributes
│   ├── .gitignore
│   ├── .prettierrc
│   ├── .travis.yml
│   ├── Dockerfile
│   ├── LICENSE.md
│   ├── README.md
│   ├── app/
│   │   ├── actions/
│   │   │   ├── auth.js
│   │   │   ├── games.js
│   │   │   ├── lobby.js
│   │   │   ├── profile.js
│   │   │   ├── socket.js
│   │   │   ├── tests/
│   │   │   │   └── auth.test.js
│   │   │   └── types.js
│   │   ├── app.js
│   │   ├── components/
│   │   │   ├── ActionPanel.js
│   │   │   ├── App.js
│   │   │   ├── Board.js
│   │   │   ├── Card.js
│   │   │   ├── Footer.js
│   │   │   ├── Game.js
│   │   │   ├── Home.js
│   │   │   ├── Lobby.js
│   │   │   ├── NavBar.js
│   │   │   ├── NotFoundPage.js
│   │   │   ├── Profile.js
│   │   │   ├── Seat.js
│   │   │   ├── SignInForm.js
│   │   │   ├── SignUpForm.js
│   │   │   └── Signout.js
│   │   ├── configureStore.js
│   │   ├── containers/
│   │   │   ├── AppContainer.js
│   │   │   ├── GameContainer.js
│   │   │   ├── HomeContainer.js
│   │   │   ├── LobbyContainer.js
│   │   │   ├── NavBarContainer.js
│   │   │   ├── ProfileContainer.js
│   │   │   ├── SignInFormContainer.js
│   │   │   └── SignUpFormContainer.js
│   │   ├── index.html
│   │   ├── middleware/
│   │   │   └── socket.js
│   │   ├── reducers/
│   │   │   ├── auth.js
│   │   │   ├── games.js
│   │   │   ├── lobby.js
│   │   │   ├── profile.js
│   │   │   ├── rootReducer.js
│   │   │   ├── socket.js
│   │   │   └── tests/
│   │   │       └── auth.test.js
│   │   ├── reducers.js
│   │   ├── selectors/
│   │   │   ├── auth.js
│   │   │   ├── games.js
│   │   │   ├── lobby.js
│   │   │   ├── profile.js
│   │   │   ├── route.js
│   │   │   ├── socket.js
│   │   │   └── tests/
│   │   │       └── games.test.js
│   │   ├── styles/
│   │   │   ├── _common.scss
│   │   │   ├── common/
│   │   │   │   ├── _colours.scss
│   │   │   │   ├── _mixins.scss
│   │   │   │   ├── _typography.scss
│   │   │   │   └── _variables.scss
│   │   │   ├── components/
│   │   │   │   ├── _buttons.scss
│   │   │   │   ├── _footer.scss
│   │   │   │   ├── _forms.scss
│   │   │   │   ├── _game.scss
│   │   │   │   ├── _lobby.scss
│   │   │   │   ├── _navbar.scss
│   │   │   │   └── game/
│   │   │   │       ├── _actionPanel.scss
│   │   │   │       ├── _boardCards.scss
│   │   │   │       ├── _cards.scss
│   │   │   │       ├── _seat.scss
│   │   │   │       ├── _slider.scss
│   │   │   │       └── _table.scss
│   │   │   ├── layout/
│   │   │   │   └── _app.scss
│   │   │   └── main.scss
│   │   └── utils/
│   │       └── request.js
│   ├── config/
│   │   ├── jest-mocks/
│   │   │   ├── cssModule.js
│   │   │   └── image.js
│   │   ├── jest.config.js
│   │   ├── test-setup.js
│   │   ├── webpack.base.babel.js
│   │   ├── webpack.dev.babel.js
│   │   └── webpack.prod.babel.js
│   ├── jest.config.js
│   ├── netlify.toml
│   ├── package.json
│   ├── server/
│   │   ├── index.js
│   │   ├── middlewares/
│   │   │   ├── addDevMiddlewares.js
│   │   │   ├── addProdMiddlewares.js
│   │   │   └── frontendMiddleware.js
│   │   └── util/
│   │       ├── argv.js
│   │       ├── logger.js
│   │       └── port.js
│   ├── shell.nix
│   └── static/
│       └── fonts/
│           └── GothamPro/
│               └── GothamHTF-BookCondensed.otf
├── docker-compose.yml
└── server/
    ├── .dev.env
    ├── .dockerignore
    ├── .gitignore
    ├── .projectile
    ├── ChangeLog.md
    ├── Dockerfile
    ├── README.md
    ├── Setup.hs
    ├── UNLICENSE.txt
    ├── app/
    │   └── Main.hs
    ├── bootstrap.sh
    ├── deploy-server.sh
    ├── deploy.sh
    ├── docs/
    │   ├── lobbyAPI.md
    │   ├── socket.md
    │   └── userAPI.md
    ├── package.yaml
    ├── ping.sh
    ├── provision.sh
    ├── server.service
    ├── shell.nix
    ├── src/
    │   ├── API.hs
    │   ├── Bots.hs
    │   ├── Database.hs
    │   ├── Env.hs
    │   ├── Poker/
    │   │   ├── ActionValidation.hs
    │   │   ├── Game/
    │   │   │   ├── Actions.hs
    │   │   │   ├── Blinds.hs
    │   │   │   ├── Game.hs
    │   │   │   ├── Hands.hs
    │   │   │   ├── Privacy.hs
    │   │   │   └── Utils.hs
    │   │   ├── Poker.hs
    │   │   └── Types.hs
    │   ├── Schema.hs
    │   ├── Socket/
    │   │   ├── Auth.hs
    │   │   ├── Clients.hs
    │   │   ├── Lobby.hs
    │   │   ├── Msg.hs
    │   │   ├── Setup.hs
    │   │   ├── Subscriptions.hs
    │   │   ├── Table.hs
    │   │   ├── Types.hs
    │   │   ├── Utils.hs
    │   │   └── Workers.hs
    │   ├── Socket.hs
    │   ├── Types.hs
    │   └── Users.hs
    ├── stack.yaml
    └── test/
        ├── Poker/
        │   ├── ActionSpec.hs
        │   ├── ActionValidationSpec.hs
        │   ├── BlindSpec.hs
        │   ├── GameSpec.hs
        │   ├── Generators.hs
        │   ├── HandSpec.hs
        │   └── UtilsSpec.hs
        ├── PokerSpec.hs
        └── Spec.hs

================================================
FILE CONTENTS
================================================

================================================
FILE: README.md
================================================
# Poker Maison

## A poker app crafted with Haskell and React

Supports games across multiple tables in realtime.

Player moves are timed in order to ensure that games keep running if players disconnect.

The UI and backend are all implemented in less than seven thousand lines of code.

![screenshot](https://s11.gifyu.com/images/SgQfh.gif)


[![License: Unlicense](https://img.shields.io/badge/license-Unlicense-blue.svg)](http://unlicense.org/)

![alt text](https://s5.gifyu.com/images/ezgif.com-optimize-1e35dcba1eceb51f5.gif "Demo")

## How to run in docker

Skip this section if you would rather avoid docker.

### Docker Prerequisites

In order to use Docker have the following installed.

- [Docker](https://docs.docker.com/compose/install/) (17.12.0+)
- [Docker Compose](https://docs.docker.com/v17.09/engine/installation/)
- [Docker Machine](https://docs.docker.com/machine/install-machine/)

Firstly start Docker Machine

```bash
docker-machine start
```

Then set the correct variables in your terminal so you can connect to Docker Machine

```bash
eval $(docker-machine env)
```

Now build the images. This will take a while.

```
docker-compose up
```

Now go navigate to http://192.168.99.100:3000 in your browser and the app should be running.

The above ip address is the one for your docker-machine VM if you are on the default settings. By default docker-machine doesn't serve localhost but instead uses 192.168.99.100 as the host.

You can simulate multiple players in the same game on on your machine if you navigate to the above url in a few different browser tabs. Eac time you open up a new tab just remember to log out after you have signed in as the browser will cache the access_token for the last logged in user for each new tab as URL is the same.

## Common Docker Problems

### Docker has the wrong TLS setting

If you get the error below then Docker Compose is not using the correct TLS version.

```
Building web
ERROR: SSL error: HTTPSConnectionPool(host='192.168.99.100', port=2376): Max retries exceeded with url: /v1.30/build?q=False&pull=False&t=server_web&nocache=False&forcerm=False&rm=True (Caused by SSLError(SSLError(1, u'[SSL: TLSV1_ALERT_PROTOCOL_VERSION] tlsv1 alert protocol version (_ssl.c:727)'),))
```

You can fix this by setting the following environment variable with the correct TLS version.

```bash
export COMPOSE_TLS_VERSION=TLSv1_2
```

### Container runs out of memory

If the server docker container runs out of memory whilst building. Whis would look like this.

```
--  While building package Cabal-2.4.1.0 using:
      /root/.stack/setup-exe-cache/x86_64-linux/Cabal-simple_mPHDZzAJ_2.4.0.1_ghc-8.6.5 --builddir=.stack-work/dist/x86_64-linux/Cabal-2.4.0.1 build --ghc-options ""
    Process exited with code: ExitFailure (-9) (THIS MAY INDICATE OUT OF MEMORY)
```

Then set increase the memory available to the VM you are using for docker-machine.
Assuming your VM is named "default", run:

```bash
docker-machine stop default
VBoxManage modifyvm default --memory 4096
docker-machine start default
```

### Slow builds

If you want to speed up builds then replace `n` in the command below
with the number of cores your machine has and run the command.
The command below assumes that "default" is the name of the VM Docker Machine is using.

```bash
docker-machine stop default
VBoxManage modifyvm default --cpus n
docker-machine start default
```

# Building locally from scratch.

The following steps are based on an Ubuntu distribution.

## Back End

Firstly make sure you have ghc and stack installed in order to compile the back end written in Haskell.
If you need to install the Haskell platform then run

```bash
curl -sSL https://get.haskellstack.org/ | sh
```

Secondly install libpq (c bindings to postgres)

```bash
sudo apt-get install libpq-dev
```

Next install redis.

```bash
sudo apt-get install redis
```

Navigate to the server/ directory.

```bash
cd server
```

Compile the back end poker server.

```bash
stack build
```

## Now we need to set some config.

Ensure postgresql 10 is installed and running.

Set the env var so that the server has the postgresql connection string.
Of course you will need to change the db connection parameters below to match your local database.

```bash
export dbConnStr='host=0.0.0.0 port=5432 user=postgres dbname=pokerdbtest password=postgres
```

Set env variable with the secret key for generating auth tokens.
Note that this secret must be 32 characters long or it won't work.

```bash
export secret="changeme077cf4e7441c32d2d0a86b4c"
```

Lastly ensure redis-server is running in the background on default port

```bash
redis-server
```

Now run the server locally. The default user API port is 8000 and websocket port is 5000.

```bash
stack run
```

## Front End

Install node version 10.16.3 and then install yarn globally

```bash
npm i -g yarn@1.17.3
```

Install a required system dependency for node-sass .

```bash
sudo apt-get install libpng-dev
```

Navigate to the client/ directory with

```bash
cd client
```

Then just run.

```bash
yarn start
```

Now you are ready to play poker!

### Simulating a multiplayer game locally

You may want to play against yourself when you are developing locally so just
run the clients on two separate ports.

In your first terminal run

```
PORT=8001 yarn start
```

Then open another terminal and run

```
PORT=8002 yarn start
```

Now just open two tabs in your browser navigating to

```
localhost:8001
```

and

```
localhost:8002
```

## Running Tests

To run the test suite on the backend which has over a hundred tests

```bash
cd server && stack test
```

## Contributions Welcome

Have a look at the issues if you want some starting ideas on how to get involved.

Feel free to open any issues with potential enhancements or bugs you have found.

## License

This is free and unencumbered software released into the public domain.  
For more information, please refer to the `UNLICENSE` file or [unlicense.org](http://unlicense.org).


================================================
FILE: client/.babelrc
================================================
{
  "presets": [
    [
      "env",
      {
        "modules": false
      }
    ],
    "react",
    "stage-0"
  ],
  "env": {
    "production": {
      "only": ["app"],
      "plugins": [
        "transform-react-remove-prop-types",
        "transform-react-constant-elements",
        "transform-react-inline-elements"
      ]
    },
    "test": {
      "plugins": ["transform-es2015-modules-commonjs", "dynamic-import-node"]
    }
  }
}


================================================
FILE: client/.dockerignore
================================================
node_modules

================================================
FILE: client/.editorconfig
================================================
# editorconfig.org

root = true

[*]
charset = utf-8
end_of_line = lf
insert_final_newline = true
indent_style = space
indent_size = 2
trim_trailing_whitespace = true

[*.md]
trim_trailing_whitespace = false


================================================
FILE: client/.eslintignore
================================================
/build/**
/coverage/**
/docs/**
/jsdoc/**
/templates/**
/tests/bench/**
/tests/fixtures/**
/tests/performance/**
/tmp/**
/lib/util/unicode/is-combining-character.js
/sass/
/node/modules
test.js
!.eslintrc.js
.gitignore

================================================
FILE: client/.eslintrc
================================================
{
  "parser": "babel-eslint",
  "extends": [
    "airbnb",
    "plugin:react/recommended",
    "prettier/react",
    "prettier"
  ],
  "env": {
    "browser": true,
    "node": true,
    "jest": true,
    "es6": true
  },
  "plugins": [
    "react",
    "jsx-a11y",
    "prettier"
  ],
  "parserOptions": {
    "ecmaVersion": 6,
    "sourceType": "module",
    "ecmaFeatures": {
      "jsx": true
    }
  },
  "rules": {
    "no-param-reassign": "off",
    "arrow-parens": "off",
    "function-paren-newline": "off",
    "comma-dangle": [
      "error",
      "only-multiline"
    ],
    "import/no-extraneous-dependencies": 0,
    "import/prefer-default-export": 0,
    "indent": [
      2,
      2,
      {
        "SwitchCase": 1
      }
    ],
    "max-len": 0,
    "no-console": 1,
    "react/forbid-prop-types": 0,
    "react/jsx-curly-brace-presence": "off",
    "react/jsx-first-prop-new-line": [
      2,
      "multiline"
    ],
    "react/jsx-filename-extension": 0,
    "react/self-closing-comp": 0,
    "jsx-a11y/anchor-is-valid": 0
  },
  "settings": {
    "import/resolver": {
      "webpack": {
        "config": "./config/webpack.prod.babel.js"
      }
    }
  }
}

================================================
FILE: client/.gitattributes
================================================
# From https://github.com/Danimoth/gitattributes/blob/master/Web.gitattributes

# Handle line endings automatically for files detected as text
# and leave all files detected as binary untouched.
* text=auto

#
# The above will handle all files NOT found below
#

#
## These files are text and should be normalized (Convert crlf => lf)
#

# source code
*.php text
*.css text
*.sass text
*.scss text
*.less text
*.styl text
*.js text eol=lf
*.coffee text
*.json text
*.htm text
*.html text
*.xml text
*.svg text
*.txt text
*.ini text
*.inc text
*.pl text
*.rb text
*.py text
*.scm text
*.sql text
*.sh text
*.bat text

# templates
*.ejs text
*.hbt text
*.jade text
*.haml text
*.hbs text
*.dot text
*.tmpl text
*.phtml text

# server config
.htaccess text
.nginx.conf text

# git config
.gitattributes text
.gitignore text
.gitconfig text

# code analysis config
.jshintrc text
.jscsrc text
.jshintignore text
.csslintrc text

# misc config
*.yaml text
*.yml text
.editorconfig text

# build config
*.npmignore text
*.bowerrc text

# Heroku
Procfile text
.slugignore text

# Documentation
*.md text
LICENSE text
AUTHORS text


#
## These files are binary and should be left untouched
#

# (binary is a macro for -text -diff)
*.png binary
*.jpg binary
*.jpeg binary
*.gif binary
*.ico binary
*.mov binary
*.mp4 binary
*.mp3 binary
*.flv binary
*.fla binary
*.swf binary
*.gz binary
*.zip binary
*.7z binary
*.ttf binary
*.eot binary
*.woff binary
*.pyc binary
*.pdf binary


================================================
FILE: client/.gitignore
================================================
# Don't check auto-generated stuff into git
coverage
build
node_modules
stats.json

# Cruft
.DS_Store
npm-debug.log
.idea

# Logs
yarn-error.log



================================================
FILE: client/.prettierrc
================================================
{
  "singleQuote": true,
  "semi": false
}


================================================
FILE: client/.travis.yml
================================================
language: node_js

os: osx

node_js:
  - 8
  - 6
  
script:
  - npm run test
  - npm run build

notifications:
  email:
    on_failure: change

cache:
  yarn: true
  directories:
    - node_modules


================================================
FILE: client/Dockerfile
================================================
# base image
FROM node:10.16.3-alpine

RUN apk add --no-cache \
    autoconf \
    automake \
    bash \
    g++ \
    libc6-compat \
    libjpeg-turbo-dev \
    libpng-dev \
    make \
    nasm

WORKDIR /app

RUN npm install yarn@1.17.3 -g

# install and cache app dependencies
COPY package.json .

RUN yarn

COPY . .

CMD yarn run start:docker


================================================
FILE: client/LICENSE.md
================================================
The MIT License (MIT)

Copyright (c) 2018 Dinesh Pandiyan

Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.


================================================
FILE: client/README.md
================================================
<img src="https://raw.githubusercontent.com/flexdinesh/react-redux-boilerplate/master/app/components/Header/images/banner.jpg" alt="react redux boilerplate banner" align="center" />

<br />

<div align="center">A minimal, beginner friendly React-Redux boilerplate with all the industry best practices</div>

<br />

<div align="center">
  <!-- Dependency Status -->
  <a href="https://david-dm.org/flexdinesh/react-redux-boilerplate">
    <img src="https://david-dm.org/flexdinesh/react-redux-boilerplate.svg" alt="Dependency Status" />
  </a>
  <!-- devDependency Status -->
  <a href="https://david-dm.org/flexdinesh/react-redux-boilerplate#info=devDependencies">
    <img src="https://david-dm.org/flexdinesh/react-redux-boilerplate/dev-status.svg" alt="devDependency Status" />
  </a>
  <!-- Build Status -->
  <a href="https://travis-ci.org/flexdinesh/react-redux-boilerplate">
    <img src="https://travis-ci.org/flexdinesh/react-redux-boilerplate.svg" alt="Build Status" />
  </a>
  <!-- Gitter -->
  <a href="https://gitter.im/flexdinesh/react-redux-boilerplate">
    <img src="https://camo.githubusercontent.com/54dc79dc7da6b76b17bc8013342da9b4266d993c/68747470733a2f2f6261646765732e6769747465722e696d2f6d78737462722f72656163742d626f696c6572706c6174652e737667" alt="Gitter Chat" />
  </a>
</div>

<br />

<div align="center">
  <sub>Created by <a href="https://twitter.com/flexdinesh">Dinesh Pandiyan</a></sub>
</div>


## Why? [![start with why](https://img.shields.io/badge/start%20with-why%3F-brightgreen.svg?style=flat)](http://www.ted.com/talks/simon_sinek_how_great_leaders_inspire_action)

The whole React community knows and will unanimously agree that [react-boilerplate](https://github.com/react-boilerplate/react-boilerplate) is the ultimate starter template for kickstarting a React project. It's setup with all the industry best practices and standards. But it also has a lot more than what you just need to start a react-redux app. It took me quite some time to get my head around what was happening in the codebase and it's clearly not for starters. They quote this right in their readme,

> Please note that this boilerplate is **production-ready and not meant for beginners**! If you're just starting out with react or redux, please refer to https://github.com/petehunt/react-howto instead. If you want a solid, battle-tested base to build your next product upon and have some experience with react, this is the perfect start for you.

So it involves a lot of additional learning curve to get started with [react-boilerplate](https://github.com/react-boilerplate/react-boilerplate). That's why I forked it, stripped it down and made this _leaner, **beginner friendly**_ boilerplate without all the additional complexity.


## Features

This boilerplate features all the latest tools and practices in the industry.

- _React.js_ - **React 16**✨, React Router 5
- _Redux.js_ - Redux saga, Redux immutable and Reselect
- _Babel_ - ES6, ESNext, Airbnb and React/Recommended config
- _Webpack_ - **Webpack 4**✨, Hot Reloading, Code Splitting, Optimized Prod Build and more
- _Test_ - Jest with Enzyme
- _Lint_ - ESlint
- _Styles_ - SCSS Styling

Here are a few highlights to look out for in this boilerplate 

<dl>
  <dt>Instant feedback</dt>
  <dd>Enjoy the best DX (Developer eXperience) and code your app at the speed of thought! Your saved changes to the CSS and JS are reflected instantaneously without refreshing the page. Preserve application state even when you update something in the underlying code!</dd>

  <dt>Next generation JavaScript</dt>
  <dd>Use template strings, object destructuring, arrow functions, JSX syntax and more, today.</dd>

  <dt>Component Specific Styles</dt>
  <dd>Separate styles for each component. Style in the good old scss way but still keep it abstracted for each component.</dd>

  <dt>Industry-standard routing</dt>
  <dd>It's natural to want to add pages (e.g. `/about`) to your application, and routing makes this possible.</dd>

  <dt>Predictable state management</dt>
  <dd>Unidirectional data flow allows for change logging and time travel debugging.</dd>

  <dt>SEO</dt>
  <dd>We support SEO (document head tags management) for search engines that support indexing of JavaScript content. (eg. Google)</dd>
</dl>

But wait... there's more!

  - *The best test setup:* Automatically guarantee code quality and non-breaking
    changes. (Seen a react app with 99% test coverage before?)
  - *The fastest fonts:* Say goodbye to vacant text.
  - *Stay fast*: Profile your app's performance from the comfort of your command
    line!
  - *Catch problems:* TravisCI setup included by default, so your
    tests get run automatically on each code push.


## Quick start

1. Clone this repo using `git clone https://github.com/flexdinesh/react-redux-boilerplate.git`
2. Move to the appropriate directory: `cd react-redux-boilerplate`.<br />
3. Run `yarn` or `npm install` to install dependencies.<br />
4. Run `npm start` to see the example app at `http://localhost:3000`.

Now you're ready build your beautiful React Application!


## Info

These are the things I stripped out from [react-boilerplate](https://github.com/react-boilerplate/react-boilerplate) - _github project rules, ngrok tunneling, shjs, service worker, webpack dll plugin, i18n, styled-components, code generators and a few more._


## License

MIT license, Copyright (c) 2018 Dinesh Pandiyan.


================================================
FILE: client/app/actions/auth.js
================================================
import axios from 'axios'

import * as types from './types'
import { checkStatus } from '../utils/request'

/* Action Creators for Socket API authentication */

// Redux Socket Middleware intercepts this action and handles connection logic
export const connectSocket = token => ({
  type: types.CONNECT_SOCKET,
  token
})

export const disconnectSocket = () => ({ type: types.DISCONNECT_SOCKET })

export const logoutUser = history => dispatch => {
  localStorage.removeItem('token')
  dispatch(logout())
  dispatch(disconnectSocket())
  history.push('/')
}

console.log('env var', process.env)

const AUTH_API_URL =
  process.env.NODE_ENV === 'docker'
    ? 'http://192.168.99.100:8000'
    : process.env.NODE_ENV === 'production'
    ? 'https://tenpoker.co.uk'
    : 'http://localhost:8000'

export const authRequested = () => ({ type: types.AUTH_REQUESTED })

export const authSuccess = username => ({ type: types.AUTHENTICATED, username })

export const authError = error => ({ type: types.AUTHENTICATION_ERROR, error })

export const logout = () => ({ type: types.UNAUTHENTICATED })

export function login(username, password, history) {
  return async dispatch => {
    dispatch(authRequested())
    axios
      .post(
        `${AUTH_API_URL}/login`,
        {
          loginUsername: username,
          loginPassword: password
        },
        {
          headers: {
            'Access-Control-Allow-Origin': '*'
          }
        }
      )
      .then(({ data }) => {
        const { access_token } = data
        dispatch(authSuccess(username))
        dispatch(connectSocket(access_token))
        localStorage.setItem('token', JSON.stringify({ ...data, username }))
        history.push('/profile')
      })
      .catch(err => dispatch(authError(err)))
  }
}

export function register(username, email, password, history) {
  return async dispatch => {
    dispatch(authRequested())
    axios
      .post(`${AUTH_API_URL}/register`, {
        newUsername: username,
        newUserEmail: email,
        newUserPassword: password
      })
      .then(({ data }) => {
        const { access_token } = data
        dispatch(authSuccess(username))
        dispatch(connectSocket(access_token))
        localStorage.setItem('token', JSON.stringify({ ...data, username }))
        history.push('/profile')
      })
      .catch(err => dispatch(authError(err)))
  }
}


================================================
FILE: client/app/actions/games.js
================================================
import * as types from './types'

export const newGameState = (tableName, gameState) => ({
  type: types.NEW_GAME_STATE,
  tableName,
  gameState
})

export const postBigBlind = tableName => ({
  type: types.POST_BIG_BLIND,
  data: {
    tag: 'GameMsgIn',
    contents: {
      tag: 'GameMove',
      contents: [tableName, { tag: 'PostBlind', contents: 'Big' }]
    }
  }
})

export const postSmallBlind = tableName => ({
  type: types.POST_SMALL_BLIND,
  data: {
    tag: 'GameMsgIn',
    contents: {
      tag: 'GameMove',
      contents: [tableName, { tag: 'PostBlind', contents: 'Small' }]
    }
  }
})

export const bet = (tableName, amount) => ({
  type: types.BET,
  data: {
    tag: 'GameMsgIn',
    contents: {
      tag: 'GameMove',
      contents: [tableName, { tag: 'Bet', contents: Number(amount) }]
    }
  }
})

export const raise = (tableName, amount) => ({
  type: types.RAISE,
  data: {
    tag: 'GameMsgIn',
    contents: {
      tag: 'GameMove',
      contents: [tableName, { tag: 'Raise', contents: Number(amount) }]
    }
  }
})

export const call = tableName => ({
  type: types.CALL,
  data: {
    tag: 'GameMsgIn',
    contents: { tag: 'GameMove', contents: [tableName, { tag: 'Call' }] }
  }
})

export const check = tableName => ({
  type: types.CHECK,
  data: {
    tag: 'GameMsgIn',
    contents: { tag: 'GameMove', contents: [tableName, { tag: 'Check' }] }
  }
})

export const fold = tableName => ({
  type: types.FOLD,
  data: {
    tag: 'GameMsgIn',
    contents: { tag: 'GameMove', contents: [tableName, { tag: 'Fold' }] }
  }
})

export const leaveSeat = tableName => ({
  type: types.LEAVE_SEAT,
  data: {
    tag: 'GameMsgIn',
    contents: {
      tag: 'LeaveSeat',
      contents: tableName
    }
  }
})

export const sitIn = tableName => ({
  type: types.SIT_IN,
  data: { tag: 'GameMove', contents: [tableName, { tag: 'SitIn' }] }
})


================================================
FILE: client/app/actions/lobby.js
================================================
/* 
   The data value of the action forms the websocket msg payload.
*/
import * as types from './types'

export const getLobby = () => ({
  type: types.GET_LOBBY,
  data: { tag: 'GetTables' }
})

export const newLobby = lobby => ({ type: types.NEW_LOBBY, lobby })

// should be moved as this is game action
export const takeSeat = (tableName, chips) => ({
  type: types.TAKE_SEAT,
  data: {
    tag: 'GameMsgIn',
    contents: {
      tag: 'TakeSeat',
      contents: [tableName, Number(chips)]
    }
  }
})

export const subscribeToTable = tableName => ({
  type: types.SUBSCRIBE_TO_TABLE,
  data: { tag: 'SubscribeToTable', contents: tableName }
})


================================================
FILE: client/app/actions/profile.js
================================================
import axios from 'axios'

import * as types from './types'

/* Action Creators for User API authentication */
const AUTH_API_URL = 'https://tenpoker.co.uk'
//process.env.NODE_ENV === 'production' ? 'https://tenpoker.co.uk' : 'http://localhost:8000'

export const getProfileRequest = () => ({ type: types.GET_PROFILE_REQUEST })

export const getProfileSuccess = profile => ({
  type: types.GET_PROFILE_SUCCESS,
  profile
})

export const getProfileErr = error => ({ type: types.GET_PROFILE_ERR, error })

export const getProfile = username => {
  return dispatch => {
    const token = localStorage.getItem('token')
    if (token) {
      try {
        const { access_token } = JSON.parse(token)
        dispatch(getProfileRequest())
        console.log('access token', access_token)
        axios
          .get(`${AUTH_API_URL}/profile`, {
            headers: {
              Authorization: access_token,
              'Content-Type': 'application/json'
            }
          })
          .then(({ data }) => {
            const profile = {
              chipsInPlay: data.proChipsInPlay,
              availableChips: data.proAvailableChips,
              userCreatedAt: data.proUserCreatedAt,
              username: data.proUsername,
              email: data.proEmail
            }

            dispatch(getProfileSuccess(profile))
          })
          .catch(err => dispatch(getProfileErr(err)))
      } catch (e) {
        console.log(e)
        dispatch(getProfileErr(e))
      }
    } else {
      dispatch(getProfileErr('No JWT token for profile request'))
    }
  }
}


================================================
FILE: client/app/actions/socket.js
================================================
import * as types from './types'

export const socketConnErr = err => ({ type: types.SOCKET_CONN_ERR, err })

export const socketConnected = socket => ({ type: types.SOCKET_CONNECTED, socket })

export const socketAuthSuccess = () => ({ type: types.SOCKET_AUTH_SUCCESS })

export const socketAuthErr = err => ({ type: types.SOCKET_AUTH_ERR, err })

export const socketReconnecting = () => ({ type: "SOCKET_RECONNECTING" })

export const socketReconnectFail = () => ({ type: "SOCKET_RECONNECT_FAIL" })

================================================
FILE: client/app/actions/tests/auth.test.js
================================================
/* eslint-disable */
import configureMockStore from "redux-mock-store";
import thunk from "redux-thunk";
import axios from "axios";

import { authRequested, authError, authSuccess, login, logout, register } from "../auth";
import * as types from "../types";

const localStorageMock = {
  getItem: jest.fn(),
  setItem: jest.fn(),
  clear: jest.fn()
};

global.localStorage = localStorageMock;

const jestMock = response => jest
  .fn()
  .mockImplementation(
    () =>
      new Promise(
        (resolve, reject) =>
          response.status !== 200 ? reject(response) : resolve(response)
      )
  );

const stubAxios = response => {
  axios.get = jestMock(response)
  axios.post = jestMock(response)
};

describe("auth actions", () => {
  describe("action creators", () => {
    describe("authRequested", () => {
      it("should return correct action an authSuccess action for received asset", () => {
        expect(authRequested()).toEqual({ type: types.AUTH_REQUESTED })
      });
    })

    describe("authSuccess", () => {
      it("should return correct action an authSuccess action for received asset", () => {
        const username = 'Argo'
        expect(authSuccess(username)).toEqual({ type: types.AUTHENTICATED, username })
      });
    })

    describe("authError", () => {
      it("should return correct action an authSuccess action for received asset", () => {
        const error = '404'
        expect(authError(error)).toEqual({ type: types.AUTHENTICATION_ERROR, error })
      });
    })

    describe("logout", () => {
      it("should return correct action an authSuccess action for received asset", () => {
        expect(logout()).toEqual({ type: types.UNAUTHENTICATED })
      });
    })
  })

  describe("thunk actions", () => {
    let mockStore;
    let historyMock = { push: jest.fn() } // mocks react router history

    describe("signIn", () => {
      beforeEach(() => {
        const middlewares = [thunk];
        mockStore = configureMockStore(middlewares);
      });

      afterEach(() => {
        axios.get.mockReset();
        historyMock.push.mockReset()
        localStorage.clear()
      });

      afterAll(() => {
        axios.get.mockRestore();
      });

      const username = 'Argo'
      const email = 'email@email.com'
      const password = 'password'

      it("should dispatch correct actions when authentication succeeds", () => {
        const store = mockStore({});
        const expectedActions = [
          { type: types.AUTH_REQUESTED },
          { type: types.AUTHENTICATED }
        ];

        stubAxios({ status: 200, data: { token: 'JWT' } });
        return store.dispatch(login({ email, password }, historyMock)).then(() => {
          expect(store.getActions()).toEqual(expectedActions);
        });
      });


      it("should dispatch correction actions when error occurs while fetching user profile", () => {
        const store = mockStore({});
        const error = {
          "response": { "data": "Unauthorized" }, "status": 401
        }
        const expectedActions = [
          { type: types.AUTH_REQUESTED },
          { type: types.AUTHENTICATION_ERROR, error }
        ];

        stubAxios({ status: 401, response: { data: "Unauthorized" } });
        return store.dispatch(login({ email, password }, historyMock)).then(() => {
          expect(store.getActions()).toEqual(expectedActions);
        });
      });

      it("should redirect to correct route on auth success", () => {
        const store = mockStore({});
        const expectedRoute = '/lobby'
        stubAxios({ status: 200, data: { token: 'JWT' } });

        return store.dispatch(login({ email, password }, historyMock)).then(() => {
          expect(historyMock.push).toBeCalledWith(expectedRoute)
        });
      });

      it("should store JWT token in localStorage on auth success", () => {
        const store = mockStore({});
        const token = 'JWT'
        stubAxios({ status: 200, data: { token } });

        return store.dispatch(login({ email, password }, historyMock)).then(() => {
          expect(localStorage.setItem).toBeCalledWith('token', token)
        });
      });
    });
  });
});

================================================
FILE: client/app/actions/types.js
================================================
/* Actions prefixed with /server denote actions which trigger the sending of a websocket msg to server*/

/* User API Types */
export const AUTH_REQUESTED = 'AUTH_REQUESTED'
export const AUTHENTICATED = 'AUTHENTICATED'
export const UNAUTHENTICATED = 'UNAUTHENTICATED'
export const AUTHENTICATION_ERROR = 'AUTHENTICATION_ERROR'

/* Retrieve User Profile */
export const GET_PROFILE_REQUEST = 'GET_PROFILE_REQUEST'
export const GET_PROFILE_SUCCESS = 'GET_PROFILE_SUCCESS'
export const GET_PROFILE_ERR = 'GET_PROFILE_ERR'

/* Websocket Action Types */
export const CONNECT_SOCKET = 'CONNECT_SOCKET'
export const SOCKET_CONNECTED = 'SOCKET_CONNECTED'
export const DISCONNECT_SOCKET = 'DISCONNECT_SOCKET'
export const SOCKET_AUTH_SUCCESS = 'SOCKET_AUTH_SUCCESS'
export const SOCKET_AUTH_ERR = 'SOCKET_AUTH_ERR'
export const SOCKET_CONN_ERR = 'SOCKET_CONN_ERR'

/* Lobby Action Types */
export const GET_LOBBY = 'server/GET_LOBBY'
export const NEW_LOBBY = 'NEW_LOBBY'
export const TAKE_SEAT = 'server/TAKE_SEAT'
export const SUBSCRIBE_TO_TABLE = 'server/SUBSCRIBE_TO_TABLE'

/* Game Action Types */
export const NEW_GAME_STATE = 'NEW_GAME_STATE'
export const SUCCESSFULLY_SAT_DOWN = 'SUCCESSFULLY_SAT_DOWN'
export const POST_BIG_BLIND = 'server/POST_BIG_BLIND'
export const POST_SMALL_BLIND = 'server/POST_SMALL_BLIND'
export const BET = 'server/BET'
export const RAISE = 'server/RAISE'
export const CHECK = 'server/CHECK'
export const FOLD = 'server/FOLD'
export const CALL = 'server/CALL'
export const SIT_IN = 'server/SIT_IN'
export const LEAVE_SEAT = 'server/LEAVE_SEAT'


================================================
FILE: client/app/app.js
================================================
/**
 * app.js
 *
 * This is the entry file for the application, only setup and boilerplate
 * code.
 */

// Needed for redux-saga es6 generator support
import 'babel-polyfill'

// Import all the third party stuff
import React from 'react'
import ReactDOM from 'react-dom'
import { Provider } from 'react-redux'
import { ConnectedRouter } from 'react-router-redux'
import createHistory from 'history/createBrowserHistory'

import 'sanitize.css/sanitize.css'

import AppContainer from 'containers/AppContainer'

import { authSuccess } from './actions/auth'

import 'styles/main.scss'

import configureStore from './configureStore'

// Create redux store with history
const initialState = {}
const history = createHistory()
const store = configureStore(initialState, history)
const MOUNT_NODE = document.getElementById('app')

const render = () => {
  ReactDOM.render(
    <Provider store={store}>
      <ConnectedRouter history={history}>
        <AppContainer />
      </ConnectedRouter>
    </Provider>,
    MOUNT_NODE
  )
}

if (module.hot) {
  // Hot reloadable React components and translation json files
  // modules.hot.accept does not accept dynamic dependencies,
  // have to be constants at compile-time
  module.hot.accept(['containers/AppContainer'], () => {
    ReactDOM.unmountComponentAtNode(MOUNT_NODE)
    render()
  })
}

// If we have a JWT token in localStorage then treat user as authenticated
const token = localStorage.getItem('token')

if (token) {
  try {
    const { username } = JSON.parse(localStorage.getItem('token'))
    store.dispatch(authSuccess(username))
  } catch (e) {
    console.log(e)
  }
}

render()


================================================
FILE: client/app/components/ActionPanel.js
================================================
import React from 'react'

// TODO move to own component called pocket cards
import Card from './Card'

const getPocketCards = cards =>
  cards !== undefined && cards !== null ? cards.map(card => {
    const rank = card.get('rank')
    const suit = card.get('suit')

    return (<Card
      key={rank + suit}
      rank={rank}
      suit={suit}
    />)
  }) : ''




const ActionPanel = ({
  updateBetValue,
  betValue,
  bet,
  raise,
  call,
  fold,
  check,
  postSmallBlind,
  postBigBlind,
  sitDown,
  leaveGameSeat,
  userPocketCards,
  gameStage,
  sitIn,
  bigBlind,
  maxCurrBet,
  isTurnToAct,
  availableActions,
  userPlayer
}) => {
  console.log('available actions', availableActions)
  console.log(gameStage)
  const preDealActions =
    gameStage === "PreDeal" ? <React.Fragment>

      {availableActions.includes("PostBigBlind") ?
        <button
          type="button"
          onClick={() => postBigBlind()} className="button">
          Post Big Blind
      </button> : ''}

      {availableActions.includes("PostSmallBlind") ?
        <button
          type="button" onClick={() => postSmallBlind()} className="button">
          post Small Blind
      </button> : ' '}

      {userPlayer ? '' : <button
        type="button"
        onClick={() => sitDown(betValue)}
        className="button">
        Sit Down Bet <span className='monospaced-font-bold'>
          {betValue}</span>
      </button>}

      {userPlayer && (userPlayer.get("_playerState") === "SatOut") ? <button
        type="button"
        onClick={() => sitIn()}
        className="button">
        Sit In
          </button> : ''}

      {userPlayer ? <button
        type="button"
        onClick={() => leaveGameSeat()}
        className="button">
        Leave Seat
    </button> : ' '}

    </React.Fragment> : '';


  let minBet = maxCurrBet >= bigBlind ? 2 * maxCurrBet : bigBlind

  return (
    <div className='action-panel'>


      <div className='user-actions-container'>
        {(availableActions.includes("Bet") || !userPlayer || availableActions.includes("Raise")) ?
          <div className="slidecontainer">
            <input type="range"

              max={userPlayer ? userPlayer.get("_chips") : 2000}
              min={userPlayer ? minBet : 1500}
              step={5}
              value={betValue}
              className="slider"
              id="myRange"

              onChange={updateBetValue} />
          </div> : ''}
        {preDealActions}
        {true ?   // gameStage !== 'Showdown' && gameStage !== 'PreDeal' && isTurnToAct ?
          <React.Fragment>

            {availableActions.includes("Check") ?
              <button type="button" onClick={() => check()} className="button">
                Check
       </button> : ''}

            {availableActions.includes("Call") ?
              <button type="button" onClick={() => call()} className="button">
                Call</button> : ''}

            {availableActions.includes("Bet") ? <button
              type="button"
              onClick={() => bet(betValue)} className="button">Bet <span className='monospaced-font-bold'>
                {betValue}</span></button> : ''}
            {availableActions.includes("Raise") ?
              <button
                type="button"
                onClick={() => raise(betValue)}
                className="button">
                Raise {betValue}</button> : ''}
            {availableActions.includes("Fold") ? <button
              type="button"
              onClick={() => fold()}
              className="button">
              Fold
          </button> : ''}
          </React.Fragment>
          : ''}

      </div>
    </div>)
}


export default ActionPanel


================================================
FILE: client/app/components/App.js
================================================
/**
 *
 * App
 *
 * This component is the skeleton around the actual pages, and should only
 * contain code that should be seen on all pages. (e.g. navigation bar)
 */

import React from 'react'
import { Helmet } from 'react-helmet'
import { Switch, Route } from 'react-router-dom'

import HomeContainer from '../containers/HomeContainer'
import NavBarContainer from '../containers/NavBarContainer'
import SignUpFormContainer from '../containers/SignUpFormContainer'
import SignInFormContainer from '../containers/SignInFormContainer'
import LobbyContainer from '../containers/LobbyContainer'
import GameContainer from '../containers/GameContainer'
import ProfileContainer from '../containers/ProfileContainer'

import Footer from './Footer'
import NotFoundPage from './NotFoundPage'
import Signout from './Signout'

const App = ({ username }) => (
  <div className="app-wrapper">
    <Helmet
      titleTemplate="%s Ten Poker"
      defaultTitle="Ten Poker"
    >
      <meta name="description" content="An open source poker app." />
    </Helmet>
    <NavBarContainer />
    <Switch>
      <Route exact path="/" component={HomeContainer} />
      <Route path="/signup" component={SignUpFormContainer} />
      <Route path="/signin" component={SignInFormContainer} />
      <Route path="/signout" component={Signout} />
      <Route path="/lobby" component={LobbyContainer} />
      <Route path="/profile" component={ProfileContainer} />
      <Route
        path="/game/:tableName"
        render={props => <GameContainer {...props} username={username} />}
      />
      <Route path="" component={NotFoundPage} />
    </Switch>
  </div>
)

export default App


================================================
FILE: client/app/components/Board.js
================================================
import React from 'react';

import Card from './Card';

const Board = ({ cards }) => (
  <div className="board-cards">
    <div className='board-cards-container'>
      {cards.map(card => {
        const rank = card.get('rank')
        const suit = card.get('suit')

        return (<Card
          key={rank + suit}
          rank={rank}
          suit={suit}
        />)
      })}
    </div>
  </div>);

export default Board;

================================================
FILE: client/app/components/Card.js
================================================
import React from 'react';

import clubs from '../../static/Clubs.svg'
import hearts from '../../static/Hearts.svg'
import spades from '../../static/Spades.svg'
import diamonds from '../../static/Diamonds.svg'

const showRank = rank => {
  switch (rank) {
    case 'Ace':
      return 'A'
    case 'King':
      return 'K'
    case 'Queen':
      return 'Q'
    case 'Jack':
      return 'J'
    case 'Ten':
      return '10'
    case 'Nine':
      return '9'
    case 'Eight':
      return '8'
    case 'Seven':
      return '7'
    case 'Six':
      return '6'
    case 'Five':
      return '5'
    case 'Four':
      return '4'
    case 'Three':
      return '3'
    case 'Two':
      return '2'
  }
}

const suitSVG = suit => {
  switch (suit) {
    case 'Spades':
      return spades
    case 'Diamonds':
      return diamonds
    case 'Hearts':
      return hearts
    case 'Clubs':
      return clubs
  }
}

const Card = ({ rank, suit }) => (
  <div className='card'>
    <div className="rank">
      <span className="monospace-font-bold">{showRank(rank)}</span>
    </div>
    <div className="suit">
      <img alt={suit} src={suitSVG(suit)} />
    </div>
  </div>);

export default Card;


================================================
FILE: client/app/components/Footer.js
================================================
import React from 'react';


const Footer = () => (
  <div className='footer'> Footer</div>
);

export default Footer;


================================================
FILE: client/app/components/Game.js
================================================
import React from 'react'

import ActionPanel from './ActionPanel'
import Board from './Board'
import Seat from './Seat'
import Card from './Card'

import { fromJS, toJS, List } from 'immutable'

let isEveryoneAllIn = players => {
  let activesCount = players.filter(p =>
    p.get("_playerState") == "In").size
  let allInCount = players.filter(p =>
    (p.get("_playerState") == "In") && (p.get("_chips") === 0)).size

  console.log('actives count', activesCount)
  console.log('all in count', allInCount)
  if (activesCount < 2) {
    return false;
  }
  else {
    let notAllInCount = activesCount - allInCount
    return notAllInCount <= 1
  }
}



const getSeatedPlayer = (
  username,
  player,
  gameStage,
  position,
  isTurnToAct,
  isEveryoneAllIn,
  activePlayerCount,

) => (
    <Seat
      key={position}
      position={position}
      isEveryoneAllIn={isEveryoneAllIn}
      playerName={player.get('_playerName')}
      chips={player.get('_chips')}
      hasPocketCards={
        player.get('_playerName') !== username &&
        player.get('_playerState') === 'In' &&
        gameStage !== 'PreDeal' &&
        gameStage !== 'Showdown'
      }
      playerState={player.get('_playerState')}
      activePlayerCount={activePlayerCount}
      isTurnToAct={isTurnToAct && (player.get('_actedThisTurn') === false) && gameStage !== 'Showdown'}
    />
  )

const getSeats = (username, maxPlayers, players, gameStage, currentPosToAct, isEveryoneAllIn, activePlayerCount) =>
  Array(maxPlayers)
    .fill(null)
    .map((_, i) => {
      const player = players.get(i)
      const isTurnToAct = i === currentPosToAct

      return player ? (
        getSeatedPlayer(username, player, gameStage, i, isTurnToAct, isEveryoneAllIn, activePlayerCount)
      ) : (
          <Seat
            key={i}
            position={i} />
        )
    })

const getPocketCards = players =>
  players.map((p, i) => {
    if (p.get('_pockets') === null) {
      return ''
    }

    return p.get('_pockets').length !== 0 ? (
      <div className={`showdown-pocket-cards-${i}`} key={p.get('_playerName')}>
        <div className="showdown-pocket-cards-container">
          {p.get('_pockets').map(card => {
            const rank = card.get('rank')
            const suit = card.get('suit')

            return <Card key={rank + suit} rank={rank} suit={suit} />
          })}
        </div>
      </div>
    ) : (
        ''
      )
  })

const getPlayerBets = players =>
  players.map(
    (p, i) =>
      p.get('_bet') > 0 ? (
        <div className={`player-bet-container-pos-${i}`}>
          <div className={`player-bet-pos-${i}`}>
            <div className="player-bet-chip" />
            <div className="player-bet-label">
              <h3><span className="monospaced-font-bold">{`$${p.get('_bet')}`}</span></h3>
            </div>
          </div>
        </div>
      ) : (
          ''
        )
  )

const parseAvailableActions = actions => {
  console.log(actions)


  if (List.size === 0) {
    return actions
  } else {
    const actionsJS = actions.toJS()
    return actionsJS.map(a => {
      console.log(a)


      if (a.tag === "PostBlind") {
        if (a.contents === "Big") {
          return "PostBigBlind"
        } else {
          return "PostSmallBlind"
        }
      } else {
        return a.tag
      }
    })
  }
}

const Game = props => {
  const { game, username, isTurnToAct } = props




  if (game) {
    const jsgame = game.toJS()
    console.log(jsgame)
    console.log('everyone all in ', isEveryoneAllIn(game.get("_players")))
    const everyoneAllIn = isEveryoneAllIn(game.get("_players"))
    const players = game.get('_players')
    const dealerPos = game.get('_dealer')
    const maxPlayers = 6
    const gameStage = game.get('_street')
    const potSize = game.get('_pot')

    let activePlayerCount = players.filter(p =>
      p.get("_playerState") == "In").size

    const userPlayer = game
      .get('_players')
      .find(p => p.get('_playerName') === username)


    const userPocketCards = userPlayer ? userPlayer.get('_pockets') : null
    const userAvailableActions = userPlayer ? userPlayer.get('_possibleActions') : fromJS([])
    console.log(((parseAvailableActions(userAvailableActions))).toJS)

    const currentPosToAct = game.get('_currentPosToAct')
    const isMultiplayerShowdown =
      game.get('_winners').get('tag') == 'MultiPlayerShowdown'
    const showdownPots = game.get('_winners').get('contents')
    const mainShowdownPot = showdownPots
      ? showdownPots.get
        ? showdownPots.get(0)
        : null
      : null
    const mainShowdownPotHandRanking = mainShowdownPot
      ? mainShowdownPot.get(0).get(0)
      : null
    const mainShowdownPotHandCards = mainShowdownPot
      ? mainShowdownPot.get(0).get(1)
      : null
    const mainShowdownPotHandPlayers = mainShowdownPot
      ? mainShowdownPot.get(1)
      : null
    const playerNamesWinnersOfMainShowdownPot = mainShowdownPot
      ? mainShowdownPot.get(1)
      : null


    return (
      <div className="game-view-grid">
        <div className="game-container">
          <div className="table-container">
            {getPocketCards(players)}
            {getSeats(
              username,
              maxPlayers,
              players,
              gameStage,
              currentPosToAct,
              everyoneAllIn,
              activePlayerCount,
              gameStage
            )}
            <div className="game-grid">
              {players ? (
                players.count() > 1 ? (
                  <div className={`dealer-btn-pos-${dealerPos}`}>D</div>
                ) : (
                    ''
                  )
              ) : (
                  ''
                )}
              <Board cards={game.get('_board')} />
              {getPlayerBets(players)}
              <h3 className="pot-label">
                <span className="monospaced-font-bold">{`$${potSize}`}</span>
              </h3>
              {mainShowdownPot ? (
                <h3 className="winners-label">
                  {`${mainShowdownPotHandPlayers} wins with ${mainShowdownPotHandRanking}`}
                </h3>
              ) : (
                  ''
                )}
            </div>
            <div className="game-table" />
          </div>
        </div>
        <ActionPanel
          {...props}

          gameStage={gameStage}
          userPocketCards={userPocketCards}
          availableActions={parseAvailableActions(userAvailableActions)}
          userPlayer={userPlayer}
          maxCurrBet={game.get("_maxBet")}
          bigBlind={game.get("_bigBlind")}
        />
      </div>
    )
  }
  return <h2>Loading Game...</h2>
}

export default Game


================================================
FILE: client/app/components/Home.js
================================================
import React from 'react';

const Home = () => (
  <div> Home
  </div>
);

export default Home;


================================================
FILE: client/app/components/Lobby.js
================================================
import React from 'react';

const Lobby = ({ lobby, history, subscribeToATable }) =>
  < table className="table game-table-list" >
    <thead>
      <tr>
        <th><h4>Name</h4></th>
        <th><h4>Players</h4></th>
        <th><h4>Waitlist</h4></th>
        <th><h4>Min Buy In</h4></th>
        <th><h4>Max Buy In</h4></th>
        <th><h4>Big Blind</h4></th>
        <th></th>
      </tr>
    </thead>
    <tbody >
      {lobby.map((table) => {
        const tableName = table.get('_tableName')

        return <tr
          key={tableName}
        >
          <td>{tableName}</td>
          <td>{`${table.get('_playerCount')} / ${table.get('_maxPlayers')}`}</td>
          <td>{table.get('_waitlistCount')}</td>
          <td>{table.get('_minBuyInChips')}</td>
          <td>{table.get('_maxBuyInChips')}</td>
          <td>{table.get('_bigBlind')}</td>
          <td><button className="button" style={{ fontSize: "0.8em", paddingBottom: '0.2em', paddingTop: '0.2em', width: "5.7em", height: "3.8em" }} onClick={() => {
            subscribeToATable(tableName)
            history.push(`/game/${tableName}`)
          }}>Join</button></td>
        </tr>
      })}
    </tbody >
  </table >

export default Lobby;


================================================
FILE: client/app/components/NavBar.js
================================================
import React from 'react'

const NavBar = ({
  isAuthenticated,
  currRoute,
  username,
  history,
  logoutUser
}) => (
    <nav role="navigation" className="navbar">
      <div className="navbar-brand">
        <div>
          <a onClick={() => history.push('/')}>
            <h4 className="brand-title">Ten Poker</h4>
          </a>
        </div>
      </div>
      <div className="navbar-menu">
        <div className="navbar-start">
          {isAuthenticated ? (
            <React.Fragment>
              <div
                onClick={() => history.push('/lobby')}
                className={`navbar-item${
                  currRoute === '/lobby' ? '-active' : ''
                  }`}
              >
                <a >
                  <h4>Lobby</h4>
                </a>
              </div>

            </React.Fragment>
          ) : (
              ''
            )}
        </div>
        <div className="navbar-end">
          {isAuthenticated ? (
            <div
              className={`navbar-item${
                currRoute === '/profile' ? '-active' : ''
                }`}
            >
              {' '}
              <a onClick={() => history.push('/profile')}>
                <h4>
                  <span className="navbar-username">{username}</span>
                </h4>
              </a>
            </div>
          ) : (
              ''
            )}
          {isAuthenticated ? (
            <div className="navbar-item">
              <a onClick={() => logoutUser()}>
                <h4>Logout</h4>
              </a>
            </div>
          ) : (
              ''
            )}
          {!isAuthenticated ? (
            <div className="navbar-item">
              <a onClick={() => history.push('/signin')}>
                <h4>Login</h4>
              </a>
            </div>
          ) : (
              ''
            )}
          {!isAuthenticated ? (
            <div className="navbar-item">
              <a onClick={() => history.push('/signup')}>
                <h4>Register</h4>
              </a>
            </div>
          ) : (
              ''
            )}
        </div>
      </div>
    </nav>
  )

export default NavBar


================================================
FILE: client/app/components/NotFoundPage.js
================================================
import React from 'react';

const NotFoundPage = () => (
  <div> NotFoundPage
  </div>
);

export default NotFoundPage;


================================================
FILE: client/app/components/Profile.js
================================================
import React from 'react'

const Profile = username => <div className="profile">profile</div>

export default Profile


================================================
FILE: client/app/components/Seat.js
================================================
import React from 'react';

let isPlayerInactive = playerState =>
  playerState === 'Folded' ||
  playerState === 'SatOut'


const Seat = ({ activePlayerCount, gameStage, isEveryoneAllIn, playerName, chips, isTurnToAct, hasPocketCards, position, playerState }) => {

  console.log('player state', playerState)
  console.log('has pockets', hasPocketCards)
  console.log('is everyone all in ', isEveryoneAllIn)
  console.log(' hasPocketCards && playerState !== "Folded" && !isEveryoneAllIn', hasPocketCards && playerState !== "Folded" && !isEveryoneAllIn)

  return (
    <div className={`seat-${position}-container`}>
      {hasPocketCards && playerState == "In" && !isEveryoneAllIn && (gameStage !== 'Showdown') && (activePlayerCount > 1) ?
        <div className='hidden-pocket-cards' >
          <div className='hidden-pocket-cards-container' >
            <div className='card pocket-one' />
            <div className='card pocket-two' />
          </div>
        </div> : ''}
      <div
        className={`seat-${position}
        ${isTurnToAct ? 'active-player' : ''} 
        ${playerName ? '' : 'empty-seat'}
        ${isPlayerInactive(playerState) ? 'disabled' : ''}`
        }>
        <h4 className={`${playerName ? 'player-name' : ''}`}>{playerName || ''}</h4>
        <h4 className={playerState ? 'player-state' : ''}>
          {playerState == 'In' && chips == 0 ? 'All In' : ''}
          {playerState == 'Folded' ? 'Folded' : ''}
          {playerState == 'SatOut' ? 'Sat Out' : ''}</h4>
        {playerName ?
          <h4 className='player-chip-count'>
            <span className='monospaced-font-bold'>
              {playerState == 'In' && chips == 0 ? '' : `$${chips}`}</span></h4> : ''}
      </div>
    </div>)

}

export default Seat;

================================================
FILE: client/app/components/SignInForm.js
================================================
import React from 'react';

const SignInForm = ({ handleChange, handleSubmit }) => (
  <div className="form-container">
    <div className="form" >
      <div className="form-container">

        <h2> Log In</h2>

        <form onSubmit={handleSubmit}>
          <div className="field">
            <p className="control has-icons-left has-icons-right">
              <input className="input" type="text" placeholder="Username" name="username" onChange={e => handleChange(e)} />
              <span className="icon is-small is-left">
                <i className="fas fa-envelope"></i>
              </span>
              <span className="icon is-small is-right">
                <i className="fas fa-check"></i>
              </span>
            </p>
          </div>
          <div className="field">
            <p className="control has-icons-left">
              <input className="input" type="password" placeholder="Password" name="password" onChange={e => handleChange(e)} />
              <span className="icon is-small is-left">
                <i className="fas fa-lock"></i>
              </span>
            </p>
          </div>
          <div className="field">
            <p className="control">
              <button className="button is-success">
                Login
        </button>
            </p>
          </div>
        </form>
      </div>
    </div>
  </div>
);

export default SignInForm;


================================================
FILE: client/app/components/SignUpForm.js
================================================
import React from 'react'

const SignUpForm = ({ handleChange, handleSubmit }) => (
  <div className="form-container">
    <div className="form">
      <h2> Sign Up</h2>

      <form onSubmit={handleSubmit}>
        <div className="field">
          <p className="control has-icons-left has-icons-right">
            <input
              className="input"
              type="email"
              placeholder="Email"
              name="email"
              onChange={e => handleChange(e)}
            />
            <span className="icon is-small is-left">
              <i className="fas fa-envelope" />
            </span>
            <span className="icon is-small is-right">
              <i className="fas fa-check" />
            </span>
          </p>
        </div>
        <div className="field">
          <p className="control has-icons-left">
            <input
              className="input"
              type="text"
              placeholder="Username"
              name="username"
              onChange={e => handleChange(e)}
            />
            <span className="icon is-small is-left">
              <i className="fas fa-lock" />
            </span>
          </p>
        </div>
        <div className="field">
          <p className="control has-icons-left">
            <input
              className="input"
              type="password"
              placeholder="Password"
              name="password"
              onChange={e => handleChange(e)}
            />
            <span className="icon is-small is-left">
              <i className="fas fa-lock" />
            </span>
          </p>
        </div>
        <div className="field">
          <p className="control has-icons-left">
            <input
              className="input"
              type="password"
              placeholder="Repeat Password"
              name="repeatPassword"
              onChange={e => handleChange(e)}
            />
            <span className="icon is-small is-left">
              <i className="fas fa-lock" />
            </span>
          </p>
        </div>
        <div className="field">
          <p className="control">
            <button className="button is-success">Register</button>
          </p>
        </div>
      </form>
    </div>
  </div>
)

export default SignUpForm


================================================
FILE: client/app/components/Signout.js
================================================
import React from 'react';

const Signout = () => (
  <div> Signout </div>
);

export default Signout;


================================================
FILE: client/app/configureStore.js
================================================
/**
 * Create the store with dynamic reducers
 */

import { createStore, applyMiddleware, compose } from 'redux'
import { fromJS } from 'immutable'
import { routerMiddleware } from 'react-router-redux'
import reduxThunk from 'redux-thunk'

import createReducer from './reducers'
import socketMiddleware from "./middleware/socket";

export default function configureStore(initialState = {}, history) {
  // Create the store with two middlewares
  // 1. sagaMiddleware: Makes redux-sagas work
  // 2. routerMiddleware: Syncs the location/URL path to the state
  const middlewares = [reduxThunk, socketMiddleware, routerMiddleware(history)]

  const enhancers = [applyMiddleware(...middlewares)]

  // If Redux DevTools Extension is installed use it, otherwise use Redux compose
  /* eslint-disable no-underscore-dangle */
  const composeEnhancers =
    process.env.NODE_ENV !== 'production' &&
      typeof window === 'object' &&
      window.__REDUX_DEVTOOLS_EXTENSION_COMPOSE__
      ? window.__REDUX_DEVTOOLS_EXTENSION_COMPOSE__({
        // TODO Try to remove when `react-router-redux` is out of beta, LOCATION_CHANGE should not be fired more than once after hot reloading
        // Prevent recomputing reducers for `replaceReducer`
        shouldHotReload: false
      })
      : compose
  /* eslint-enable */

  const store = createStore(
    createReducer(),
    fromJS(initialState),
    composeEnhancers(...enhancers)
  )

  // Extensions
  store.injectedReducers = {} // Reducer registry

  // Make reducers hot reloadable, see http://mxs.is/googmo
  /* istanbul ignore next */
  if (module.hot) {
    module.hot.accept('./reducers', () => {
      store.replaceReducer(createReducer(store.injectedReducers))
      store.dispatch({ type: '@@REDUCER_INJECTED' })
    })
  }

  return store
}


================================================
FILE: client/app/containers/AppContainer.js
================================================
import React, { Component } from 'react'
import { connect } from 'react-redux'
import { withRouter } from 'react-router'

import { isAuthenticated, getUsername } from '../selectors/auth'
import { isSocketAuthenticated } from '../selectors/socket'

import { connectSocket } from '../actions/auth'

import App from '../components/App'

class AppContainer extends Component {
  componentDidMount() {
    /* If we have a token and socket not connected then try and connect */
    const { connectSocket, isSocketAuthenticated } = this.props
    const token = localStorage.getItem('token')
    if (token && !isSocketAuthenticated) {
      try {
        const { access_token } = JSON.parse(token)
        connectSocket(access_token)
      } catch (e) {
        console.log(e)
      }
    }
  }

  render() {
    const { username } = this.props

    return <App username={username} />
  }
}

const mapStateToProps = state => ({
  isAuthenticated: isAuthenticated(state),
  isSocketAuthenticated: isSocketAuthenticated(state),
  username: getUsername(state)
})

const mapDispatchToProps = dispatch => ({
  connectSocket: (url, token) => dispatch(connectSocket(url, token))
})

export default withRouter(
  connect(
    mapStateToProps,
    mapDispatchToProps
  )(AppContainer)
)


================================================
FILE: client/app/containers/GameContainer.js
================================================
import React from 'react'
import { connect } from "react-redux";

import Game from '../components/Game'
import { getGame, getPlayerPosition, isTurnToAct } from '../selectors/games'
import { call, bet, fold, raise, check, postBigBlind, postSmallBlind, sitIn, leaveSeat } from '../actions/games'
import { takeSeat } from '../actions/lobby'

class GameContainer extends React.Component {
  constructor(props) {
    super(props)

    this.state = {
      betValue: 0
    }
  }
  handleChange = event => {
    this.setState({ betValue: event.target.value });
  }

  render() {
    return (<Game updateBetValue={this.handleChange} betValue={this.state.betValue} {...this.props} />)
  }
}

const mapStateToProps = (state, { username, match: { params: { tableName } } }) => ({
  game: getGame(tableName)(state),
  isTurnToAct: isTurnToAct(username, tableName)(state),
  playerPosition: getPlayerPosition(tableName)(state)
});

const mapDispatchToProps = (dispatch, { match: { params: { tableName } } }) => ({
  bet: amount => dispatch(bet(tableName, amount)),
  raise: amount => dispatch(raise(tableName, amount)),
  call: () => dispatch(call(tableName)),
  fold: () => dispatch(fold(tableName)),
  check: () => dispatch(check(tableName)),
  postSmallBlind: () => dispatch(postSmallBlind(tableName)),
  postBigBlind: () => dispatch(postBigBlind(tableName)),
  sitDown: chips => dispatch(takeSeat(tableName, chips)),
  sitIn: () => dispatch(sitIn(tableName)),
  leaveGameSeat: () => dispatch(leaveSeat(tableName))
});


export default connect(mapStateToProps, mapDispatchToProps)(GameContainer)


================================================
FILE: client/app/containers/HomeContainer.js
================================================
import Home from '../components/Home'

export default Home

================================================
FILE: client/app/containers/LobbyContainer.js
================================================
import React from 'react'
import { connect } from "react-redux";
import { withRouter } from 'react-router-dom'

import { getLobby, subscribeToTable } from '../actions/lobby'
import { getLobbyState } from '../selectors/lobby'
import Lobby from '../components/Lobby'

class LobbyContainer extends React.Component {
  componentDidMount() {
    this.props.getLobby()
  }

  render() {
    const { lobby } = this.props
    return (<Lobby {...this.props} />)
  }
}

const mapStateToProps = state => ({
  lobby: getLobbyState(state)
});

const mapDispatchToProps = (dispatch) => ({
  getLobby: () => dispatch(getLobby()),
  subscribeToATable: tableName => dispatch(subscribeToTable(tableName))
});

export default withRouter(connect(mapStateToProps, mapDispatchToProps)(LobbyContainer));


================================================
FILE: client/app/containers/NavBarContainer.js
================================================
import { withRouter } from 'react-router-dom'
import { connect } from 'react-redux'

import { logoutUser } from '../actions/auth'
import { isAuthenticated, getUsername } from '../selectors/auth'
import { getPathname } from '../selectors/route'

import NavBar from '../components/NavBar'

const mapStateToProps = state => ({
  isAuthenticated: isAuthenticated(state),
  username: getUsername(state),
  currRoute: getPathname(state)
})

const mapDispatchToProps = (dispatch, { history }) => ({
  logoutUser: () => dispatch(logoutUser(history))
})

export default withRouter(
  connect(
    mapStateToProps,
    mapDispatchToProps
  )(NavBar)
)


================================================
FILE: client/app/containers/ProfileContainer.js
================================================
import React from 'react'
import { connect } from 'react-redux'

import { getUsername } from '../selectors/auth'
import { getProfileSelector } from '../selectors/profile'

import { getProfile } from '../actions/profile'
import Profile from '../components/Profile'

class ProfileContainer extends React.Component {
  componentDidMount() {
    this.props.getProfile()
  }

  render() {
    return <Profile {...this.props} />
  }
}

const mapStateToProps = state => ({
  username: getUsername(state),
  profile: getProfileSelector(state)
})

const mapDispatchToProps = (dispatch, { username }) => ({
  getProfile: () => dispatch(getProfile(username))
})

export default connect(
  mapStateToProps,
  mapDispatchToProps
)(ProfileContainer)


================================================
FILE: client/app/containers/SignInFormContainer.js
================================================
import React from 'react'
import { connect } from 'react-redux'
import { withRouter } from 'react-router'

import { login } from '../actions/auth'
import SignInForm from '../components/SignInForm'

class SignInFormContainer extends React.Component {
  constructor(props) {
    super(props)

    this.state = {
      username: '',
      password: ''
    }
  }

  handleChange = event =>
    this.setState({
      [event.target.name]: event.target.value
    })

  handleSubmit = event => {
    const { username, password } = this.state
    this.props.login(
      username,
      password
    )
    event.preventDefault()
  }

  validateForm = () => {
    return this.state.username.length > 0 && this.state.password.length > 0
  }

  render() {
    return (
      <SignInForm
        handleChange={this.handleChange}
        handleSubmit={this.handleSubmit}
      />
    )
  }
}

const mapDispatchToProps = (dispatch, { history }) => ({
  login: (username, password) => dispatch(login(username, password, history))
})

export default connect(
  undefined,
  mapDispatchToProps
)(withRouter(SignInFormContainer))


================================================
FILE: client/app/containers/SignUpFormContainer.js
================================================
import React from 'react'
import { connect } from 'react-redux'
import { withRouter } from 'react-router'

import { register } from '../actions/auth'
import SignUpForm from '../components/SignUpForm'

class SignUpFormContainer extends React.Component {
  constructor(props) {
    super(props)

    this.state = {
      email: '',
      username: '',
      password: '',
      repeatPassword: ''
    }
  }

  handleChange = event =>
    this.setState({
      [event.target.name]: event.target.value
    })

  handleSubmit = event => {
    const { username, email, password } = this.state
    this.props.register(
      username,
      email,
      password
    )
    event.preventDefault()
  }

  validateForm = () => {
    return this.state.email.length > 0 && this.state.password.length > 0
  }

  render() {
    return (
      <SignUpForm
        handleChange={this.handleChange}
        handleSubmit={this.handleSubmit}
      />
    )
  }
}

const mapDispatchToProps = (dispatch, { history }) => ({
  register: (username, email, password) => dispatch(register(username, email, password, history))
})

export default connect(
  undefined,
  mapDispatchToProps
)(withRouter(SignUpFormContainer))


================================================
FILE: client/app/index.html
================================================
<!doctype html>
<html lang="en">

<head>
  <!-- The first thing in any HTML file should be the charset -->
  <meta charset="utf-8">

  <!-- Make the page mobile compatible -->
  <meta name="viewport" content="width=device-width, initial-scale=1">

  <title>Poker</title>
</head>

<body>
  <!-- Display a message if JS has been disabled on the browser. -->
  <noscript>If you're seeing this message, that means
    <strong>JavaScript has been disabled on your browser</strong>, please
    <strong>enable JS</strong> to make this app work.</noscript>

  <!-- The app hooks into this div -->
  <div id="app"></div>
  <!-- Open Sans Font -->
  <!-- A lot of magic happens in this file. HtmlWebpackPlugin automatically includes all assets (e.g. bundle.js, main.css) with the correct HTML tags, which is why they are missing in this HTML file. Don't add any assets here! (Check out the webpack config files in config/webpack for details) -->
</body>

</html>

================================================
FILE: client/app/middleware/socket.js
================================================
import { fromJS } from 'immutable'

import { disconnectSocket } from '../actions/auth'
import {
  socketConnErr,
  socketConnected,
  socketAuthErr,
  socketAuthSuccess
} from '../actions/socket'
import { newLobby, getLobby } from '../actions/lobby'
import { newGameState } from '../actions/games'

import * as types from '../actions/types'

//const SOCKET_API_URL = 'ws://localhost:5000'
// 'wss://tengame.co.uk'

const SOCKET_API_URL =
  process.env.NODE_ENV === 'docker'
    ? 'ws://192.168.99.100:5000'
    : process.env.NODE_ENV === 'production'
    ? 'wss://tengame.co.uk'
    : 'ws://localhost:5000'

import ReconnectingWebSocket from 'reconnecting-websocket'

//process.env.NODE_ENV === 'production' ? 'wss://tengame.co.uk' : 'ws://localhost:5000'

function addHandlers(socket, authToken, dispatch) {
  socket.onopen = event => {
    // connected to server but not authenticated
    dispatch(socketConnected(socket)) // pass ref to socket so dispatcher - socket middleware has access to new connected socket instance
    socket.send(authToken)
  }

  socket.onclose = event => {
    dispatch(disconnectSocket())
    // try and reconnect nearly instantly which is
    // useful when the client has refreshed their web browser
    setTimeout(() => {
      if (socket.connect) {
        socket.connect()
      } else {
      }
    }, 750)
  }

  socket.onmessage = msg => {
    console.log(msg)

    const parsedMsg = JSON.parse(JSON.parse(msg.data))
    if (parsedMsg.tag === 'AuthSuccess') {
      dispatch(socketAuthSuccess())
    }
    if (parsedMsg.tag === 'TableList') {
      const tableList = parsedMsg.contents
      dispatch(newLobby(fromJS(tableList)))
    }
    if (
      parsedMsg.tag === 'SuccessfullySatDown' ||
      parsedMsg.tag === 'NewGameState' ||
      parsedMsg.tag === 'SuccessfullySubscribedToTable'
    ) {
      const tableName = parsedMsg.contents[0]
      const gameState = parsedMsg.contents[1]
      dispatch(newGameState(tableName, fromJS(gameState)))
    }
  }

  socket.onerror = err => {
    console.log(err)
    dispatch(socketAuthErr(err))
    console.log(err)
  }
}

let connectedSocket = null

function connHandler(dispatch, action) {
  if (action.type === types.CONNECT_SOCKET) {
    const { token } = action
    connectedSocket = new ReconnectingWebSocket(SOCKET_API_URL)
    // new WebSocket(SOCKET_API_URL)

    addHandlers(connectedSocket, token, dispatch)
  }

  if (action.type === types.DISCONNECT_SOCKET && connectedSocket) {
    if (connectedSocket.readyState === 1) {
      connectedSocket.close()
    }
  }

  if (action.data && connectedSocket) {
    //if (connectedSocket.readyState === 1)
    // connectedSocket.send(action.payload)
  }
}

/**
 * Allows you to register actions that when dispatched, send the action to the
 * server via a socket.
 * `criteria` may be a function (type, action) that returns true if you wish to send the
 *  action to the server, array of action types, or a string prefix.
 * the third parameter is an options object with the following properties:
 * {
 *   eventName,// a string name to use to send and receive actions from the server.
 *   execute, // a function (action, emit, next, dispatch) that is responsible for
 *            // sending the message to the server.
 * }
 */
const reduxSocketMiddleware = ({ dispatch, getState }) => next => action => {
  connHandler(dispatch, action)
  console.log(action)

  const criteria = 'server/'

  if (connectedSocket) {
    if (evaluate(action, criteria)) {
      return defaultExecute(dispatch, next, action)
    }
  }
  return next(action)
}

function evaluate(action, option) {
  if (!action || !action.type) {
    return false
  }

  const { type } = action
  let matched = false
  if (typeof option === 'function') {
    // Test function
    matched = option(type, action)
  } else if (typeof option === 'string') {
    // String prefix
    matched = type.indexOf(option) === 0
  } else if (Array.isArray(option)) {
    // Array of types
    matched = option.some(item => type.indexOf(item) === 0)
  }
  return matched
}

function defaultExecute(dispatch, next, action) {
  if (connectedSocket) {
    if (connectedSocket.readyState === 1)
      connectedSocket.send(JSON.stringify(action.data))
  }
}

export default reduxSocketMiddleware


================================================
FILE: client/app/reducers/auth.js
================================================
import Immutable from 'immutable';

import * as types from '../actions/types';

const initialState = Immutable.Map({ authenticated: false, username: null, error: null, isLoading: false });

export default function (state = initialState, action) {
  switch (action.type) {
    case types.AUTH_REQUESTED:
      return state.set('isLoading', true);
    case types.AUTHENTICATED:
      return state.set('authenticated', true).set('username', action.username).set('isLoading', false).set('error', null);
    case types.UNAUTHENTICATED:
      return state.set('authenticated', false).set('username', null).set('isLoading', false).set('error', null);
    case types.AUTHENTICATION_ERROR:
      return state.set('error', action.error).set('isLoading', false)
    default:
      return state
  }
}

================================================
FILE: client/app/reducers/games.js
================================================
import Immutable from 'immutable';

import * as types from '../actions/types';

const initialState = Immutable.Map({});

export default function (state = initialState, action) {
  switch (action.type) {
    case types.NEW_GAME_STATE:
      return state.set(action.tableName, action.gameState);
    default:
      return state
  }
}

================================================
FILE: client/app/reducers/lobby.js
================================================
import Immutable, { fromJS } from 'immutable';

import * as types from '../actions/types';

const initialState = Immutable.fromJS([]);

export default function (state = initialState, action) {
  switch (action.type) {
    case types.NEW_LOBBY:
      return fromJS(action.lobby)
    default:
      return state
  }
}

================================================
FILE: client/app/reducers/profile.js
================================================
import Immutable from 'immutable'

import * as types from '../actions/types'

const initialState = Immutable.Map({
  profile: null,
  isLoading: false,
  error: null
})

export default function(state = initialState, action) {
  switch (action.type) {
    case types.GET_PROFILE_REQUEST:
      return state.set('isLoading', true)
    case types.GET_PROFILE_SUCCESS:
      return state
        .set('profile', action.profile)
        .set('isLoading', false)
        .set('error', null)
    case types.GET_PROFILE_ERR:
      return state.set('error', action.error).set('isLoading', false)
    default:
      return state
  }
}


================================================
FILE: client/app/reducers/rootReducer.js
================================================
import { combineReducers } from 'redux-immutable'

import auth from './auth'
import socket from './socket'
import lobby from './lobby'
import games from './games'
import profile from './profile'

const rootReducer = combineReducers({
  auth,
  socket,
  lobby,
  profile,
  games
})

export default rootReducer


================================================
FILE: client/app/reducers/socket.js
================================================

import Immutable, { fromJS } from 'immutable';

import {
  SOCKET_AUTH_SUCCESS,
  SOCKET_AUTH_ERR,
  SOCKET_CONN_ERR,
  SOCKET_CONNECTED,
  DISCONNECT_SOCKET
} from '../actions/types'

const initialState = fromJS({
  socketAuth: false,
  socketAuthErr: null,
  socketConnErr: null,
  socketConnected: false
})

export default function socket(state = initialState, action) {
  switch (action.type) {
    case SOCKET_CONNECTED:
      return state.set('socketConnected', true).set('socketConnErr', null).set('socketAuthErr', null)
    case DISCONNECT_SOCKET:
      return state.set('socketConnected', false).set('socketConnErr', null).set('socketAuthErr', null)
    case SOCKET_AUTH_SUCCESS:
      return state.set('socketAuth', true)
    case SOCKET_AUTH_ERR:
      return state.set('socketAuthError', action.err)
    case SOCKET_CONN_ERR:
      return state.set('socketConnError', action.err)
    default:
      return state
  }
}

================================================
FILE: client/app/reducers/tests/auth.test.js
================================================
/* eslint-disable */
import { Map } from "immutable";

import reducer from "../auth";
import * as types from "../../actions/types";

const initialState = Map({
  authenticated: false,
  username: null,
  error: null,
  isLoading: false
});

describe("auth reducer", () => {
  it("should return the initial state", () => {
    expect(reducer(undefined, {})).toEqual(initialState);
  });

  it("should handle authentication success", () => {
    const username = 'Argo'
    const expectedState = Map({
      authenticated: true,
      username,
      error: null,
      isLoading: false
    });

    expect(
      reducer(initialState,
        { type: types.AUTHENTICATED, username }
      ))
      .toEqual(expectedState)
  });


  it("should handle authentication errors", () => {
    const error = '404'
    const expectedState = Map({
      authenticated: false,
      username: null,
      error,
      isLoading: false
    });

    expect(reducer(
      initialState, { type: types.AUTHENTICATION_ERROR, error }
    )).toEqual(expectedState)
  });

  it("should handle logout", () => {
    const initialState = Map({
      authenticated: true,
      username: 'Argo',
      error: null,
      isLoading: false
    });
    const expectedState = Map({
      authenticated: false,
      username: null,
      error: null,
      isLoading: false
    });

    expect(reducer(initialState, { type: types.UNAUTHENTICATED })).toEqual(expectedState)
  });
});

================================================
FILE: client/app/reducers.js
================================================
/**
 * Combine all reducers in this file and export the combined reducers.
 */

import { fromJS } from 'immutable'
import { combineReducers } from 'redux-immutable'
import { LOCATION_CHANGE } from 'react-router-redux'

import rootReducer from 'reducers/rootReducer'

/*
 * routeReducer
 *
 * The reducer merges route location changes into our immutable state.
 * The change is necessitated by moving to react-router-redux@5
 *
 */

// Initial routing state
const routeInitialState = fromJS({
  location: null
})

/**
 * Merge route into the global application state
 */
function routeReducer(state = routeInitialState, action) {
  switch (action.type) {
    /* istanbul ignore next */
    case LOCATION_CHANGE:
      return state.merge({
        location: action.payload
      })
    default:
      return state
  }
}

/**
 * Creates the main reducer with the dynamically injected ones
 */
export default function createReducer(injectedReducers) {
  return combineReducers({
    route: routeReducer,
    global: rootReducer,
    ...injectedReducers
  })
}


================================================
FILE: client/app/selectors/auth.js
================================================
import Immutable from 'immutable'
import { createSelector } from 'reselect'

export const auth = state => state.get('global').get('auth')

export const isAuthenticated = createSelector(auth, state =>
  state.get('authenticated')
)

export const getUsername = createSelector(auth, state => state.get('username'))


================================================
FILE: client/app/selectors/games.js
================================================
import { createSelector } from 'reselect'

export const getGames = state => state.get('global').get('games')

export const getGame = tableName =>
  createSelector(getGames, games => games.get(tableName))

export const getCurrentPlayerToAct = tableName => (
  getGame(tableName),
  game => {
    if (!game) {
      return null
    }

    const currentPosToAct = game.get('_currentPosToAct')

    if (Number.isInteger(currentPosToAct)) {
      const player = game.get('_players').get(currentPosToAct)

      if (player.get("_hasActed") == true) {
        return null
      } else {
        return player.get('_playerName')
      }
    }

    return null
  }
)

export const isTurnToAct = (username, tableName) => createSelector(
  getCurrentPlayerToAct(tableName),
  playerName => playerName === username
)

export const getPlayerPosition = (tableName, username) => createSelector(
  getGame(tableName), game => {
    if (!game) return null
    return game.get('_players')
      .findIndex(
        plyr => plyr.get('_playerName') === username
      )
  }
)


================================================
FILE: client/app/selectors/lobby.js
================================================
import Immutable from 'immutable';
import { createSelector } from 'reselect'

export const getLobbyState = state => state.get('global').get('lobby')


================================================
FILE: client/app/selectors/profile.js
================================================
import Immutable from 'immutable'
import { createSelector } from 'reselect'

export const profile = state => ({})

export const getProfileSelector = createSelector(profile, profile => ({}))


================================================
FILE: client/app/selectors/route.js
================================================
import Immutable from 'immutable'
import { createSelector } from 'reselect'

export const getLocation = state => state.get('route').get('location')

export const getPathname = createSelector(
  getLocation,
  location => (location ? location.get('pathname') : null)
)


================================================
FILE: client/app/selectors/socket.js
================================================
import Immutable from 'immutable';
import { createSelector } from 'reselect'

export const socket = state => state.get('global').get('socket')

export const isSocketAuthenticated = createSelector(
    socket,
    state => state.get('isSocketAuth')
)


================================================
FILE: client/app/selectors/tests/games.test.js
================================================
/* eslint-disable */
import Immutable from 'immutable'

describe('Games Selectors', () => {
  describe('getGames', () => {
    it('should return correct action an authSuccess action for received asset', () => {
      expect(authRequested()).toEqual({ type: types.AUTH_REQUESTED })
    })
  })
})


================================================
FILE: client/app/styles/_common.scss
================================================
/* Re-export all common scss files */
@import 'common/mixins';
@import 'common/variables';
@import 'common/typography';
@import 'common/colours';

================================================
FILE: client/app/styles/common/_colours.scss
================================================
@import "variables";

.card {
  background-color: $neutral-colour-100;
  color: $neutral-colour-800;
}

.navbar {
  //background-color: $neutral-colour-700;
  background-color: $neutral-accent-700; // #e8e9f3; // #a18276; // #39a9db; // #39a9db;
  //  background-color: $neutral-accent-600;
  color: $neutral-colour-100;
}
.action-panel {
  background-color: transparent;
}

.hidden-pocket-cards .card {
  background-color: $neutral-colour-100; // $neutral-colour-100;
}

%seat {
  background-color: $primary-colour-700;
}


================================================
FILE: client/app/styles/common/_mixins.scss
================================================
@import "variables";

/*
---------------------------------
  Media queries
---------------------------------
*/

// Small devices
@mixin xs {
  @media (min-width: #{$screen-xs-min}) {
    @content;
  }
}

// Small devices
@mixin sm {
  @media (min-width: #{$screen-sm-min}) {
    @content;
  }
}

// Medium devices
@mixin md {
  @media (min-width: #{$screen-md-min}) {
    @content;
  }
}

// Large devices
@mixin lg {
  @media (min-width: #{$screen-lg-min}) {
    @content;
  }
}

// Extra large devices
@mixin xl {
  @media (min-width: #{$screen-xl-min}) {
    @content;
  }
}

// Extra large devices
@mixin xxl {
  @media (min-width: #{$screen-xxl-min}) {
    @content;
  }
}

// Game
%seat {
  margin: auto;
  justify-content: center;
  align-content: center;
  display: grid;
  width: 100%;
  height: 70%;
  border-radius: 7em;
  min-height: 5.3rem;
}

%showdown-pocket-cards {
  margin: 0;
  position: relative;
  top: 0.42em;
  justify-self: center;
  align-self: end;
  z-index: -1;
}

/* A poker cards dimensions are 63.5mm X 88.9mm */
%card {
  height: 2.5em;
  width: 1.7em;
  margin-left: 0.2em;
  text-align: center;
  font-weight: 800;
  background-color: $neutral-colour-100;
  border-radius: 0.33em;
  color: neutral-colour-900;
}

%dealer-btn {
  height: 1.9em;
  width: 1.9em;
  font-family: "Raleway", sans-serif;
  font-weight: 600;
  font-size: 1em;
  line-height: 2em;
  text-align: center;
  letter-spacing: -0.1em;
  border-radius: 1.7em;
  background-color: $neutral-accent-600;
  //box-shadow: 1px 1px 1px 0px rgba(18, 27, 33, 0.55);
}


================================================
FILE: client/app/styles/common/_typography.scss
================================================
// Import Modular Scale Plugin
@import "~modularscale-sass/stylesheets/modularscale";

@import "variables";

/*
---------------------------------
  Typography
---------------------------------
*/

// Monospaced

@font-face {
  font-family: "MonoP";
  src: url("../../static/fonts/MonoP-Medium.woff") format("woff"); /* Pretty Modern Browsers */
}

@font-face {
  font-family: "MonoP-Bold";
  src: url("../../static/fonts/MonoP-Bold.woff") format("woff"); /* Pretty Modern Browsers */
}

$monospaced-font: "MonoP", sans-serif;

$monospaced-font2: "MonoP-Bold", sans-serif;

.monospaced-font {
  font-family: $monospaced-font;
}

.monospaced-font-bold {
  font-family: $monospaced-font2;
}

/* cabin-500 - latin */
@font-face {
  font-family: "Cabin";
  font-style: normal;
  font-weight: 500;
  src: local("Cabin Medium"), local("Cabin-Medium"),
    /* IE6-IE8 */ url("../../static/fonts/cabin/cabin-v14-latin-500.woff2") format("woff2"),
    /* Super Modern Browsers */ url("../../static/fonts/cabin/cabin-v14-latin-500.woff") format("woff"),
    /* Modern Browsers */ url("../../static/fonts/cabin/cabin-v14-latin-500.ttf") format("truetype");
}

// Raleway

/* raleway-200 - latin */
@font-face {
  font-family: "Raleway";
  font-style: normal;
  font-weight: 200;
  src: local("Raleway ExtraLight"), local("Raleway-ExtraLight"),
    url("../../static/fonts/raleway/raleway-v14-latin-200.woff2") format("woff2"),
    /* Chrome 26+, Opera 23+, Firefox 39+ */ url("../../static/fonts/raleway/raleway-v14-latin-200.woff") format("woff"); /* Chrome 6+, Firefox 3.6+, IE 9+, Safari 5.1+ */
}
/* raleway-300 - latin */
@font-face {
  font-family: "Raleway";
  font-style: normal;
  font-weight: 300;
  src: local("Raleway Light"), local("Raleway-Light"),
    url("../../static/fonts/raleway/raleway-v14-latin-300.woff2") format("woff2"),
    /* Chrome 26+, Opera 23+, Firefox 39+ */ url("../../static/fonts/raleway/raleway-v14-latin-300.woff") format("woff"); /* Chrome 6+, Firefox 3.6+, IE 9+, Safari 5.1+ */
}
/* raleway-regular - latin */
@font-face {
  font-family: "Raleway";
  font-style: normal;
  font-weight: 400;
  src: local("Raleway"), local("Raleway-Regular"),
    url("../../static/fonts/raleway/raleway-v14-latin-regular.woff2") format("woff2"),
    /* Chrome 26+, Opera 23+, Firefox 39+ */ url("../../static/fonts/raleway/raleway-v14-latin-regular.woff")
      format("woff"); /* Chrome 6+, Firefox 3.6+, IE 9+, Safari 5.1+ */
}
/* raleway-500 - latin */
@font-face {
  font-family: "Raleway";
  font-style: normal;
  font-weight: 500;
  src: local("Raleway Medium"), local("Raleway-Medium"),
    url("../../static/fonts/raleway/raleway-v14-latin-500.woff2") format("woff2"),
    /* Chrome 26+, Opera 23+, Firefox 39+ */ url("../../static/fonts/raleway/raleway-v14-latin-500.woff") format("woff"); /* Chrome 6+, Firefox 3.6+, IE 9+, Safari 5.1+ */
}
/* raleway-700 - latin */
@font-face {
  font-family: "Raleway";
  font-style: normal;
  font-weight: 700;
  src: local("Raleway Bold"), local("Raleway-Bold"),
    url("../../static/fonts/raleway/raleway-v14-latin-700.woff2") format("woff2"),
    /* Chrome 26+, Opera 23+, Firefox 39+ */ url("../../static/fonts/raleway/raleway-v14-latin-700.woff") format("woff"); /* Chrome 6+, Firefox 3.6+, IE 9+, Safari 5.1+ */
}
/* raleway-800 - latin */
@font-face {
  font-family: "Raleway";
  font-style: normal;
  font-weight: 800;
  src: local("Raleway ExtraBold"), local("Raleway-ExtraBold"),
    url("../../static/fonts/raleway/raleway-v14-latin-800.woff2") format("woff2"),
    /* Chrome 26+, Opera 23+, Firefox 39+ */ url("../../static/fonts/raleway/raleway-v14-latin-800.woff") format("woff"); /* Chrome 6+, Firefox 3.6+, IE 9+, Safari 5.1+ */
}

$raleway-bold: "Raleway Bold", sans-serif;

$cabin: "Cabin", sans-serif;

// Configure modular-scale plugin
$modularscale: (
  base: 0.6em,
  ratio: 1.15,
  $screen-sm-min: (
    base: 0.8em,
    ratio: 1.25
  ),
  $screen-md-min: (
    base: 0.9em,
    ratio: 1.25
  ),
  $screen-lg-min: (
    base: 0.9em,
    ratio: 1.25
  ),
  $screen-xl-min: (
    base: 1em,
    ratio: 1.25
  ),
  $screen-xxl-min: (
    base: 1em,
    ratio: 1.333
  )
);

h1,
h2,
h3,
h4,
h5 {
  margin: 0;
}

h1,
.h1 {
  @include ms-respond(font-size, 5);
  font-family: "Raleway", sans-serif;
  font-weight: 800;
}

h2,
.h2 {
  @include ms-respond(font-size, 4);
  font-family: "Raleway", sans-serif;
  font-weight: 800;
}

h3,
.h3 {
  @include ms-respond(font-size, 3);
  font-family: "Raleway", sans-serif;
  letter-spacing: 1.3px;
  font-weight: 800;
}

h4,
.h4 {
  @include ms-respond(font-size, 1);
  letter-spacing: 0.8px;
  font-weight: 800;
  font-family: "Raleway", sans-serif;
}

h5,
.h5 {
  @include ms-respond(font-size, 1);
  letter-spacing: 1px;
  font-family: "Raleway", sans-serif;
  font-weight: 800;
}

body,
.body {
  @include ms-respond(font-size, 0);
  font-family: "Raleway", sans-serif;
  //letter-spacing: 1px;
}

.brand-title {
  letter-spacing: 1.4px;
  font-family: "Raleway", sans-serif;
  font-weight: 700;
  opacity: 0.85;
  color: $neutral-colour-100;
  text-transform: uppercase;
}

.card {
  font-size: 1.6em;
  @include md {
    font-size: 1.65em;
  }
  @include lg {
    font-size: 1.7em;
  }

  @include xxl {
    font-size: 2.2em;
  }
  font-family: "GothamPro-Black", sans-serif;
}

@include md {
  margin-left: 14vw;
  margin-right: 14vw;
}

/* Prevents table Aspect Ratio from being too wide on wider screens. */
@include xl {
  margin-left: 20vw;
  margin-right: 20vw;
}

.button {
  font-family: "Raleway", sans-serif;
  font-weight: 700;
  text-transform: uppercase;
  letter-spacing: 0.16em;
  font-size: 1em;
  line-height: 1em;
}

.button > .monospaced-font-bold {
  font-size: 1.2em;
  //font-family: "Raleway", sans-serif;
  font-weight: 700;
  text-transform: uppercase;
}

//.monospaced-font
.player-name {
  //font-family: $monospaced-font;
  color: $neutral-colour-300;
  font-weight: 700;
  font-size: 1.3em;
  text-align: center;
  text-transform: uppercase;
}

.navbar-username {
}

.pot-label {
  font-weight: 800;
  align-self: center;
  justify-self: center;
}

td {
  font-weight: 700;
  @include ms-respond(font-size, 1);
  letter-spacing: 0.8px;
}


================================================
FILE: client/app/styles/common/_variables.scss
================================================
/*** Variables ***/

/*
---------------------------------
  Colours
---------------------------------
*/

$primary-colour-100: #edf6fc;
$primary-colour-200: #a0d7ff;
$primary-colour-300: #4bb3fd;
$primary-colour-400: #14a1ff;
$primary-colour-500: #027cce;
$primary-colour-600: #015c99;
$primary-colour-700: #014877;
$primary-colour-800: #39a9db;
$primary-colour-900: #003856;

$neutral-colour-100: #e5f1f9;
$neutral-colour-200: #dee2e2;
$neutral-colour-300: #cee2e2;
$neutral-colour-400: #5d8989;
$neutral-colour-500: #4f535b;
$neutral-colour-600: #244242;
$neutral-colour-700: #243942;
$neutral-colour-800: #131414;

$neutral-accent-100: #cfe8f9;
$neutral-accent-200: #a0c9e5;
$neutral-accent-300: #6698ba;
$neutral-accent-400: #56819e;
$neutral-accent-500: #495c68;
$neutral-accent-600: #213b4f;
$neutral-accent-700: #172630;
$neutral-accent-900: #121b21;

//2c3e50
//$gradient: radial-gradient($neutral-accent-600, $neutral-accent-900);
$gradient: radial-gradient($neutral-accent-600, $neutral-accent-900);

//$success-accent-100:
//$success-accent-200:
//$success-accent-300:
//$success-accent-400:
//$success-accent-500:
//$success-accent-600:
//$success-accent-700:
//
//$warning-accent-100:
//$warning-accent-200:
//$warning-accent-300:
//$warning-accent-400:
//$warning-accent-500:
//$warning-accent-600:
//$warning-accent-700:
//
//$danger-accent-100:
//$danger-accent-200:
//$danger-accent-300:
//$danger-accent-400:
//$danger-accent-500:
//$danger-accent-600:
//$danger-accent-700:

// table gradient should comprise of mixed palette colours
$dark-imperial-blue: #003e60;

$anti-flash-white: white; // #F0EFF4;

$prussian-blue: #003049;
$dark-cerulean: #064789;
$eerie-black: #161925;
$deep-space-purple: #415a77;

$outer-space-grey: #424b54;

$color-grey-400: $outer-space-grey;

// or
$orioles-orange: #f34213; // perhaps busies the palette too much

// App colours
$color-primary: $prussian-blue;
$color-secondary: $dark-imperial-blue;
$color-accent: $orioles-orange;
$color-light: $deep-space-purple;
$color-darkest: $eerie-black;

$color-brand: $prussian-blue;

// gradients
$gotham: radial-gradient(#240b36, $dark-imperial-blue);

$witching-hour: radial-gradient(#c31432, #240b36);
$night-hawk: radial-gradient(#2980b9, #2c3e50);
$red-mist: radial-gradient(#e74c3c, #000000);
$namn: linear-gradient(#a73737, #7a2828);

// Brand colours
$color-facebook: #3b5998;
$color-feedly: #2bb24c;
$color-github: #333;
$color-google: #dc4e41;
$color-instagram: #3f729b;
$color-linkedin: #0077b5;
$color-medium: #00ab6b;
$color-messenger: #0084ff;
$color-rss: #f26522;
$color-spotify: #2ebd59;
$color-twitter: #55acee;

// Borders
$border-light: solid 1px rgba(0, 0, 0, 0.05);

/*
---------------------------------
  Media queries
---------------------------------
*/

// Very small devices such as small phones
$screen-xs-min: 376px;

// Small tablets and large smartphones (landscape view)
$screen-sm-min: 576px;

// Small tablets (portrait view)
$screen-md-min: 798px;

// Tablets and small desktops
$screen-lg-min: 1222px;

// Large tablets and desktops
$screen-xl-min: 1250px;

// Large tablets and desktops
$screen-xxl-min: 1600px;

/*
---------------------------------
  Animation
---------------------------------
*/

// Animation
$anime-in: 0.4s;
$anime-out: 0.5s;


================================================
FILE: client/app/styles/components/_buttons.scss
================================================
@import "../common";

.button {
  border-radius: 1.5em;
  width: 8em;
  height: 4rem;
  margin: 0.5em;
  padding: 0.8em;
  border: 0;
  background-color: $primary-colour-700;
  color: $neutral-colour-100;
  border: none;
}

.button:hover,
.button:focus {
  background-color: $primary-colour-600;
  transition: background-color ease-in-out 0.25s;
  outline: 0;
}


================================================
FILE: client/app/styles/components/_footer.scss
================================================
.footer {
  background: green;
}

================================================
FILE: client/app/styles/components/_forms.scss
================================================
.form-container {
  width: 35vw;
  min-width: 200px;
  margin: auto;
  text-align: center;
}
.form {
  text-align: centre;
}

.form-container {
  margin: auto;
}


================================================
FILE: client/app/styles/components/_game.scss
================================================
@import "game/table";
@import "game/actionPanel";
@import "game/boardCards";
@import "game/cards";
@import "game/seat";
@import "game/slider";

.game-container {
  display: flex;
  justify-content: center;
  align-items: center;
  grid-column-start: 2;
  grid-row-start: 1;
  margin-top: 11vh;
}

.game-grid {
  grid-area: 2/2/5/5;
  display: grid;
  grid-template-columns: repeat(5, 1fr);
  grid-template-rows: repeat(6, 1fr);
}


================================================
FILE: client/app/styles/components/_lobby.scss
================================================
.game-table-list {
  margin: auto;
  text-align: center;
  margin-top: 10%;
  width: 60%;
}

.game-table-list tr {
  padding-top: 1em;
}


================================================
FILE: client/app/styles/components/_navbar.scss
================================================
.navbar {
  display: flex;
  text-align: center;
  min-height: 4em;
}

.navbar-brand {
  width: 16em;
  margin: auto;
  text-align: left;
  padding-left: 2.5em;
}

.navbar-menu {
  display: flex;
  justify-content: space-between;
  width: 100%;
}

.navbar-start {
  display: flex;
  justify-content: space-between;
  align-items: center;
}

.navbar-end {
  display: flex;
  justify-content: space-between;
  align-items: center;
  padding-right: 2.5em;
}

.navbar-item {
  width: 9em;
  margin: 7%;
}

.navbar-item-active {
  color: $neutral-colour-500;
}

.navbar-item h4 {
  font-weight: 700;
}

.navbar-item:hover {
  opacity: 0.82;
  transition: all 0.08s linear;
}

.navbar-item-active {
  width: 7em;
  margin: 7%;
  color: $eerie-black;
}

.brand-title {
  letter-spacing: 0.1em;
}


================================================
FILE: client/app/styles/components/game/_actionPanel.scss
================================================
.action-panel {
  grid-column-start: 2;
  grid-row-start: 2;
  width: 70%;
  margin: auto;
  grid-row-end: 4;
  display: flex;

  @include md {
    border-radius: 3em 3em 0 0;
  }
}

.user-actions-container {
  margin: auto;
}


================================================
FILE: client/app/styles/components/game/_boardCards.scss
================================================
.board-cards {
  justify-self: center;
  align-self: center;
  grid-area: 3/1/5/6;
}

.board-cards-container {
  display: flex;
  height: 100%;
  width: 100%;
  justify-self: center;
  align-self: center;
}


================================================
FILE: client/app/styles/components/game/_cards.scss
================================================
@import "../../common";

.rank {
  font-family: "MonoP-Bold", sans-serif;
  font-weight: 800;
  height: 1.32em;
}

.suit > img {
  height: 0.75em;
  width: 0.75em;
  margin-bottom: 1.3em;
}

.suit-icon {
  width: 100%;
}

.card {
  @extend %card;
}

/* cards behind player oval representing opponent pockets outwith showdown */
.hidden-pocket-cards .card {
  position: absolute;
  z-index: -1;
  margin: 0;
  height: 3em;
  top: -1em;
}

.hidden-pocket-cards-container {
  width: 70%;
  margin: auto;
}

.pocket-one {
  right: 65%;
  margin-left: 0;
}

/* Pocket cards held by opponents that are face down */
.hidden-pocket-cards {
  position: relative;
  margin: auto;
  width: 0;
}

/* Cards displayed at showdown  */
.showdown-pocket-cards-container {
  width: 100%;

  display: flex;
}

.showdown-pocket-cards-container:first-child {
  margin-right: 0.15em;
}

.showdown-pocket-cards-container:last-child {
  margin-right: 0.15em;
}

.showdown-pocket-cards-0 {
  @extend %showdown-pocket-cards;
  grid-area: 4/3;
}

.showdown-pocket-cards-1 {
  @extend %showdown-pocket-cards;
  grid-area: 3/1;
}

.showdown-pocket-cards-2 {
  @extend %showdown-pocket-cards;
  grid-area: 1/1;
}

.showdown-pocket-cards-3 {
  @extend %showdown-pocket-cards;
  grid-area: 1/3;
}

.showdown-pocket-cards-4 {
  @extend %showdown-pocket-cards;
  grid-area: 1/5;
}

.showdown-pocket-cards-5 {
  @extend %showdown-pocket-cards;
  grid-area: 3/5;
}

.showdown-pocket-cards-6 {
  @extend %showdown-pocket-cards;
  grid-area: 1/3;
}


================================================
FILE: client/app/styles/components/game/_seat.scss
================================================
/*

The real power of mixins comes when you pass them arguments. 
Arguments are declared as a parenthesized, comma-separated list of variables. 

Each of those variables is assigned a value each time the mixin is used.

@mixin default-box($color, $boxModel, $padding) {
  $borderColor: $color;
  border: 1px solid $borderColor;
  clear: both;
  display: $boxModel;
  margin: 5px 0;
  padding: 5px $padding;
}

header{ @include default-box(#666, block, 10px); }
footer{ @include default-box(#999, inline-block, 5px);
*/
/* Mixins */
@import "../../common";

.player-chip-count > .monospaced-font-bold {
  font-size: 1.2em;
  @include lg {
    font-size: 1.2em;
  }
  @include xxl {
    font-size: 1.33em;
  }
}

// current seated player's turn to act
.active-player {
  border: 0.3em;
  border-style: solid;
  box-sizing: border-box;
  -moz-box-sizing: border-box;
  -webkit-box-sizing: border-box;
  border-color: $neutral-accent-100;
}

.disabled {
  opacity: 0.9;
}

div[class^="seat-"] > h4 {
  margin: 0;
}
div[class^="seat-"] > h5 {
  margin: 0;
}
div[class^="seat-"] > h3 {
  margin: 0;
}

.seat-0 {
  @extend %seat;
}

.seat-0-container {
  grid-area: 5/3;
}

.seat-1 {
  @extend %seat;
}

.seat-1-container {
  grid-area: 4/1;
}

.seat-2 {
  @extend %seat;
  grid-area: 2/1;
}

.seat-2-container {
  grid-area: 2/1;
}

.seat-3 {
  @extend %seat;
  grid-area: 1/3;
}

.seat-3-container {
  grid-area: 1/3;
}

.seat-4 {
  @extend %seat;
  grid-area: 2/5;
}

.seat-4-container {
  grid-area: 2/5;
}

.seat-5 {
  @extend %seat;
}

.seat-5-container {
  grid-area: 4/5;
}

.empty-seat {
  opacity: 0.15;
  color: transparent;
}

.empty-seat:hover {
  opacity: 0.2;
  transition: ease-in-out 0.1s;
  color: $primary-colour-700;
}


================================================
FILE: client/app/styles/components/game/_slider.scss
================================================
.slidecontainer {
  width: 100%; /* Width of the outside container */
  margin: auto;
  text-align: center;
  padding-bottom: 1.5rem;
}

/* The slider itself */
.slider {
  -webkit-appearance: none; /* Override default CSS styles */
  appearance: none;
  width: 50%; /* Full-width */

  height: 0.3em; /* Specified height */
  background: $neutral-colour-700; /* Grey background */
  outline: none; /* Remove outline */
  opacity: 0.5; /* Set transparency (for mouse-over effects on hover) */
  -webkit-transition: 0.2s; /* 0.2 seconds transition on hover */
  transition: opacity 0.2s;
}

/* Mouse-over effects */
.slider:hover {
  opacity: 1; /* Fully shown on mouse-over */
}

/* The slider handle (use -webkit- (Chrome, Opera, Safari, Edge) and -moz- (Firefox) to override default look) */
.slider::-webkit-slider-thumb {
  -webkit-appearance: none; /* Override default look */
  appearance: none;
  width: 1.1em; /* Set a specific slider handle width */
  height: 1.1em; /* Slider handle height */
  background: $neutral-accent-200;
  border-radius: 100%;
  cursor: pointer; /* Cursor on hover */
}

.slider::-moz-range-thumb {
  width: 2em; /* Set a specific slider handle width */
  height: 2em; /* Slider handle height */
  background: #4caf50; /* Green background */
  cursor: pointer; /* Cursor on hover */
}


================================================
FILE: client/app/styles/components/game/_table.scss
================================================
/* Six Player Table */
.table-container {
  display: grid;
  grid-template-columns: 1.5fr 1fr 1.5fr 1fr 1.5fr;
  grid-template-rows: repeat(5, 5fr);
  width: 100%;
  height: 100%;
  margin-left: 14vw;
  margin-right: 14vw;

  @include md {
    margin: auto;
  }
}

.table-container h2 {
  justify-self: center;
  margin: 0;
}

/* 
  Selects the chip count inside the player oval 
  
  Adds whitespace between player name and chip count
*/
.table-container h2 + h2 {
  padding: 0.7em 0 0 0;
}

.game-table {
  position: relative;
  grid-area: 2/2/5/5;
  width: 120%;
  height: 120%;
  left: -10.25%;
  top: -13.4%;
  border-radius: 100%;
  z-index: -10;
  background: radial-gradient($primary-colour-600, $primary-colour-900);
}

.pot-label {
  grid-area: 2/2/2/5;
  top: -0.6em;
  position: relative;
  color: $neutral-colour-100;
  justify-self: center;
}

.winners-label {
  color: $neutral-colour-100;
  font-family: $cabin;
  text-transform: capitalize;
  grid-area: 3/1/3/6;
  justify-self: center;
  font-weight: 500;
  top: -0.9em;
  position: relative;
}

.dealer-btn-pos-0 {
  @extend %dealer-btn;
  grid-area: 6/2;
  justify-self: center;
  align-self: center;
}

.dealer-btn-pos-1 {
  @extend %dealer-btn;
  grid-area: 4/1;
  align-self: center;
}

.dealer-btn-pos-2 {
  @extend %dealer-btn;
  grid-area: 1/2;

  justify-self: left;
  align-self: center;
}

.dealer-btn-pos-3 {
  @extend %dealer-btn;
  grid-area: 1/4;
}

.dealer-btn-pos-4 {
  @extend %dealer-btn;
  grid-area: 2/5;
  justify-self: center;
}

.dealer-btn-pos-5 {
  @extend %dealer-btn;
  grid-area: 4/5;
  justify-self: center;
}

.player-bet-label {
  margin-right: 0.25em;
  margin-left: 0.32em;
  height: 1.25em;
  width: 100%;
}

.player-bet-chip {
  background-color: $neutral-accent-200;
  height: 1.25em;
  width: 1.25em;
  border-radius: 1.25em;
  //box-shadow: 1px 1px 1px 0px rgba(0, 0, 0, 0.55);
}

.player-bet-container-pos-0 {
  grid-area: 5/3/5/5;
}

.player-bet-pos-0 {
  display: flex;
  justify-content: center;
}

.player-bet-container-pos-1 {
  grid-area: 5/1/5/3;
  align-self: start;
}

.player-bet-pos-1 {
  width: 100%;
  text-align: left;
  display: flex;
}

.player-bet-container-pos-2 {
  grid-area: 2/1 / span 1 / span 2;
  position: relative;
}

.player-bet-pos-2 {
  text-align: left;
  display: flex;
}

.player-bet-container-pos-3 {
  margin-top: 0.25em;
  grid-area: 1/4 / span 1 / span 2;
  text-align: left;
}

.player-bet-pos-3 {
  width: 100%;
  display: flex;
  justify-content: right;
}

.player-bet-container-pos-4 {
  grid-area: 2/5;
  position: relative;
  text-align: right;
}

.player-bet-pos-4 {
  text-align: right;
  position: absolute;
  bottom: 0;
  display: flex;
  flex-direction: row-reverse;
}

.player-bet-container-pos-5 {
  grid-area: 5/5;
  text-align: right;
  position: relative;
}

.player-bet-pos-5 {
  position: absolute;
  display: flex;
  flex-direction: row-reverse;
}


================================================
FILE: client/app/styles/layout/_app.scss
================================================
@import "../common/mixins";

%full-screen {
  position: absolute;
  height: 100%;
  width: 100%;
}

.app {
  @extend %full-screen;
}

.app-wrapper {
  @extend %full-screen;
  display: grid;
  grid-template-columns: auto;
  grid-template-rows: 0.8fr 15fr;
  grid-template-areas:
    "navbar"
    "main";
}

.game-view-grid {
  display: grid;
  grid-template-columns: max-content;
  grid-template-rows: 75vh 10vh;

  @include md {
    margin-left: 14vw;
    margin-right: 14vw;
  }

  /* Prevents table Aspect Ratio from being too wide on wider screens. */
  @include xl {
    margin-left: 23vw;
    margin-right: 23vw;
  }
}


================================================
FILE: client/app/styles/main.scss
================================================
/* Main App Grid */
@import "layout/app";

/* Improt common modules */
@import "common";

/* Components */
@import "components/game";
@import "components/footer";
@import "components/navbar";
@import "components/buttons";
@import "components/lobby";

@import "components/forms";

// Main Layout Colours
html {
  color: $neutral-colour-100;
  background: $gradient; // #10212d;
  height: 100%;
}


================================================
FILE: client/app/utils/request.js
================================================
/**
 * Parses the JSON returned by a network request
 *
 * @param  {object} response A response from a network request
 *
 * @return {object}          The parsed JSON from the request
 */
export function parseJSON(response) {
  if (response.status === 204 || response.status === 205) {
    return null
  }
  return response.json()
}

/**
 * Checks if a network request came back fine, and throws an error if not
 *
 * @param  {object} response   A response from a network request
 *
 * @return {object|undefined} Returns either the response, or throws an error
 */
export function checkStatus(response) {
  if (response.status >= 200 && response.status < 300) {
    return response
  }

  const error = new Error(response.statusText)
  error.response = response
  throw error
}


================================================
FILE: client/config/jest-mocks/cssModule.js
================================================
module.exports = 'CSS_MODULE'


================================================
FILE: client/config/jest-mocks/image.js
================================================
module.exports = 'IMAGE_MOCK'


================================================
FILE: client/config/jest.config.js
================================================
module.exports = {
  collectCoverageFrom: [
    'app/**/*.{js,jsx}',
    '!app/**/*.test.{js,jsx}',
    '!app/*/RbGenerated*/*.{js,jsx}',
    '!app/app.js',
    '!app/*/*/Loadable.{js,jsx}'
  ],
  coverageThreshold: {
    global: {
      statements: 90,
      branches: 80,
      functions: 92,
      lines: 90
    }
  },
  coverageReporters: ['json', 'lcov', 'text-summary'],
  moduleDirectories: ['node_modules', 'app'],
  moduleNameMapper: {
    '.*\\.(css|less|styl|scss|sass)$':
      '<rootDir>/config/jest-mocks/cssModule.js',
    '.*\\.(jpg|jpeg|png|gif|eot|otf|webp|svg|ttf|woff|woff2|mp4|webm|wav|mp3|m4a|aac|oga)$':
      '<rootDir>/config/jest-mocks/image.js'
  },
  setupTestFrameworkScriptFile: '<rootDir>/config/test-setup.js',
  testEnvironment: 'node',
  testRegex: 'tests/.*\\.test\\.js$'
}


================================================
FILE: client/config/test-setup.js
================================================
// needed for regenerator-runtime
// (ES7 generator support is required by redux-saga)
import 'babel-polyfill'

// Enzyme adapter for React 16
import Enzyme from 'enzyme'
import Adapter from 'enzyme-adapter-react-16'

Enzyme.configure({ adapter: new Adapter() })


================================================
FILE: client/config/webpack.base.babel.js
================================================
/**
 * COMMON WEBPACK CONFIGURATION
 */

const path = require('path')
const webpack = require('webpack')

process.noDeprecation = true

module.exports = options => ({
  mode: options.mode,
  entry: options.entry,
  output: Object.assign(
    {
      // Compile into js/build.js
      path: path.resolve(process.cwd(), 'build'),
      publicPath: '/'
    },
    options.output
  ), // Merge with env dependent settings
  module: {
    rules: [
      {
        test: /\.js$/, // Transform all .js files required somewhere with Babel
        exclude: /node_modules/,
        use: {
          loader: 'babel-loader',
          options: options.babelQuery
        }
      },
      {
        // Preprocess our own .scss files
        test: /\.scss$/,
        exclude: /node_modules/,
        use: ['style-loader', 'css-loader', 'sass-loader']
      },
      {
        // Preprocess 3rd party .css files located in node_modules
        test: /\.css$/,
        include: /node_modules/,
        use: ['style-loader', 'css-loader']
      },
      {
        test: /\.(eot|svg|otf|ttf|woff|woff2)$/,
        use: 'file-loader'
      },
      {
        test: /\.(jpg|png|gif)$/,
        use: [
          'file-loader',
          {
            loader: 'image-webpack-loader',
            options: {
              query: {
                gifsicle: {
                  interlaced: true
                },
                mozjpeg: {
                  progressive: true
                },
                optipng: {
                  optimizationLevel: 7
                },
                pngquant: {
                  quality: '65-90',
                  speed: 4
                }
              }
            }
          }
        ]
      },
      {
        test: /\.html$/,
        use: 'html-loader'
      },
      {
        test: /\.json$/,
        use: 'json-loader'
      },
      {
        test: /\.(mp4|webm)$/,
        use: {
          loader: 'url-loader',
          options: {
            limit: 10000
          }
        }
      }
    ]
  },
  plugins: options.plugins.concat([
    new webpack.ProvidePlugin({
      // make fetch available
      fetch: 'exports-loader?self.fetch!whatwg-fetch'
    }),

    // Always expose NODE_ENV to webpack, in order to use `process.env.NODE_ENV`
    // inside your code for any environment checks; UglifyJS will automatically
    // drop any unreachable code.
    new webpack.DefinePlugin({
      'process.env': {
        NODE_ENV: JSON.stringify(process.env.NODE_ENV)
      }
    })
  ]),
  resolve: {
    modules: ['app', 'node_modules'],
    extensions: ['.js', '.jsx', '.scss', '.react.js'],
    mainFields: ['browser', 'jsnext:main', 'main']
  },
  devtool: options.devtool,
  target: 'web', // Make web variables accessible to webpack, e.g. window
  performance: options.performance || {},
  optimization: {
    namedModules: true,
    splitChunks: {
      name: 'vendor',
      minChunks: 2
    }
  }
})


================================================
FILE: client/config/webpack.dev.babel.js
================================================
/**
 * DEVELOPMENT WEBPACK CONFIGURATION
 */

const path = require('path')
const webpack = require('webpack')
const HtmlWebpackPlugin = require('html-webpack-plugin')
const CircularDependencyPlugin = require('circular-dependency-plugin')

module.exports = require('./webpack.base.babel')({
  mode: 'development',
  // Add hot reloading in development
  entry: [
    'eventsource-polyfill', // Necessary for hot reloading with IE
    'webpack-hot-middleware/client?reload=true',
    path.join(process.cwd(), 'app/app.js') // Start with js/app.js
  ],

  // Don't use hashes in dev mode for better performance
  output: {
    filename: '[name].js',
    chunkFilename: '[name].chunk.js'
  },

  // Add development plugins
  plugins: [
    new webpack.HotModuleReplacementPlugin(), // Tell webpack we want hot reloading
    new HtmlWebpackPlugin({
      inject: true, // Inject all files that are generated by webpack, e.g. bundle.js
      template: 'app/index.html'
    }),
    new CircularDependencyPlugin({
      exclude: /a\.js|node_modules/, // exclude node_modules
      failOnError: false // show a warning when there is a circular dependency
    })
  ],

  // Emit a source map for easier debugging
  // See https://webpack.js.org/configuration/devtool/#devtool
  devtool: 'eval-source-map',

  performance: {
    hints: false
  }
})


================================================
FILE: client/config/webpack.prod.babel.js
================================================
// Important modules this config uses
const path = require('path')
// const webpack = require('webpack');
const HtmlWebpackPlugin = require('html-webpack-plugin')

module.exports = require('./webpack.base.babel')({
  mode: 'production',
  // In production, we skip all hot-reloading stuff
  entry: [path.join(process.cwd(), 'app/app.js')],

  // Utilize long-term caching by adding content hashes (not compilation hashes) to compiled assets
  output: {
    filename: '[name].[chunkhash].js',
    chunkFilename: '[name].[chunkhash].chunk.js',
    publicPath: '/'
  },

  plugins: [
    // Minify and optimize the index.html
    new HtmlWebpackPlugin({
      template: 'app/index.html',
      minify: {
        removeComments: true,
        collapseWhitespace: true,
        removeRedundantAttributes: true,
        useShortDoctype: true,
        removeEmptyAttributes: true,
        removeStyleLinkTypeAttributes: true,
        keepClosingSlash: true,
        minifyJS: true,
        minifyCSS: true,
        minifyURLs: true
      },
      inject: true
    })
  ],

  performance: {
    assetFilter: assetFilename =>
      !/(\.map$)|(^(main\.|favicon\.))/.test(assetFilename)
  }
})


================================================
FILE: client/jest.config.js
================================================
module.exports = require('./config/jest.config')


================================================
FILE: client/netlify.toml
================================================
[build]
  publish = "build"
  command = "yarn run build:prod"

[build.environment]
  NODE_VERSION = "10.16.3"
  YARN_VERION = "1.17.3"

# The following redirect is intended for use with most SPAs that handle
# routing internally.
[[redirects]]
  from = "/*"
  to = "/index.html"
  status = 200

[[headers]]
  # Define which paths this specific [[headers]] block will cover.
  for = "/*"
    [headers.values]
    Access-Control-Allow-Origin = "*"

================================================
FILE: client/package.json
================================================
{
  "name": "poker-client",
  "version": "0.1.0",
  "description": "Poker Client",
  "repository": {
    "type": "git",
    "url": "https://github.com/therewillbecode/haskell-poker"
  },
  "engines": {
    "npm": ">=3",
    "node": ">=5"
  },
  "author": "therewillbecode",
  "license": "Unlicense",
  "scripts": {
    "prebuild": "npm run build:clean",
    "build:prod": "NODE_ENV=production node_modules/.bin/webpack --config config/webpack.prod.babel.js --color -p --progress --hide-modules --display-optimization-bailout",
    "build:clean": "rimraf ./build",
    "start": "cross-env NODE_ENV=development node server/index.js",
    "start:docker": "cross-env NODE_ENV=docker node server/index.js",
    "start:production": "npm run test && npm run build && npm run start:prod",
    "start:prod": "cross-env NODE_ENV=production node server/index.js",
    "deploy": "npm run build:clean && yarn run copy-static && yarn run build && aws s3 sync build/ s3://poker-client --delete",
    "clean": "npm run test:clean && npm run build:clean",
    "lint": "npm run lint:eslint",
    "lint:eslint": "eslint .",
    "eslint:fix": "eslint --fix .",
    "prettier:fix": "node ./node_modules/prettier/bin-prettier.js --write app /**/*.js",
    "test:clean": "rimraf ./coverage",
    "test": "cross-env NODE_ENV=test jest --coverage",
    "test:watch": "cross-env NODE_ENV=test jest --watchAll"
  },
  "dependencies": {
    "axios": "^0.19.0",
    "babel-polyfill": "6.26.0",
    "chalk": "^2.3.2",
    "fontfaceobserver": "2.0.13",
    "history": "4.7.2",
    "hoist-non-react-statics": "3.0.1",
    "immutable": "3.8.2",
    "invariant": "2.2.4",
    "ip": "1.1.5",
    "modularscale-sass": "^3.0.5",
    "prop-types": "15.6.2",
    "react": "^16.11.0",
    "react-dom": "^16.11.0",
    "react-helmet": "5.2.0",
    "react-loadable": "^5.4.0",
    "react-redux": "5.0.7",
    "react-router-dom": "^4.3.1",
    "react-router-redux": "5.0.0-alpha.6",
    "reconnecting-websocket": "^4.2.0",
    "redux": "4.0.0",
    "redux-immutable": "4.0.0",
    "redux-logger": "^3.0.6",
    "redux-thunk": "^2.3.0",
    "reselect": "3.0.1",
    "sanitize.css": "11.0.0",
    "warning": "^4.0.1",
    "whatwg-fetch": "2.0.4"
  },
  "devDependencies": {
    "add-asset-html-webpack-plugin": "2.1.3",
    "babel-cli": "6.26.0",
    "babel-core": "^6.26.3",
    "babel-eslint": "8.2.6",
    "babel-loader": "7.1.5",
    "babel-plugin-dynamic-import-node": "2.0.0",
    "babel-plugin-react-transform": "3.0.0",
    "babel-plugin-transform-es2015-modules-commonjs": "^6.26.2",
    "babel-plugin-transform-react-constant-elements": "6.23.0",
    "babel-plugin-transform-react-inline-elements": "6.22.0",
    "babel-plugin-transform-react-remove-prop-types": "0.4.14",
    "babel-preset-env": "^1.6.1",
    "babel-preset-react": "6.24.1",
    "babel-preset-stage-0": "6.24.1",
    "circular-dependency-plugin": "5.0.2",
    "compression": "1.7.4",
    "cross-env": "6.0.3",
    "css-loader": "1.0.0",
    "enzyme": "^3.3.0",
    "enzyme-adapter-react-16": "^1.1.1",
    "eslint": "5.3.0",
    "eslint-config-airbnb": "17.0.0",
    "eslint-config-airbnb-base": "13.0.0",
    "eslint-config-prettier": "^2.9.0",
    "eslint-import-resolver-webpack": "^0.10.0",
    "eslint-plugin-import": "^2.12.0",
    "eslint-plugin-jsx-a11y": "6.1.1",
    "eslint-plugin-prettier": "^2.6.2",
    "eslint-plugin-react": "^7.9.1",
    "eventsource-polyfill": "0.9.6",
    "exports-loader": "0.7.0",
    "express": "4.17.1",
    "file-loader": "1.1.11",
    "html-loader": "0.5.5",
    "html-webpack-plugin": "3.2.0",
    "image-webpack-loader": "^4.3.1",
    "imports-loader": "0.8.0",
    "jest-cli": "^23.1.0",
    "lint-staged": "^7.1.3",
    "moxios": "^0.4.0",
    "node-plop": "^0.16.0",
    "node-sass": "^4.13.0",
    "null-loader": "0.1.1",
    "plop": "2.1.0",
    "prettier": "^1.14.2",
    "react-test-renderer": "^16.4.0",
    "redux-mock-store": "^1.5.3",
    "rimraf": "2.6.2",
    "sass-loader": "^7.0.1",
    "shelljs": "^0.8.1",
    "style-loader": "^0.22.1",
    "url-loader": "1.0.1",
    "webpack": "^4.41.2",
    "webpack-cli": "^3.0.3",
    "webpack-dev-middleware": "^3.3.3",
    "webpack-dev-server": "^3.9.0",
    "webpack-hot-middleware": "^2.3.2"
  }
}


================================================
FILE: client/server/index.js
================================================
/* eslint consistent-return:0 */

const express = require('express')
const { resolve } = require('path')
const logger = require('./util//logger')

const argv = require('./util/argv')
const port = require('./util//port')
const setup = require('./middlewares/frontendMiddleware')

const app = express()

// If you need a backend, e.g. an API, add your custom backend-specific middleware here
// app.use('/api', myApi);

// In production we need to pass these values in instead of relying on webpack
setup(app, {
  outputPath: resolve(process.cwd(), 'build'),
  publicPath: '/'
})

// get the intended host and port number, use localhost and port 3000 if not provided
const customHost = argv.host || process.env.HOST
const host = customHost || null // Let http.Server use its default IPv6/4 host
const prettyHost = customHost || 'localhost'

// Start your app.
app.listen(port, host, err => {
  if (err) {
    return logger.error(err.message)
  }
  logger.appStarted(port, prettyHost)
})


================================================
FILE: client/server/middlewares/addDevMiddlewares.js
================================================
const path = require('path')
const webpack = require('webpack')
const webpackDevMiddleware = require('webpack-dev-middleware')
const webpackHotMiddleware = require('webpack-hot-middleware')

function createWebpackMiddleware(compiler, publicPath) {
  return webpackDevMiddleware(compiler, {
    noInfo: true,
    publicPath,
    silent: true,
    stats: 'errors-only'
  })
}

module.exports = function addDevMiddlewares(app, webpackConfig) {
  const compiler = webpack(webpackConfig)
  const middleware = createWebpackMiddleware(
    compiler,
    webpackConfig.output.publicPath
  )

  app.use(middleware)
  app.use(webpackHotMiddleware(compiler))

  // Since webpackDevMiddleware uses memory-fs internally to store build
  // artifacts, we use it instead
  const fs = middleware.fileSystem

  app.get('*', (req, res) => {
    fs.readFile(path.join(compiler.outputPath, 'index.html'), (err, file) => {
      if (err) {
        res.sendStatus(404)
      } else {
        res.send(file.toString())
      }
    })
  })
}


================================================
FILE: client/server/middlewares/addProdMiddlewares.js
================================================
const path = require('path')
const express = require('express')
const compression = require('compression')

module.exports = function addProdMiddlewares(app, options) {
  const publicPath = options.publicPath || '/'
  const outputPath = options.outputPath || path.resolve(process.cwd(), 'build')

  // compression middleware compresses your server responses which makes them
  // smaller (applies also to assets). You can read more about that technique
  // and other good practices on official Express.js docs http://mxs.is/googmy
  app.use(compression())
  app.use(publicPath, express.static(outputPath))

  app.get('*', (req, res) =>
    res.sendFile(path.resolve(outputPath, 'index.html'))
  )
}


================================================
FILE: client/server/middlewares/frontendMiddleware.js
================================================
/* eslint-disable global-require */

/**
 * Front-end middleware
 */
module.exports = (app, options) => {
  const isProd = process.env.NODE_ENV === 'production'

  if (isProd) {
    const addProdMiddlewares = require('./addProdMiddlewares')
    addProdMiddlewares(app, options)
  } else {
    const webpackConfig = require('../../config/webpack.dev.babel')
    const addDevMiddlewares = require('./addDevMiddlewares')
    addDevMiddlewares(app, webpackConfig)
  }

  return app
}


================================================
FILE: client/server/util/argv.js
================================================
module.exports = require('minimist')(process.argv.slice(2))


================================================
FILE: client/server/util/logger.js
================================================
/* eslint-disable no-console */

const chalk = require('chalk')
const ip = require('ip')

const divider = chalk.gray('\n-----------------------------------')

/**
 * Logger middleware, you can customize it to make messages more personal
 */
const logger = {
  // Called whenever there's an error on the server we want to print
  error: err => {
    console.error(chalk.red(err))
  },

  // Called when express.js app starts on given port w/o errors
  appStarted: (port, host) => {
    console.log(`Server started ! ${chalk.green('✓')}`)

    console.log(`
${chalk.bold('Access URLs:')}${divider}
Localhost: ${chalk.magenta(`http://${host}:${port}`)}
      LAN: ${chalk.magenta(`http://${ip.address()}:${port}`)}${divider}
${chalk.blue(`Press ${chalk.italic('CTRL-C')} to stop`)}
    `)
  }
}

module.exports = logger


================================================
FILE: client/server/util/port.js
================================================
const argv = require('./argv')

module.exports = parseInt(argv.port || process.env.PORT || '3000', 10)


================================================
FILE: client/shell.nix
================================================
# so we can access the `pkgs` and `stdenv` variables
with import <nixpkgs> {};

# Make a new "derivation" that represents our shell
stdenv.mkDerivation {
  name = "my-environment";

  # The packages in the `buildInputs` list will be added to the PATH in our shell
  buildInputs = [
    pkgs.nodejs-10_x
    pkgs.yarn
    pkgs.ocaml
    pkgs.pngquant
    pkgs.libpng12
    pkgs.python
    pkgs.autoreconfHook
  ];
}


================================================
FILE: client/static/fonts/GothamPro/GothamHTF-BookCondensed.otf
================================================






<!DOCTYPE html>
<html lang="en">
  <head>
    <meta charset="utf-8">
  <link rel="dns-prefetch" href="https://assets-cdn.github.com">
  <link rel="dns-prefetch" href="https://avatars0.githubusercontent.com">
  <link rel="dns-prefetch" href="https://avatars1.githubusercontent.com">
  <link rel="dns-prefetch" href="https://avatars2.githubusercontent.com">
  <link rel="dns-prefetch" href="https://avatars3.githubusercontent.com">
  <link rel="dns-prefetch" href="https://github-cloud.s3.amazonaws.com">
  <link rel="dns-prefetch" href="https://user-images.githubusercontent.com/">



  <link crossorigin="anonymous" media="all" integrity="sha512-Z0JAar9+DkI1NjGVdZr3GivARUgJtA0o2eHlTv7Ou2gshR5awWVf8QGsq11Ns9ZxQLEs+G5/SuARmvpOLMzulw==" rel="stylesheet" href="https://assets-cdn.github.com/assets/frameworks-95aff0b550d3fe338b645a4deebdcb1b.css" />
  <link crossorigin="anonymous" media="all" integrity="sha512-h5cEqWTuBT7ANPGSQLt1mH+ozRnf2uZHIo5hzaBUEaFGGVZkq/aXrTxFNXPfCm9ir2ztHtlW4AAMl2IxBKc1pQ==" rel="stylesheet" href="https://assets-cdn.github.com/assets/github-e6bb18b320358b77abe040d2eb46b547.css" />
  
  
  
  

  <meta name="viewport" content="width=device-width">
  
  <title>kelsoswebsite/GothamHTF-BookCondensed.otf at master · NatashaTheRobot/kelsoswebsite</title>
    <meta name="description" content="GitHub is where people build software. More than 28 million people use GitHub to discover, fork, and contribute to over 85 million projects.">
    <link rel="search" type="application/opensearchdescription+xml" href="/opensearch.xml" title="GitHub">
  <link rel="fluid-icon" href="https://github.com/fluidicon.png" title="GitHub">
  <meta property="fb:app_id" content="1401488693436528">

    
    <meta property="og:image" content="https://avatars1.githubusercontent.com/u/1157147?s=400&amp;v=4" /><meta property="og:site_name" content="GitHub" /><meta property="og:type" content="object" /><meta property="og:title" content="NatashaTheRobot/kelsoswebsite" /><meta property="og:url" content="https://github.com/NatashaTheRobot/kelsoswebsite" /><meta property="og:description" content="Contribute to kelsoswebsite development by creating an account on Github." />

  <link rel="assets" href="https://assets-cdn.github.com/">
  <link rel="web-socket" href="wss://live.github.com/_sockets/VjI6MjY4MDM4MjAxOmE3NGY2ZTU4YWEzMjY1ZTM1NTlhYWM0OGZhMzc3MDAyNTg0NDA1MjQxOGMzMDQxMDYwNjNjYTlmNDgxNmUxMGQ=--43060a1274d6c7b3cbe68d0aaacc37494c45f9fd">
  <meta name="pjax-timeout" content="1000">
  <link rel="sudo-modal" href="/sessions/sudo_modal">
  <meta name="request-id" content="CD90:4116:459C922:7E6350F:5B756E0B" data-pjax-transient>


  

  <meta name="selected-link" value="repo_source" data-pjax-transient>

    <meta name="google-site-verification" content="KT5gs8h0wvaagLKAVWq8bbeNwnZZK1r1XQysX3xurLU">
  <meta name="google-site-verification" content="ZzhVyEFwb7w3e0-uOTltm8Jsck2F5StVihD0exw2fsA">
  <meta name="google-site-verification" content="GXs5KoUUkNCoaAZn7wPN-t01Pywp9M3sEjnt_3_ZWPc">
    <meta name="google-analytics" content="UA-3769691-2">

<meta name="octolytics-host" content="collector.githubapp.com" /><meta name="octolytics-app-id" content="github" /><meta name="octolytics-event-url" content="https://collector.githubapp.com/github-external/browser_event" /><meta name="octolytics-dimension-request_id" content="CD90:4116:459C922:7E6350F:5B756E0B" /><meta name="octolytics-dimension-region_edge" content="iad" /><meta name="octolytics-dimension-region_render" content="iad" /><meta name="octolytics-actor-id" content="13610012" /><meta name="octolytics-actor-login" content="therewillbecode" /><meta name="octolytics-actor-hash" content="095fb9283e4ca607acaf1787e0f0b4528656454602bfea91ea2b04bed13dc891" />
<meta name="analytics-location" content="/&lt;user-name&gt;/&lt;repo-name&gt;/blob/show" data-pjax-transient="true" />



  <meta class="js-ga-set" name="userId" content="3bf10623e60ddb700ce45c195d27120d" %>

<meta class="js-ga-set" name="dimension1" content="Logged In">


  

      <meta name="hostname" content="github.com">
    <meta name="user-login" content="therewillbecode">

      <meta name="expected-hostname" content="github.com">
    <meta name="js-proxy-site-detection-payload" content="NThkN2Y0YzA0Njg5ZWRlYzkwN2MzMTZlZDFkMDFlNDVlYWI0YTY0ODNmMGY1ZWMzNGVlYmYxY2YyNDQ0MTIzNXx7InJlbW90ZV9hZGRyZXNzIjoiOTUuMTUxLjg0LjEwIiwicmVxdWVzdF9pZCI6IkNEOTA6NDExNjo0NTlDOTIyOjdFNjM1MEY6NUI3NTZFMEIiLCJ0aW1lc3RhbXAiOjE1MzQ0MjI1NDIsImhvc3QiOiJnaXRodWIuY29tIn0=">

    <meta name="enabled-features" content="DASHBOARD_V2_LAYOUT,DASHBOARD_V2_LAYOUT_OPT_IN,EXPLORE_DISCOVER_REPOSITORIES,UNIVERSE_BANNER,FREE_TRIALS,MARKETPLACE_INSIGHTS,MARKETPLACE_DOCKERFILE_CI_CTA,MARKETPLACE_PLAN_RESTRICTION_EDITOR,MARKETPLACE_SEARCH,MARKETPLACE_INSIGHTS_CONVERSION_PERCENTAGES,MARKETPLACE_RETARGETING">

  <meta name="html-safe-nonce" content="b8dfbd9d3a9229a41eca73ceb9de018c127caaac">

  <meta http-equiv="x-pjax-version" content="60e4fa41ffbcbd51f51925bcc7ea1d9f">
  

      <link href="https://github.com/NatashaTheRobot/kelsoswebsite/commits/master.atom" rel="alternate" title="Recent Commits to kelsoswebsite:master" type="application/atom+xml">

  <meta name="go-import" content="github.com/NatashaTheRobot/kelsoswebsite git https://github.com/NatashaTheRobot/kelsoswebsite.git">

  <meta name="octolytics-dimension-user_id" content="1157147" /><meta name="octolytics-dimension-user_login" content="NatashaTheRobot" /><meta name="octolytics-dimension-repository_id" content="6568626" /><meta name="octolytics-dimension-repository_nwo" content="NatashaTheRobot/kelsoswebsite" /><meta name="octolytics-dimension-repository_public" content="true" /><meta name="octolytics-dimension-repository_is_fork" content="false" /><meta name="octolytics-dimension-repository_network_root_id" content="6568626" /><meta name="octolytics-dimension-repository_network_root_nwo" content="NatashaTheRobot/kelsoswebsite" /><meta name="octolytics-dimension-repository_explore_github_marketplace_ci_cta_shown" content="false" />


    <link rel="canonical" href="https://github.com/NatashaTheRobot/kelsoswebsite/blob/master/public/assets/fonts/Gotham/GothamHTF-BookCondensed.otf" data-pjax-transient>


  <meta name="browser-stats-url" content="https://api.github.com/_private/browser/stats">

  <meta name="browser-errors-url" content="https://api.github.com/_private/browser/errors">

  <link rel="mask-icon" href="https://assets-cdn.github.com/pinned-octocat.svg" color="#000000">
  <link rel="icon" type="image/x-icon" class="js-site-favicon" href="https://assets-cdn.github.com/favicon.ico">

<meta name="theme-color" content="#1e2327">


  <meta name="u2f-support" content="true">

<link rel="manifest" href="/manifest.json" crossOrigin="use-credentials">

  </head>

  <body class="logged-in env-production page-blob">
    

  <div class="position-relative js-header-wrapper ">
    <a href="#start-of-content" tabindex="1" class="p-3 bg-blue text-white show-on-focus js-skip-to-content">Skip to content</a>
    <div id="js-pjax-loader-bar" class="pjax-loader-bar"><div class="progress"></div></div>

    
    
    



        
<header class="Header  f5" role="banner">
  <div class="d-flex flex-justify-between px-3 container-lg">
    <div class="d-flex flex-justify-between ">
      <div class="">
        <a class="header-logo-invertocat" href="https://github.com/" data-hotkey="g d" aria-label="Homepage" data-ga-click="Header, go to dashboard, icon:logo">
  <svg height="32" class="octicon octicon-mark-github" viewBox="0 0 16 16" version="1.1" width="32" aria-hidden="true"><path fill-rule="evenodd" d="M8 0C3.58 0 0 3.58 0 8c0 3.54 2.29 6.53 5.47 7.59.4.07.55-.17.55-.38 0-.19-.01-.82-.01-1.49-2.01.37-2.53-.49-2.69-.94-.09-.23-.48-.94-.82-1.13-.28-.15-.68-.52-.01-.53.63-.01 1.08.58 1.23.82.72 1.21 1.87.87 2.33.66.07-.52.28-.87.51-1.07-1.78-.2-3.64-.89-3.64-3.95 0-.87.31-1.59.82-2.15-.08-.2-.36-1.02.08-2.12 0 0 .67-.21 2.2.82.64-.18 1.32-.27 2-.27.68 0 1.36.09 2 .27 1.53-1.04 2.2-.82 2.2-.82.44 1.1.16 1.92.08 2.12.51.56.82 1.27.82 2.15 0 3.07-1.87 3.75-3.65 3.95.29.25.54.73.54 1.48 0 1.07-.01 1.93-.01 2.2 0 .21.15.46.55.38A8.013 8.013 0 0 0 16 8c0-4.42-3.58-8-8-8z"/></svg>
</a>

      </div>

    </div>

    <div class="HeaderMenu d-flex flex-justify-between flex-auto">
      <div class="d-flex">
            <div class="">
              <div class="header-search scoped-search site-scoped-search js-site-search position-relative js-jump-to"
  role="search combobox"
  aria-owns="jump-to-results"
  aria-label="Search or jump to"
  aria-haspopup="listbox"
  aria-expanded="true"
>
  <div class="position-relative">
    <!-- '"` --><!-- </textarea></xmp> --></option></form><form class="js-site-search-form" data-scope-type="Repository" data-scope-id="6568626" data-scoped-search-url="/NatashaTheRobot/kelsoswebsite/search" data-unscoped-search-url="/search" action="/NatashaTheRobot/kelsoswebsite/search" accept-charset="UTF-8" method="get"><input name="utf8" type="hidden" value="&#x2713;" />
      <label class="form-control header-search-wrapper header-search-wrapper-jump-to position-relative d-flex flex-justify-between flex-items-center js-chromeless-input-container">
        <input type="text"
          class="form-control header-search-input jump-to-field js-jump-to-field js-site-search-focus js-site-search-field is-clearable"
          data-hotkey="s,/"
          name="q"
          value=""
          placeholder="Search or jump to…"
          data-unscoped-placeholder="Search or jump to…"
          data-scoped-placeholder="Search or jump to…"
          autocapitalize="off"
          aria-autocomplete="list"
          aria-controls="jump-to-results"
          data-jump-to-suggestions-path="/_graphql/GetSuggestedNavigationDestinations#csrf-token=fugzxIjE9QzlcLUTJKU+RU4wyHm8mEVK+sRELVe8s/vgsdm1BiGexqQb9gz2Ghu8MUeQ9Ss/+boFOZYNfiSR1w=="
          spellcheck="false"
          autocomplete="off"
          >
          <input type="hidden" class="js-site-search-type-field" name="type" >
            <img src="https://assets-cdn.github.com/images/search-shortcut-hint.svg" alt="" class="mr-2 header-search-key-slash">

            <div class="Box position-absolute overflow-hidden d-none jump-to-suggestions js-jump-to-suggestions-container">
              <ul class="d-none js-jump-to-suggestions-template-container">
                <li class="d-flex flex-justify-start flex-items-center p-0 f5 navigation-item js-navigation-item">
                  <a tabindex="-1" class="no-underline d-flex flex-auto flex-items-center p-2 jump-to-suggestions-path js-jump-to-suggestion-path js-navigation-open" href="">
                    <div class="jump-to-octicon js-jump-to-octicon mr-2 text-center d-none"></div>
                    <img class="avatar mr-2 flex-shrink-0 js-jump-to-suggestion-avatar" alt="" aria-label="Team" src="" width="28" height="28">

                    <div class="jump-to-suggestion-name js-jump-to-suggestion-name flex-auto overflow-hidden text-left no-wrap css-truncate css-truncate-target">
                    </div>

                    <div class="border rounded-1 flex-shrink-0 bg-gray px-1 text-gray-light ml-1 f6 d-none js-jump-to-badge-search">
                      <span class="js-jump-to-badge-search-text-default d-none" aria-label="in this repository">
                        In this repository
                      </span>
                      <span class="js-jump-to-badge-search-text-global d-none" aria-label="in all of GitHub">
                        All GitHub
                      </span>
                      <span aria-hidden="true" class="d-inline-block ml-1 v-align-middle">↵</span>
                    </div>

                    <div aria-hidden="true" class="border rounded-1 flex-shrink-0 bg-gray px-1 text-gray-light ml-1 f6 d-none d-on-nav-focus js-jump-to-badge-jump">
                      Jump to
                      <span class="d-inline-block ml-1 v-align-middle">↵</span>
                    </div>
                  </a>
                </li>
                <svg height="16" width="16" class="octicon octicon-repo flex-shrink-0 js-jump-to-repo-octicon-template" title="Repository" aria-label="Repository" viewBox="0 0 12 16" version="1.1" role="img"><path fill-rule="evenodd" d="M4 9H3V8h1v1zm0-3H3v1h1V6zm0-2H3v1h1V4zm0-2H3v1h1V2zm8-1v12c0 .55-.45 1-1 1H6v2l-1.5-1.5L3 16v-2H1c-.55 0-1-.45-1-1V1c0-.55.45-1 1-1h10c.55 0 1 .45 1 1zm-1 10H1v2h2v-1h3v1h5v-2zm0-10H2v9h9V1z"/></svg>
                <svg height="16" width="16" class="octicon octicon-project flex-shrink-0 js-jump-to-project-octicon-template" title="Project" aria-label="Project" viewBox="0 0 15 16" version="1.1" role="img"><path fill-rule="evenodd" d="M10 12h3V2h-3v10zm-4-2h3V2H6v8zm-4 4h3V2H2v12zm-1 1h13V1H1v14zM14 0H1a1 1 0 0 0-1 1v14a1 1 0 0 0 1 1h13a1 1 0 0 0 1-1V1a1 1 0 0 0-1-1z"/></svg>
                <svg height="16" width="16" class="octicon octicon-search flex-shrink-0 js-jump-to-search-octicon-template" title="Search" aria-label="Search" viewBox="0 0 16 16" version="1.1" role="img"><path fill-rule="evenodd" d="M15.7 13.3l-3.81-3.83A5.93 5.93 0 0 0 13 6c0-3.31-2.69-6-6-6S1 2.69 1 6s2.69 6 6 6c1.3 0 2.48-.41 3.47-1.11l3.83 3.81c.19.2.45.3.7.3.25 0 .52-.09.7-.3a.996.996 0 0 0 0-1.41v.01zM7 10.7c-2.59 0-4.7-2.11-4.7-4.7 0-2.59 2.11-4.7 4.7-4.7 2.59 0 4.7 2.11 4.7 4.7 0 2.59-2.11 4.7-4.7 4.7z"/></svg>
              </ul>
              <ul class="d-none js-jump-to-no-results-template-container">
                <li class="d-flex flex-justify-center flex-items-center p-3 f5 d-none">
                  <span class="text-gray">No suggested jump to results</span>
                </li>
              </ul>

              <ul id="jump-to-results" class="js-navigation-container jump-to-suggestions-results-container js-jump-to-suggestions-results-container" >
                <li class="d-flex flex-justify-center flex-items-center p-0 f5">
                  <img src="https://assets-cdn.github.com/images/spinners/octocat-spinner-128.gif" alt="Octocat Spinner Icon" class="m-2" width="28">
                </li>
              </ul>
            </div>
      </label>
</form>  </div>
</div>

            </div>

          <ul class="d-flex pl-2 flex-items-center text-bold list-style-none" role="navigation">
            <li>
              <a class="js-selected-navigation-item HeaderNavlink px-2" data-hotkey="g p" data-ga-click="Header, click, Nav menu - item:pulls context:user" aria-label="Pull requests you created" data-selected-links="/pulls /pulls/assigned /pulls/mentioned /pulls" href="/pulls">
                Pull requests
</a>            </li>
            <li>
              <a class="js-selected-navigation-item HeaderNavlink px-2" data-hotkey="g i" data-ga-click="Header, click, Nav menu - item:issues context:user" aria-label="Issues you created" data-selected-links="/issues /issues/assigned /issues/mentioned /issues" href="/issues">
                Issues
</a>            </li>
              <li>
                <a class="js-selected-navigation-item HeaderNavlink px-2" data-ga-click="Header, click, Nav menu - item:marketplace context:user" data-octo-click="marketplace_click" data-octo-dimensions="location:nav_bar" data-selected-links=" /marketplace" href="/marketplace">
                   Marketplace
</a>              </li>
            <li>
              <a class="js-selected-navigation-item HeaderNavlink px-2" data-ga-click="Header, click, Nav menu - item:explore" data-selected-links="/explore /trending /trending/developers /integrations /integrations/feature/code /integrations/feature/collaborate /integrations/feature/ship showcases showcases_search showcases_landing /explore" href="/explore">
                Explore
</a>            </li>
          </ul>
      </div>

      <div class="d-flex">
        
<ul class="user-nav d-flex flex-items-center list-style-none" id="user-links">
  <li class="dropdown">
    <span class="d-inline-block  px-2">
      
    <a aria-label="You have unread notifications" class="notification-indicator tooltipped tooltipped-s  js-socket-channel js-notification-indicator" data-hotkey="g n" data-ga-click="Header, go to notifications, icon:unread" data-channel="notification-changed:13610012" href="/notifications">
        <span class="mail-status unread"></span>
        <svg class="octicon octicon-bell" viewBox="0 0 14 16" version="1.1" width="14" height="16" aria-hidden="true"><path fill-rule="evenodd" d="M13.99 11.991v1H0v-1l.73-.58c.769-.769.809-2.547 1.189-4.416.77-3.767 4.077-4.996 4.077-4.996 0-.55.45-1 .999-1 .55 0 1 .45 1 1 0 0 3.387 1.229 4.156 4.996.38 1.879.42 3.657 1.19 4.417l.659.58h-.01zM6.995 15.99c1.11 0 1.999-.89 1.999-1.999H4.996c0 1.11.89 1.999 1.999 1.999z"/></svg>
</a>
    </span>
  </li>

  <li class="dropdown">
    <details class="details-overlay details-reset d-flex px-2 flex-items-center">
      <summary class="HeaderNavlink"
         aria-label="Create new…"
         data-ga-click="Header, create new, icon:add">
        <svg class="octicon octicon-plus float-left mr-1 mt-1" viewBox="0 0 12 16" version="1.1" width="12" height="16" aria-hidden="true"><path fill-rule="evenodd" d="M12 9H7v5H5V9H0V7h5V2h2v5h5v2z"/></svg>
        <span class="dropdown-caret mt-1"></span>
      </summary>
      <details-menu class="dropdown-menu dropdown-menu-sw">
        
<a role="menuitem" class="dropdown-item" href="/new" data-ga-click="Header, create new repository">
  New repository
</a>

  <a role="menuitem" class="dropdown-item" href="/new/import" data-ga-click="Header, import a repository">
    Import repository
  </a>

<a role="menuitem" class="dropdown-item" href="https://gist.github.com/" data-ga-click="Header, create new gist">
  New gist
</a>

  <a role="menuitem" class="dropdown-item" href="/organizations/new" data-ga-click="Header, create new organization">
    New organization
  </a>


  <div class="dropdown-divider"></div>
  <div class="dropdown-header">
    <span title="NatashaTheRobot/kelsoswebsite">This repository</span>
  </div>
    <a role="menuitem" class="dropdown-item" href="/NatashaTheRobot/kelsoswebsite/issues/new" data-ga-click="Header, create new issue">
      New issue
    </a>

      </details-menu>
    </details>
  </li>

  <li class="dropdown">

    <details class="details-overlay details-reset d-flex pl-2 flex-items-center">
      <summary class="HeaderNavlink name mt-1"
        aria-label="View profile and more"
        data-ga-click="Header, show menu, icon:avatar">
        <img alt="@therewillbecode" class="avatar float-left mr-1" src="https://avatars1.githubusercontent.com/u/13610012?s=40&amp;v=4" height="20" width="20">
        <span class="dropdown-caret"></span>
      </summary>
      <details-menu class="dropdown-menu dropdown-menu-sw">
        <ul>
          <li class="header-nav-current-user css-truncate"><a role="menuitem" class="no-underline user-profile-link px-3 pt-2 pb-2 mb-n2 mt-n1 d-block" href="/therewillbecode" data-ga-click="Header, go to profile, text:Signed in as">Signed in as <strong class="css-truncate-target">therewillbecode</strong></a></li>
          <li class="dropdown-divider"></li>
          <li><a role="menuitem" class="dropdown-item" href="/therewillbecode" data-ga-click="Header, go to profile, text:your profile">Your profile</a></li>
          <li><a role="menuitem" class="dropdown-item" href="/therewillbecode?tab=repositories" data-ga-click="Header, go to repositories, text:your repositories">Your repositories</a></li>
          <li><a role="menuitem" class="dropdown-item" href="/therewillbecode?tab=stars" data-ga-click="Header, go to starred repos, text:your stars">Your stars</a></li>
            <li><a role="menuitem" class="dropdown-item" href="https://gist.github.com/" data-ga-click="Header, your gists, text:your gists">Your gists</a></li>
          <li class="dropdown-divider"></li>
          <li><a role="menuitem" class="dropdown-item" href="https://help.github.com" data-ga-click="Header, go to help, text:help">Help</a></li>
          <li><a role="menuitem" class="dropdown-item" href="/settings/profile" data-ga-click="Header, go to settings, icon:settings">Settings</a></li>
          <li>
            <!-- '"` --><!-- </textarea></xmp> --></option></form><form class="logout-form" action="/logout" accept-charset="UTF-8" method="post"><input name="utf8" type="hidden" value="&#x2713;" /><input type="hidden" name="authenticity_token" value="CFVUUYt0GAnKF5OwDXaRogwFDcI2aBhtTdF2AqoEa0W3T6AfJVMIX383BbZ08oZCAzTcR+Au9tEN2WrsYuyqJA==" />
              <button type="submit" class="dropdown-item dropdown-signout" data-ga-click="Header, sign out, icon:logout" role="menuitem">
                Sign out
              </button>
</form>          </li>
        </ul>
      </details-menu>
    </details>
  </li>
</ul>



        <!-- '"` --><!-- </textarea></xmp> --></option></form><form class="sr-only right-0" action="/logout" accept-charset="UTF-8" method="post"><input name="utf8" type="hidden" value="&#x2713;" /><input type="hidden" name="authenticity_token" value="qtODRutXu2nmdW8B3UbDc+na00lv/kGuetgYbk2NMRsVyXcIRXCrP1NV+QekwtST5usCzLm4rxI60ASAhWXweg==" />
          <button type="submit" class="dropdown-item dropdown-signout" data-ga-click="Header, sign out, icon:logout">
            Sign out
          </button>
</form>      </div>
    </div>
  </div>
</header>

      

  </div>

  <div id="start-of-content" class="show-on-focus"></div>

    <div id="js-flash-container">


</div>



  <div role="main" class="application-main ">
        <div itemscope itemtype="http://schema.org/SoftwareSourceCode" class="">
    <div id="js-repo-pjax-container" data-pjax-container >
      







  <div class="pagehead repohead instapaper_ignore readability-menu experiment-repo-nav  ">
    <div class="repohead-details-container clearfix container">

      <ul class="pagehead-actions">
  <li>
        <!-- '"` --><!-- </textarea></xmp> --></option></form><form data-autosubmit="true" data-remote="true" class="js-social-container" action="/notifications/subscribe" accept-charset="UTF-8" method="post"><input name="utf8" type="hidden" value="&#x2713;" /><input type="hidden" name="authenticity_token" value="CJ/EGIn9sp48FPPhcMLlkMo8psdTqWcAQfVqi5nkoHBxiAiDTtmfk705KhTAiCYsr8/kR3yiF6WugeFsDpNwQA==" />      <input type="hidden" name="repository_id" id="repository_id" value="6568626" class="form-control" />

        <div class="select-menu js-menu-container js-select-menu">
          <a href="/NatashaTheRobot/kelsoswebsite/subscription"
            class="btn btn-sm btn-with-count select-menu-button js-menu-target"
            role="button"
            aria-haspopup="true"
            aria-expanded="false"
            aria-label="Toggle repository notifications menu"
            data-ga-click="Repository, click Watch settings, action:blob#show">
            <span class="js-select-button">
                <svg class="octicon octicon-eye v-align-text-bottom" viewBox="0 0 16 16" version="1.1" width="16" height="16" aria-hidden="true"><path fill-rule="evenodd" d="M8.06 2C3 2 0 8 0 8s3 6 8.06 6C13 14 16 8 16 8s-3-6-7.94-6zM8 12c-2.2 0-4-1.78-4-4 0-2.2 1.8-4 4-4 2.22 0 4 1.8 4 4 0 2.22-1.78 4-4 4zm2-4c0 1.11-.89 2-2 2-1.11 0-2-.89-2-2 0-1.11.89-2 2-2 1.11 0 2 .89 2 2z"/></svg>
                Watch
            </span>
          </a>
          <a class="social-count js-social-count"
            href="/NatashaTheRobot/kelsoswebsite/watchers"
            aria-label="3 users are watching this repository">
            3
          </a>

        <div class="select-menu-modal-holder">
          <div class="select-menu-modal subscription-menu-modal js-menu-content">
            <div class="select-menu-header js-navigation-enable" tabindex="-1">
              <svg class="octicon octicon-x js-menu-close" role="img" aria-label="Close" viewBox="0 0 12 16" version="1.1" width="12" height="16"><path fill-rule="evenodd" d="M7.48 8l3.75 3.75-1.48 1.48L6 9.48l-3.75 3.75-1.48-1.48L4.52 8 .77 4.25l1.48-1.48L6 6.52l3.75-3.75 1.48 1.48L7.48 8z"/></svg>
              <span class="select-menu-title">Notifications</span>
            </div>

              <div class="select-menu-list js-navigation-container" role="menu">

                <div class="select-menu-item js-navigation-item selected" role="menuitem" tabindex="0">
                  <svg class="octicon octicon-check select-menu-item-icon" viewBox="0 0 12 16" version="1.1" width="12" height="16" aria-hidden="true"><path fill-rule="evenodd" d="M12 5l-8 8-4-4 1.5-1.5L4 10l6.5-6.5L12 5z"/></svg>
                  <div class="select-menu-item-text">
                    <input type="radio" name="do" id="do_included" value="included" checked="checked" />
                    <span class="select-menu-item-heading">Not watching</span>
                    <span class="description">Be notified when participating or @mentioned.</span>
                    <span class="js-select-button-text hidden-select-button-text">
                      <svg class="octicon octicon-eye v-align-text-bottom" viewBox="0 0 16 16" version="1.1" width="16" height="16" aria-hidden="true"><path fill-rule="evenodd" d="M8.06 2C3 2 0 8 0 8s3 6 8.06 6C13 14 16 8 16 8s-3-6-7.94-6zM8 12c-2.2 0-4-1.78-4-4 0-2.2 1.8-4 4-4 2.22 0 4 1.8 4 4 0 2.22-1.78 4-4 4zm2-4c0 1.11-.89 2-2 2-1.11 0-2-.89-2-2 0-1.11.89-2 2-2 1.11 0 2 .89 2 2z"/></svg>
                      Watch
                    </span>
                  </div>
                </div>

                <div class="select-menu-item js-navigation-item " role="menuitem" tabindex="0">
                  <svg class="octicon octicon-check select-menu-item-icon" viewBox="0 0 12 16" version="1.1" width="12" height="16" aria-hidden="true"><path fill-rule="evenodd" d="M12 5l-8 8-4-4 1.5-1.5L4 10l6.5-6.5L12 5z"/></svg>
                  <div class="select-menu-item-text">
                    <input type="radio" name="do" id="do_subscribed" value="subscribed" />
                    <span class="select-menu-item-heading">Watching</span>
                    <span class="description">Be notified of all conversations.</span>
                    <span class="js-select-button-text hidden-select-button-text">
                      <svg class="octicon octicon-eye v-align-text-bottom" viewBox="0 0 16 16" version="1.1" width="16" height="16" aria-hidden="true"><path fill-rule="evenodd" d="M8.06 2C3 2 0 8 0 8s3 6 8.06 6C13 14 16 8 16 8s-3-6-7.94-6zM8 12c-2.2 0-4-1.78-4-4 0-2.2 1.8-4 4-4 2.22 0 4 1.8 4 4 0 2.22-1.78 4-4 4zm2-4c0 1.11-.89 2-2 2-1.11 0-2-.89-2-2 0-1.11.89-2 2-2 1.11 0 2 .89 2 2z"/></svg>
                        Unwatch
                    </span>
                  </div>
                </div>

                <div class="select-menu-item js-navigation-item " role="menuitem" tabindex="0">
                  <svg class="octicon octicon-check select-menu-item-icon" viewBox="0 0 12 16" version="1.1" width="12" height="16" aria-hidden="true"><path fill-rule="evenodd" d="M12 5l-8 8-4-4 1.5-1.5L4 10l6.5-6.5L12 5z"/></svg>
                  <div class="select-menu-item-text">
                    <input type="radio" name="do" id="do_ignore" value="ignore" />
                    <span class="select-menu-item-heading">Ignoring</span>
                    <span class="description">Never be notified.</span>
                    <span class="js-select-button-text hidden-select-button-text">
                      <svg class="octicon octicon-mute v-align-text-bottom" viewBox="0 0 16 16" version="1.1" width="16" height="16" aria-hidden="true"><path fill-rule="evenodd" d="M8 2.81v10.38c0 .67-.81 1-1.28.53L3 10H1c-.55 0-1-.45-1-1V7c0-.55.45-1 1-1h2l3.72-3.72C7.19 1.81 8 2.14 8 2.81zm7.53 3.22l-1.06-1.06-1.97 1.97-1.97-1.97-1.06 1.06L11.44 8 9.47 9.97l1.06 1.06 1.97-1.97 1.97 1.97 1.06-1.06L13.56 8l1.97-1.97z"/></svg>
                        Stop ignoring
                    </span>
                  </div>
                </div>

              </div>

            </div>
          </div>
        </div>
</form>
  </li>

  <li>
    
  <div class="js-toggler-container js-social-container starring-container ">
    <!-- '"` --><!-- </textarea></xmp> --></option></form><form class="starred js-social-form" action="/NatashaTheRobot/kelsoswebsite/unstar" accept-charset="UTF-8" method="post"><input name="utf8" type="hidden" value="&#x2713;" /><input type="hidden" name="authenticity_token" value="Oxdz6HsLejdHSJhDV8MT4nm22+Aaxp8fudKzQHGgvWFQ5XijIhKCcGoArCBK3quTXlcegVB2NtsSU5Ji8Bci9Q==" />
      <input type="hidden" name="context" value="repository"></input>
      <button
        type="submit"
        class="btn btn-sm btn-with-count js-toggler-target"
        aria-label="Unstar this repository" title="Unstar NatashaTheRobot/kelsoswebsite"
        data-ga-click="Repository, click unstar button, action:blob#show; text:Unstar">
        <svg class="octicon octicon-star v-align-text-bottom" viewBox="0 0 14 16" version="1.1" width="14" height="16" aria-hidden="true"><path fill-rule="evenodd" d="M14 6l-4.9-.64L7 1 4.9 5.36 0 6l3.6 3.26L2.67 14 7 11.67 11.33 14l-.93-4.74L14 6z"/></svg>
        Unstar
      </button>
        <a class="social-count js-social-count" href="/NatashaTheRobot/kelsoswebsite/stargazers"
           aria-label="9 users starred this repository">
          9
        </a>
</form>
    <!-- '"` --><!-- </textarea></xmp> --></option></form><form class="unstarred js-social-form" action="/NatashaTheRobot/kelsoswebsite/star" accept-charset="UTF-8" method="post"><input name="utf8" type="hidden" value="&#x2713;" /><input type="hidden" name="authenticity_token" value="JL5pfIpQY7pD010QdC7ubZDKPro3M648omMCnC51CsOQbqzGSt1h/T3+Yh5+XMPcq8PTFqhCGu0OO9kyy3TUvQ==" />
      <input type="hidden" name="context" value="repository"></input>
      <button
        type="submit"
        class="btn btn-sm btn-with-count js-toggler-target"
        aria-label="Star this repository" title="Star NatashaTheRobot/kelsoswebsite"
        data-ga-click="Repository, click star button, action:blob#show; text:Star">
        <svg class="octicon octicon-star v-align-text-bottom" viewBox="0 0 14 16" version="1.1" width="14" height="16" aria-hidden="true"><path fill-rule="evenodd" d="M14 6l-4.9-.64L7 1 4.9 5.36 0 6l3.6 3.26L2.67 14 7 11.67 11.33 14l-.93-4.74L14 6z"/></svg>
        Star
      </button>
        <a class="social-count js-social-count" href="/NatashaTheRobot/kelsoswebsite/stargazers"
           aria-label="9 users starred this repository">
          9
        </a>
</form>  </div>

  </li>

  <li>
          <details class="details-reset details-overlay details-overlay-dark d-inline-block float-left"
            data-deferred-details-content-url="/NatashaTheRobot/kelsoswebsite/fork?fragment=1">
            <summary class="btn btn-sm btn-with-count"
              title="Fork your own copy of NatashaTheRobot/kelsoswebsite to your account"
              data-ga-click="Repository, show fork modal, action:blob#show; text:Fork">
              <svg class="octicon octicon-repo-forked v-align-text-bottom" viewBox="0 0 10 16" version="1.1" width="10" height="16" aria-hidden="true"><path fill-rule="evenodd" d="M8 1a1.993 1.993 0 0 0-1 3.72V6L5 8 3 6V4.72A1.993 1.993 0 0 0 2 1a1.993 1.993 0 0 0-1 3.72V6.5l3 3v1.78A1.993 1.993 0 0 0 5 15a1.993 1.993 0 0 0 1-3.72V9.5l3-3V4.72A1.993 1.993 0 0 0 8 1zM2 4.2C1.34 4.2.8 3.65.8 3c0-.65.55-1.2 1.2-1.2.65 0 1.2.55 1.2 1.2 0 .65-.55 1.2-1.2 1.2zm3 10c-.66 0-1.2-.55-1.2-1.2 0-.65.55-1.2 1.2-1.2.65 0 1.2.55 1.2 1.2 0 .65-.55 1.2-1.2 1.2zm3-10c-.66 0-1.2-.55-1.2-1.2 0-.65.55-1.2 1.2-1.2.65 0 1.2.55 1.2 1.2 0 .65-.55 1.2-1.2 1.2z"/></svg>
              Fork
            </summary>
            <details-dialog class="anim-fade-in fast Box Box--overlay d-flex flex-column">
              <div class="Box-header">
                <button class="Box-btn-octicon btn-octicon float-right" type="button" aria-label="Close dialog" data-close-dialog>
                  <svg class="octicon octicon-x" viewBox="0 0 12 16" version="1.1" width="12" height="16" aria-hidden="true"><path fill-rule="evenodd" d="M7.48 8l3.75 3.75-1.48 1.48L6 9.48l-3.75 3.75-1.48-1.48L4.52 8 .77 4.25l1.48-1.48L6 6.52l3.75-3.75 1.48 1.48L7.48 8z"/></svg>
                </button>
                <h3 class="Box-title">Where should we fork this repository?</h3>
              </div>
              <div class="Box-body overflow-auto text-center">
                <include-fragment>
                  <div class="octocat-spinner my-3" aria-label="Loading..."></div>
                  <p class="f5 text-gray">If this dialog fails to load, you can visit <a href="/NatashaTheRobot/kelsoswebsite/fork">the fork page</a> directly.</p>
                </include-fragment>
              </div>
            </details-dialog>
          </details>

    <a href="/NatashaTheRobot/kelsoswebsite/network/members" class="social-count"
       aria-label="51 users forked this repository">
      51
    </a>
  </li>
</ul>

      <h1 class="public ">
  <svg class="octicon octicon-repo" viewBox="0 0 12 16" version="1.1" width="12" height="16" aria-hidden="true"><path fill-rule="evenodd" d="M4 9H3V8h1v1zm0-3H3v1h1V6zm0-2H3v1h1V4zm0-2H3v1h1V2zm8-1v12c0 .55-.45 1-1 1H6v2l-1.5-1.5L3 16v-2H1c-.55 0-1-.45-1-1V1c0-.55.45-1 1-1h10c.55 0 1 .45 1 1zm-1 10H1v2h2v-1h3v1h5v-2zm0-10H2v9h9V1z"/></svg>
  <span class="author" itemprop="author"><a class="url fn" rel="author" href="/NatashaTheRobot">NatashaTheRobot</a></span><!--
--><span class="path-divider">/</span><!--
--><strong itemprop="name"><a data-pjax="#js-repo-pjax-container" href="/NatashaTheRobot/kelsoswebsite">kelsoswebsite</a></strong>

</h1>

    </div>
    
<nav class="reponav js-repo-nav js-sidenav-container-pjax container"
     itemscope
     itemtype="http://schema.org/BreadcrumbList"
     role="navigation"
     data-pjax="#js-repo-pjax-container">

  <span itemscope itemtype="http://schema.org/ListItem" itemprop="itemListElement">
    <a class="js-selected-navigation-item selected reponav-item" itemprop="url" data-hotkey="g c" data-selected-links="repo_source repo_downloads repo_commits repo_releases repo_tags repo_branches repo_packages /NatashaTheRobot/kelsoswebsite" href="/NatashaTheRobot/kelsoswebsite">
      <svg class="octicon octicon-code" viewBox="0 0 14 16" version="1.1" width="14" height="16" aria-hidden="true"><path fill-rule="evenodd" d="M9.5 3L8 4.5 11.5 8 8 11.5 9.5 13 14 8 9.5 3zm-5 0L0 8l4.5 5L6 11.5 2.5 8 6 4.5 4.5 3z"/></svg>
      <span itemprop="name">Code</span>
      <meta itemprop="position" content="1">
</a>  </span>

    <span itemscope itemtype="http://schema.org/ListItem" itemprop="itemListElement">
      <a itemprop="url" data-hotkey="g i" class="js-selected-navigation-item reponav-item" data-selected-links="repo_issues repo_labels repo_milestones /NatashaTheRobot/kelsoswebsite/issues" href="/NatashaTheRobot/kelsoswebsite/issues">
        <svg class="octicon octicon-issue-opened" viewBox="0 0 14 16" version="1.1" width="14" height="16" aria-hidden="true"><path fill-rule="evenodd" d="M7 2.3c3.14 0 5.7 2.56 5.7 5.7s-2.56 5.7-5.7 5.7A5.71 5.71 0 0 1 1.3 8c0-3.14 2.56-5.7 5.7-5.7zM7 1C3.14 1 0 4.14 0 8s3.14 7 7 7 7-3.14 7-7-3.14-7-7-7zm1 3H6v5h2V4zm0 6H6v2h2v-2z"/></svg>
        <span itemprop="name">Issues</span>
        <span class="Counter">1</span>
        <meta itemprop="position" content="2">
</a>    </span>

  <span itemscope itemtype="http://schema.org/ListItem" itemprop="itemListElement">
    <a data-hotkey="g p" itemprop="url" class="js-selected-navigation-item reponav-item" data-selected-links="repo_pulls checks /NatashaTheRobot/kelsoswebsite/pulls" href="/NatashaTheRobot/kelsoswebsite/pulls">
      <svg class="octicon octicon-git-pull-request" viewBox="0 0 12 16" version="1.1" width="12" height="16" aria-hidden="true"><path fill-rule="evenodd" d="M11 11.28V5c-.03-.78-.34-1.47-.94-2.06C9.46 2.35 8.78 2.03 8 2H7V0L4 3l3 3V4h1c.27.02.48.11.69.31.21.2.3.42.31.69v6.28A1.993 1.993 0 0 0 10 15a1.993 1.993 0 0 0 1-3.72zm-1 2.92c-.66 0-1.2-.55-1.2-1.2 0-.65.55-1.2 1.2-1.2.65 0 1.2.55 1.2 1.2 0 .65-.55 1.2-1.2 1.2zM4 3c0-1.11-.89-2-2-2a1.993 1.993 0 0 0-1 3.72v6.56A1.993 1.993 0 0 0 2 15a1.993 1.993 0 0 0 1-3.72V4.72c.59-.34 1-.98 1-1.72zm-.8 10c0 .66-.55 1.2-1.2 1.2-.65 0-1.2-.55-1.2-1.2 0-.65.55-1.2 1.2-1.2.65 0 1.2.55 1.2 1.2zM2 4.2C1.34 4.2.8 3.65.8 3c0-.65.55-1.2 1.2-1.2.65 0 1.2.55 1.2 1.2 0 .65-.55 1.2-1.2 1.2z"/></svg>
      <span itemprop="name">Pull requests</span>
      <span class="Counter">1</span>
      <meta itemprop="position" content="3">
</a>  </span>

    <a data-hotkey="g b" class="js-selected-navigation-item reponav-item" data-selected-links="repo_projects new_repo_project repo_project /NatashaTheRobot/kelsoswebsite/projects" href="/NatashaTheRobot/kelsoswebsite/projects">
      <svg class="octicon octicon-project" viewBox="0 0 15 16" version="1.1" width="15" height="16" aria-hidden="true"><path fill-rule="evenodd" d="M10 12h3V2h-3v10zm-4-2h3V2H6v8zm-4 4h3V2H2v12zm-1 1h13V1H1v14zM14 0H1a1 1 0 0 0-1 1v14a1 1 0 0 0 1 1h13a1 1 0 0 0 1-1V1a1 1 0 0 0-1-1z"/></svg>
      Projects
      <span class="Counter" >0</span>
</a>

    <a class="js-selected-navigation-item reponav-item" data-hotkey="g w" data-selected-links="repo_wiki /NatashaTheRobot/kelsoswebsite/wiki" href="/NatashaTheRobot/kelsoswebsite/wiki">
      <svg class="octicon octicon-book" viewBox="0 0 16 16" version="1.1" width="16" height="16" aria-hidden="true"><path fill-rule="evenodd" d="M3 5h4v1H3V5zm0 3h4V7H3v1zm0 2h4V9H3v1zm11-5h-4v1h4V5zm0 2h-4v1h4V7zm0 2h-4v1h4V9zm2-6v9c0 .55-.45 1-1 1H9.5l-1 1-1-1H2c-.55 0-1-.45-1-1V3c0-.55.45-1 1-1h5.5l1 1 1-1H15c.55 0 1 .45 1 1zm-8 .5L7.5 3H2v9h6V3.5zm7-.5H9.5l-.5.5V12h6V3z"/></svg>
      Wiki
</a>

  <a class="js-selected-navigation-item reponav-item" data-selected-links="repo_graphs repo_contributors dependency_graph pulse /NatashaTheRobot/kelsoswebsite/pulse" href="/NatashaTheRobot/kelsoswebsite/pulse">
    <svg class="octicon octicon-graph" viewBox="0 0 16 16" version="1.1" width="16" height="16" aria-hidden="true"><path fill-rule="evenodd" d="M16 14v1H0V0h1v14h15zM5 13H3V8h2v5zm4 0H7V3h2v10zm4 0h-2V6h2v7z"/></svg>
    Insights
</a>

</nav>


  </div>

<div class="container new-discussion-timeline experiment-repo-nav  ">
  <div class="repository-content ">

    
  <a class="d-none js-permalink-shortcut" data-hotkey="y" href="/NatashaTheRobot/kelsoswebsite/blob/4058de68dd765f7dbdcd27227555d2029f47dd26/public/assets/fonts/Gotham/GothamHTF-BookCondensed.otf">Permalink</a>

  <!-- blob contrib key: blob_contributors:v21:253dca872f182ec8e0b273f345400e34 -->

  

  <div class="file-navigation">
    
<div class="select-menu branch-select-menu js-menu-container js-select-menu float-left">
  <button class=" btn btn-sm select-menu-button js-menu-target css-truncate" data-hotkey="w"
    
    type="button" aria-label="Switch branches or tags" aria-expanded="false" aria-haspopup="true">
      <i>Branch:</i>
      <span class="js-select-button css-truncate-target">master</span>
  </button>

  <div class="select-menu-modal-holder js-menu-content js-navigation-container" data-pjax>

    <div class="select-menu-modal">
      <div class="select-menu-header">
        <svg class="octicon octicon-x js-menu-close" role="img" aria-label="Close" viewBox="0 0 12 16" version="1.1" width="12" height="16"><path fill-rule="evenodd" d="M7.48 8l3.75 3.75-1.48 1.48L6 9.48l-3.75 3.75-1.48-1.48L4.52 8 .77 4.25l1.48-1.48L6 6.52l3.75-3.75 1.48 1.48L7.48 8z"/></svg>
        <span class="select-menu-title">Switch branches/tags</span>
      </div>

      <div class="select-menu-filters">
        <div class="select-menu-text-filter">
          <input type="text" aria-label="Filter branches/tags" id="context-commitish-filter-field" class="form-control js-filterable-field js-navigation-enable" placeholder="Filter branches/tags">
        </div>
        <div class="select-menu-tabs">
          <ul>
            <li class="select-menu-tab">
              <a href="#" data-tab-filter="branches" data-filter-placeholder="Filter branches/tags" class="js-select-menu-tab" role="tab">Branches</a>
            </li>
            <li class="select-menu-tab">
              <a href="#" data-tab-filter="tags" data-filter-placeholder="Find a tag…" class="js-select-menu-tab" role="tab">Tags</a>
            </li>
          </ul>
        </div>
      </div>

      <div class="select-menu-list select-menu-tab-bucket js-select-menu-tab-bucket" data-tab-filter="branches" role="menu">

        <div data-filterable-for="context-commitish-filter-field" data-filterable-type="substring">


            <a class="select-menu-item js-navigation-item js-navigation-open selected"
               href="/NatashaTheRobot/kelsoswebsite/blob/master/public/assets/fonts/Gotham/GothamHTF-BookCondensed.otf"
               data-name="master"
               data-skip-pjax="true"
               rel="nofollow">
              <svg class="octicon octicon-check select-menu-item-icon" viewBox="0 0 12 16" version="1.1" width="12" height="16" aria-hidden="true"><path fill-rule="evenodd" d="M12 5l-8 8-4-4 1.5-1.5L4 10l6.5-6.5L12 5z"/></svg>
              <span class="select-menu-item-text css-truncate-target js-select-menu-filter-text">
                master
              </span>
            </a>
        </div>

          <div class="select-menu-no-results">Nothing to show</div>
      </div>

      <div class="select-menu-list select-menu-tab-bucket js-select-menu-tab-bucket" data-tab-filter="tags">
        <div data-filterable-for="context-commitish-filter-field" data-filterable-type="substring">


        </div>

        <div class="select-menu-no-results">Nothing to show</div>
      </div>

    </div>
  </div>
</div>

    <div class="BtnGroup float-right">
      <a href="/NatashaTheRobot/kelsoswebsite/find/master"
            class="js-pjax-capture-input btn btn-sm BtnGroup-item"
            data-pjax
            data-hotkey="t">
        Find file
      </a>
      <clipboard-copy for="blob-path" class="btn btn-sm BtnGroup-item">
        Copy path
      </clipboard-copy>
    </div>
    <div id="blob-path" class="breadcrumb">
      <span class="repo-root js-repo-root"><span class="js-path-segment"><a data-pjax="true" href="/NatashaTheRobot/kelsoswebsite"><span>kelsoswebsite</span></a></span></span><span class="separator">/</span><span class="js-path-segment"><a data-pjax="true" href="/NatashaTheRobot/kelsoswebsite/tree/master/public"><span>public</span></a></span><span class="separator">/</span><span class="js-path-segment"><a data-pjax="true" href="/NatashaTheRobot/kelsoswebsite/tree/master/public/assets"><span>assets</span></a></span><span class="separator">/</span><span class="js-path-segment"><a data-pjax="true" href="/NatashaTheRobot/kelsoswebsite/tree/master/public/assets/fonts"><span>fonts</span></a></span><span class="separator">/</span><span class="js-path-segment"><a data-pjax="true" href="/NatashaTheRobot/kelsoswebsite/tree/master/public/assets/fonts/Gotham"><span>Gotham</span></a></span><span class="separator">/</span><strong class="final-path">GothamHTF-BookCondensed.otf</strong>
    </div>
  </div>


  
  <div class="commit-tease">
      <span class="float-right">
        <a class="commit-tease-sha" href="/NatashaTheRobot/kelsoswebsite/commit/efc87b11815027969c5030a9c8b1f90232a964f4" data-pjax>
          efc87b1
        </a>
        <relative-time datetime="2012-11-06T20:09:47Z">Nov 6, 2012</relative-time>
      </span>
      <div>
        <a rel="author" data-skip-pjax="true" data-hovercard-user-id="1157147" data-octo-click="hovercard-link-click" data-octo-dimensions="link_type:self" href="/NatashaTheRobot"><img class="avatar" src="https://avatars0.githubusercontent.com/u/1157147?s=40&amp;v=4" width="20" height="20" alt="@NatashaTheRobot" /></a>
        <a class="user-mention" rel="author" data-hovercard-user-id="1157147" data-octo-click="hovercard-link-click" data-octo-dimensions="link_type:self" href="/NatashaTheRobot">NatashaTheRobot</a>
          <a data-pjax="true" title="created kelso kennedy&#39;s website" class="message" href="/NatashaTheRobot/kelsoswebsite/commit/efc87b11815027969c5030a9c8b1f90232a964f4">created kelso kennedy's website</a>
      </div>

    <div class="commit-tease-contributors">
      
<details class="details-reset details-overlay details-overlay-dark lh-default text-gray-dark float-left mr-2" id="blob_contributors_box">
  <summary class="btn-link" aria-haspopup="dialog" >
    
    <span><strong>1</strong> contributor</span>
  </summary>
  <details-dialog class="Box Box--overlay d-flex flex-column anim-fade-in fast " aria-label="Users who have contributed to this file">
    <div class="Box-header">
      <button class="Box-btn-octicon btn-octicon float-right" type="button" aria-label="Close dialog" data-close-dialog>
        <svg class="octicon octicon-x" viewBox="0 0 12 16" version="1.1" width="12" height="16" aria-hidden="true"><path fill-rule="evenodd" d="M7.48 8l3.75 3.75-1.48 1.48L6 9.48l-3.75 3.75-1.48-1.48L4.52 8 .77 4.25l1.48-1.48L6 6.52l3.75-3.75 1.48 1.48L7.48 8z"/></svg>
      </button>
      <h3 class="Box-title">Users who have contributed to this file</h3>
    </div>
    
        <ul class="list-style-none overflow-auto">
            <li class="Box-row">
              <a class="link-gray-dark no-underline" href="/NatashaTheRobot">
                <img class="avatar mr-2" alt="" src="https://avatars0.githubusercontent.com/u/1157147?s=40&amp;v=4" width="20" height="20" />
                NatashaTheRobot
</a>            </li>
        </ul>

  </details-dialog>
</details>
      
    </div>
  </div>



  <div class="file">
    <div class="file-header">
  <div class="file-actions">

    <div class="BtnGroup">
      <a id="raw-url" class="btn btn-sm BtnGroup-item" href="/NatashaTheRobot/kelsoswebsite/raw/master/public/assets/fonts/Gotham/GothamHTF-BookCondensed.otf">Download</a>
      <a rel="nofollow" class="btn btn-sm BtnGroup-item" href="/NatashaTheRobot/kelsoswebsite/commits/master/public/assets/fonts/Gotham/GothamHTF-BookCondensed.otf">History</a>
    </div>


        <!-- '"` --><!-- </textarea></xmp> --></option></form><form class="inline-form" action="/NatashaTheRobot/kelsoswebsite/delete/master/public/assets/fonts/Gotham/GothamHTF-BookCondensed.otf" accept-charset="UTF-8" method="post"><input name="utf8" type="hidden" value="&#x2713;" /><input type="hidden" name="authenticity_token" value="WYtzYccOzqDY22Dj36Cwj859vZfg43Y/WUNuMnDtt8pu2iehnauJQZwxkhgmQkE6beMUe0i9qBTtj6/8AYdgww==" />
          <button class="btn-octicon btn-octicon-danger tooltipped tooltipped-nw" type="submit"
            aria-label="Fork this project and delete the file" data-disable-with>
            <svg class="octicon octicon-trashcan" viewBox="0 0 12 16" version="1.1" width="12" height="16" aria-hidden="true"><path fill-rule="evenodd" d="M11 2H9c0-.55-.45-1-1-1H5c-.55 0-1 .45-1 1H2c-.55 0-1 .45-1 1v1c0 .55.45 1 1 1v9c0 .55.45 1 1 1h7c.55 0 1-.45 1-1V5c.55 0 1-.45 1-1V3c0-.55-.45-1-1-1zm-1 12H3V5h1v8h1V5h1v8h1V5h1v8h1V5h1v9zm1-10H2V3h9v1z"/></svg>
          </button>
</form>  </div>

  <div class="file-info">
    32.3 KB
  </div>
</div>

    

  <div itemprop="text" class="blob-wrapper data type-text">
      <div class="image">
          <a href="/NatashaTheRobot/kelsoswebsite/blob/master/public/assets/fonts/Gotham/GothamHTF-BookCondensed.otf?raw=true">View Raw</a>
      </div>
  </div>

  </div>

  <details class="details-reset details-overlay details-overlay-dark">
    <summary data-hotkey="l" aria-label="Jump to line"></summary>
    <details-dialog class="Box Box--overlay d-flex flex-column anim-fade-in fast linejump" aria-label="Jump to line">
      <!-- '"` --><!-- </textarea></xmp> --></option></form><form class="js-jump-to-line-form Box-body d-flex" action="" accept-charset="UTF-8" method="get"><input name="utf8" type="hidden" value="&#x2713;" />
        <input class="form-control flex-auto mr-3 linejump-input js-jump-to-line-field" type="text" placeholder="Jump to line&hellip;" aria-label="Jump to line" autofocus>
        <button type="submit" class="btn" data-close-dialog>Go</button>
</form>    </details-dialog>
  </details>


  </div>
  <div class="modal-backdrop js-touch-events"></div>
</div>

    </div>
  </div>

  </div>

        
<div class="footer container-lg px-3" role="contentinfo">
  <div class="position-relative d-flex flex-justify-between pt-6 pb-2 mt-6 f6 text-gray border-top border-gray-light ">
    <ul class="list-style-none d-flex flex-wrap ">
      <li class="mr-3">&copy; 2018 <span title="0.27286s from unicorn-6bd9bd9cc-hvp42">GitHub</span>, Inc.</li>
        <li class="mr-3"><a data-ga-click="Footer, go to terms, text:terms" href="https://github.com/site/terms">Terms</a></li>
        <li class="mr-3"><a data-ga-click="Footer, go to privacy, text:privacy" href="https://github.com/site/privacy">Privacy</a></li>
        <li class="mr-3"><a href="https://help.github.com/articles/github-security/" data-ga-click="Footer, go to security, text:security">Security</a></li>
        <li class="mr-3"><a href="https://status.github.com/" data-ga-click="Footer, go to status, text:status">Status</a></li>
        <li><a data-ga-click="Footer, go to help, text:help" href="https://help.github.com">Help</a></li>
    </ul>

    <a aria-label="Homepage" title="GitHub" class="footer-octicon" href="https://github.com">
      <svg height="24" class="octicon octicon-mark-github" viewBox="0 0 16 16" version="1.1" width="24" aria-hidden="true"><path fill-rule="evenodd" d="M8 0C3.58 0 0 3.58 0 8c0 3.54 2.29 6.53 5.47 7.59.4.07.55-.17.55-.38 0-.19-.01-.82-.01-1.49-2.01.37-2.53-.49-2.69-.94-.09-.23-.48-.94-.82-1.13-.28-.15-.68-.52-.01-.53.63-.01 1.08.58 1.23.82.72 1.21 1.87.87 2.33.66.07-.52.28-.87.51-1.07-1.78-.2-3.64-.89-3.64-3.95 0-.87.31-1.59.82-2.15-.08-.2-.36-1.02.08-2.12 0 0 .67-.21 2.2.82.64-.18 1.32-.27 2-.27.68 0 1.36.09 2 .27 1.53-1.04 2.2-.82 2.2-.82.44 1.1.16 1.92.08 2.12.51.56.82 1.27.82 2.15 0 3.07-1.87 3.75-3.65 3.95.29.25.54.73.54 1.48 0 1.07-.01 1.93-.01 2.2 0 .21.15.46.55.38A8.013 8.013 0 0 0 16 8c0-4.42-3.58-8-8-8z"/></svg>
</a>
   <ul class="list-style-none d-flex flex-wrap ">
        <li class="mr-3"><a data-ga-click="Footer, go to contact, text:contact" href="https://github.com/contact">Contact GitHub</a></li>
        <li class="mr-3"><a href="/pricing" data-ga-click="Footer, go to Pricing, text:Pricing">Pricing</a></li>
      <li class="mr-3"><a href="https://developer.github.com" data-ga-click="Footer, go to api, text:api">API</a></li>
      <li class="mr-3"><a href="https://training.github.com" data-ga-click="Footer, go to training, text:training">Training</a></li>
        <li class="mr-3"><a href="https://blog.github.com" data-ga-click="Footer, go to blog, text:blog">Blog</a></li>
        <li><a data-ga-click="Footer, go to about, text:about" href="https://github.com/about">About</a></li>

    </ul>
  </div>
  <div class="d-flex flex-justify-center pb-6">
    <span class="f6 text-gray-light"></span>
  </div>
</div>



  <div id="ajax-error-message" class="ajax-error-message flash flash-error">
    <svg class="octicon octicon-alert" viewBox="0 0 16 16" version="1.1" width="16" height="16" aria-hidden="true"><path fill-rule="evenodd" d="M8.893 1.5c-.183-.31-.52-.5-.887-.5s-.703.19-.886.5L.138 13.499a.98.98 0 0 0 0 1.001c.193.31.53.501.886.501h13.964c.367 0 .704-.19.877-.5a1.03 1.03 0 0 0 .01-1.002L8.893 1.5zm.133 11.497H6.987v-2.003h2.039v2.003zm0-3.004H6.987V5.987h2.039v4.006z"/></svg>
    <button type="button" class="flash-close js-ajax-error-dismiss" aria-label="Dismiss error">
      <svg class="octicon octicon-x" viewBox="0 0 12 16" version="1.1" width="12" height="16" aria-hidden="true"><path fill-rule="evenodd" d="M7.48 8l3.75 3.75-1.48 1.48L6 9.48l-3.75 3.75-1.48-1.48L4.52 8 .77 4.25l1.48-1.48L6 6.52l3.75-3.75 1.48 1.48L7.48 8z"/></svg>
    </button>
    You can’t perform that action at this time.
  </div>


    <script crossorigin="anonymous" integrity="sha512-2VdGgXQE8W5ONZ4OsrbEo/noennUZaqXkevD9R8juTHiCsjT0HFTTF6MoBfySUc8G+eFqUcDgd7v+CAu8Gjxlg==" type="application/javascript" src="https://assets-cdn.github.com/assets/compat-f849c975b0ffaa01d6ca305e48417d08.js"></script>
    <script crossorigin="anonymous" integrity="sha512-Swe7kfA0LYlT3FJ/ke9bPeUkLzJicE/ZxqOlslN1BTzsmekU9LCRmkEhprM8P9jyIT1PPZnHu/8tNM5k6JstFg==" type="application/javascript" src="https://assets-cdn.github.com/assets/frameworks-000e724656d8b68c57faba0b6d80278a.js"></script>
    
    <script crossorigin="anonymous" async="async" integrity="sha512-iK04uvFyMwXxWLbY/eleTk1H7shOe5W3V3LhirjsdmqMRoFuwWN1MHovDavK+Gm5INFyv+LiG32Aeui7DZk+/g==" type="application/javascript" src="https://assets-cdn.github.com/assets/github-ca5c0c6b6a11f4b7ad8aa92f3a2a45d4.js"></script>
    
    
    
  <div class="js-stale-session-flash stale-session-flash flash flash-warn flash-banner d-none">
    <svg class="octicon octicon-alert" viewBox="0 0 16 16" version="1.1" width="16" height="16" aria-hidden="true"><path fill-rule="evenodd" d="M8.893 1.5c-.183-.31-.52-.5-.887-.5s-.703.19-.886.5L.138 13.499a.98.98 0 0 0 0 1.001c.193.31.53.501.886.501h13.964c.367 0 .704-.19.877-.5a1.03 1.03 0 0 0 .01-1.002L8.893 1.5zm.133 11.497H6.987v-2.003h2.039v2.003zm0-3.004H6.987V5.987h2.039v4.006z"/></svg>
    <span class="signed-in-tab-flash">You signed in with another tab or window. <a href="">Reload</a> to refresh your session.</span>
    <span class="signed-out-tab-flash">You signed out in another tab or window. <a href="">Reload</a> to refresh your session.</span>
  </div>
  <div class="facebox" id="facebox" style="display:none;">
  <div class="facebox-popup">
    <div class="facebox-content" role="dialog" aria-labelledby="facebox-header" aria-describedby="facebox-description">
    </div>
    <button type="button" class="facebox-close js-facebox-close" aria-label="Close modal">
      <svg class="octicon octicon-x" viewBox="0 0 12 16" version="1.1" width="12" height="16" aria-hidden="true"><path fill-rule="evenodd" d="M7.48 8l3.75 3.75-1.48 1.48L6 9.48l-3.75 3.75-1.48-1.48L4.52 8 .77 4.25l1.48-1.48L6 6.52l3.75-3.75 1.48 1.48L7.48 8z"/></svg>
    </button>
  </div>
</div>

  <template id="site-details-dialog">
  <details class="details-reset details-overlay details-overlay-dark lh-default text-gray-dark" open>
    <summary aria-haspopup="dialog" aria-label="Close dialog"></summary>
    <details-dialog class="Box Box--overlay d-flex flex-column anim-fade-in fast">
      <button class="m-3 btn-octicon position-absolute right-0 top-0" type="button" aria-label="Close dialog" data-close-dialog>
        <svg class="octicon octicon-x" viewBox="0 0 12 16" version="1.1" width="12" height="16" aria-hidden="true"><path fill-rule="evenodd" d="M7.48 8l3.75 3.75-1.48 1.48L6 9.48l-3.75 3.75-1.48-1.48L4.52 8 .77 4.25l1.48-1.48L6 6.52l3.75-3.75 1.48 1.48L7.48 8z"/></svg>
      </button>
      <div class="octocat-spinner my-6 js-details-dialog-spinner"></div>
    </details-dialog>
  </details>
</template>

  <div class="Popover js-hovercard-content position-absolute" style="display: none; outline: none;" tabindex="0">
  <div class="Popover-message Popover-message--bottom-left Popover-message--large Box box-shadow-large" style="width:360px;">
  </div>
</div>

<div id="hovercard-aria-description" class="sr-only">
  Press h to open a hovercard with more details.
</div>


  </body>
</html>



================================================
FILE: docker-compose.yml
================================================
version: "3.5"

services:
  db:
    image: postgres:9.4
    environment:
      - DB_USER=postgres
      - DB_PASS=postgres
      - DB_NAME=poker
      - POSTGRES_PASSWORD=postgres
  #  volumes:
  #   - db-data:/var/lib/postgresql/data
    restart: on-failure
    networks:
      - backend
  
  redis:
    image: redis:5.0-rc4-alpine
    networks:
      - backend
    restart: on-failure
    volumes:
      - redis-data:/var/lib/redis
  
  server:
    build: ./server 
    environment:
     - dbConnStr=host=db port=5432 user=postgres dbname=postgres password=postgres
     - secret=aw4-4z0ds21c970dasdak4dm=9jhkbn8da268tkj7=rsfdaf92x88
     - redisHost=redis
    depends_on:
     - db
     - redis
    ports:
     - "8000:8000"
     - "5000:5000"
    restart: on-failure
    networks:
     - backend

  client:
    build: ./client
    restart: on-failure
    environment: 
      - HOST=0.0.0.0
    ports:
      - target: 3000
        published: 3000
        protocol: tcp
        mode: host

networks:
  backend:

volumes:
  db-data:
  redis-data:

================================================
FILE: server/.dev.env
================================================
dbConnStr='port=5432 user=postgres dbname=postgres password=postgres'
port=8000
secret="wwaaifidsa9109f0dasfda-=2-13"



================================================
FILE: server/.dockerignore
================================================
.dockerignore
.gitignore
.stack-work
Dockerfile

================================================
FILE: server/.gitignore
================================================
poker-server.cabal
*~
.env
build
dist
dist-*
cabal-dev
*.o
*.hi
*.chi
*.chs.h
*.dyn_o
*.dyn_hi
.hpc
.hsenv
.cabal-sandbox/
cabal.sandbox.config
*.prof
*.aux
*.hp
*.eventlog
.stack-work/
cabal.project.local
cabal.project.local~
.HTF/
.ghc.environment.*

.prod.env

================================================
FILE: server/.projectile
================================================


================================================
FILE: server/ChangeLog.md
================================================
# Changelog for poker-server

## Unreleased changes


================================================
FILE: server/Dockerfile
================================================
FROM fpco/stack-build-small

RUN mkdir -p /app


COPY . /app

WORKDIR /app

RUN apt-get update && \
  apt-get install libpq-dev lzma-dev libpq-dev -yy

RUN stack build --only-dependencies

RUN stack build 

CMD stack run


================================================
FILE: server/README.md
================================================
# Server


================================================
FILE: server/Setup.hs
================================================
import Distribution.Simple
main = defaultMain


================================================
FILE: server/UNLICENSE.txt
================================================
This is free and unencumbered software released into the public domain.

Anyone is free to copy, modify, publish, use, compile, sell, or
distribute this software, either in source code form or as a compiled
binary, for any purpose, commercial or non-commercial, and by any
means.

In jurisdictions that recognize copyright laws, the author or authors
of this software dedicate any and all copyright interest in the
software to the public domain. We make this dedication for the benefit
of the public at large and to the detriment of our heirs and
successors. We intend this dedication to be an overt act of
relinquishment in perpetuity of all present and future rights to this
software under copyright law.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR
OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
OTHER DEALINGS IN THE SOFTWARE.

For more information, please refer to <http://unlicense.org>

================================================
FILE: server/app/Main.hs
================================================
{-# LANGUAGE OverloadedStrings #-}

module Main where

import           Control.Concurrent.Async
import qualified Data.ByteString.Lazy          as BL
import           Data.Text.Encoding            as TSE
import           Database.Redis                 ( defaultConnectInfo )
import           Network.Wai.Handler.Warp
import           Prelude
import qualified System.Remote.Monitoring      as EKG

import qualified Data.ByteString.Lazy.Char8    as C

import           API
import           Database
import           Env
import           Socket

import           Crypto.JWT
import           Data.Proxy
import           Types

main :: IO ((), ())
main = do
  dbConnString  <- getDBConnStrFromEnv
  userAPIPort   <- getAuthAPIPort defaultUserAPIPort
  socketAPIPort <- getSocketAPIPort defaultSocketAPIPort
  redisConfig   <- getRedisHostFromEnv defaultRedisHost
  print "REDIS config: "
  print redisConfig
  secretKey <- getSecretKey
  let runSocketAPI =
        runSocketServer secretKey socketAPIPort dbConnString redisConfig
      app'     = app secretKey dbConnString redisConfig
      settings = setPort userAPIPort (setHost "0.0.0.0" defaultSettings)

  migrateDB dbConnString
  ekg <- runMonitoringServer
  concurrently (runSettings settings app') runSocketAPI
 where
  defaultUserAPIPort             = 8000
  defaultSocketAPIPort           = 5000
  defaultRedisHost               = "localhost"
  defaultMonitoringServerAddress = "localhost"
  defaultMonitoringServerPort    = 9999
  runMonitoringServer =
    EKG.forkServer defaultMonitoringServerAddress defaultMonitoringServerPort



================================================
FILE: server/bootstrap.sh
================================================
# install virtual env and python

# activate python virtual env
virtualenv venv
~ source venv/bin/activate

# install ansible
sudo dnf install ansible

pip install docker-py boto

# install aws-cli

# Give executable permissions to the
# script which dynamically retrieves 
# AWS EC2 instance inventory 
chmod +x ansible/inventory/ec2.py

# Environment variables to the AWS EC2 inventory management script 
#
#
# Our EC2 dynamic inventory script has the file name ec2.py
#
# This variable tells Ansible to use the dynamic 
# EC2 script instead of a static /etc/ansible/hosts file.
export EC2_INI_PATH=./ansible/inventory/ec2.ini
# This variable tells ec2.py where the ec2.ini config file is located.
export ANSIBLE_INVENTORY=./ansible/inventory/ec2.py

================================================
FILE: server/deploy-server.sh
================================================
#!/bin/bash
## First arg to the bashfile must be the path to the key file to SSH into the EC2 host(s)
##
## Build and push new docker image to AWS ECR then pull and run new image in EC2 instance.
## Ensure AWS credentials are set in environment or the ansible playbook will fail to login to AWS

if [ $# -eq 0 ]
  then
    echo "You forgot to speciffy the path to the key file to authenticate the SSH connection"
fi

sudo -H pip install pip==18.0.0 \
    && sudo -H pip uninstall --yes setuptools \
    && sudo -H pip install 'setuptools<20.2' --ignore-installed \
    && sudo -H pip install 'requests[security]' --ignore-installed \
    && sudo -H pip install boto awscli ansible docker-py --ignore-installed \
    && ANSIBLE_CONFIG=ansible/ansible.cfg ansible-playbook ansible/push-new-image.yml ansible/deploy-image.yml --key-file=$1 -vvvv

================================================
FILE: server/deploy.sh
================================================
#!/usr/bin/env bash
set -o errexit
set -o pipefail
set -o nounset

# Location of executable
BUILD_DIR="./build"
BINARY_PATH=$BUILD_DIR"/poker-server-exe"

# Where we deploy
HOST="34.244.29.59"
REMOTE="ubuntu@"$HOST

RUN="sudo /opt/server/server-exe"


serverHealthCheck(){
    local url="https://tenpoker.co.uk/lobby"
    local statusCode=`echo $(curl -s -o /dev/null -w "%{http_code}" $url)`

    if [[ "$statusCode" != 2* ]] && [[ "$statusCode" != 0* ]]; then
        echo "Error: Server responded with http status: $statusCode"  # if the content of statusCode isn't a "2xx" print the error.
    fi

    if [[ "$statusCode" = 0* ]]; then
        echo "Error: Server unreachable: $statusCode" # connection refused
    fi

     if [[ "$statusCode" = 2* ]]; then
        echo "Success: Server responded with http status: $statusCode"
    fi
}

# compile binrary
stack build --copy-bins --local-bin-path $BUILD_DIR


ssh -i ~/.ssh/id_rsa $REMOTE sudo "systemctl stop server.service" 


# copy server binary to remote
scp -i ~/.ssh/id_rsa $BINARY_PATH $REMOTE:/opt/server

# restart server using systemd
ssh -i ~/.ssh/id_rsa $REMOTE sudo "systemctl start server.service"

serverHealthCheck

================================================
FILE: server/docs/lobbyAPI.md
================================================
## POST /gooby

### Request:

- Supported content types are:

    - `application/json;charset=utf-8`
    - `application/json`

- Sample User (`application/json;charset=utf-8`, `application/json`):

    ```javascript
{"email":"gooby@g.com","username":"Tom","chips":2000,"password":"n84!@R5G"}
    ```

### Response:

- Status code 200
- Headers: []

- Supported content types are:

    - `application/json;charset=utf-8`
    - `application/json`

- Sample User (`application/json;charset=utf-8`, `application/json`):

    ```javascript
1
    ```



================================================
FILE: server/docs/socket.md
================================================
{"tag":"subscribeToTable","contents":"Black"}

{"tag":"TakeSeat","contents":["Black",3000]}

{"tag":"GameMove","contents":["Black",{"tag":"PostBlind","contents":"SmallBlind"}]}
{"tag":"GameMove","contents":["Black",{"tag":"PostBlind","contents":"BigBlind"}]}
{"tag":"GameMove","contents":["Black",{"tag":"Call"}]}
{"tag":"GameMove","contents":["Black",{"tag":"Check"}]}
{"tag":"GameMove","contents":["Black",{"tag":"Bet","contents":100}]}
{"tag":"LeaveSeat","contents":"Black"}

================================================
FILE: server/docs/userAPI.md
================================================
## POST /register

### Request:

- Supported content types are:

  - `application/json;charset=utf-8`
  - `application/json`

- Sample Register (`application/json;charset=utf-8`, `application/json`):

      ```javascript

  {
  newUsername: "Argo",
  newEmail: "gooby@goo.com",
  newPassword: "password123"
  }
  ```

### Response:

- Supported content types are:

  - `application/json;charset=utf-8`
  - `application/json`

- Sample ReturnToken (`application/json;charset=utf-8`, `application/json`):

      ```javascript

  {
  "access_token": "eyJhbGciOiJIUzI1NiIs",
  "expiration": 3600,
  "refresh_token": "EwMIjImdgoeswazNQx"
  }

      ```

## POST /login

### Request:

- Supported content types are:

  - `application/json;charset=utf-8`
  - `application/json`

- Sample Login (`application/json;charset=utf-8`, `application/json`):

      ```javascript

  {
    loginUsername: "gooby",
    loginPassword: "password123"
  }
  ```

### Response:

- Supported content types are:

  - `application/json;charset=utf-8`
  - `application/json`

- Sample ReturnToken (`application/json;charset=utf-8`, `application/json`):

      ```javascript

  {
  "access_token": "eyJhbGciOiJIUzI1NiIs",
  "expiration": 3600,
  "refresh_token": "EwMIjImdgoeswazNQx"
  }

      ```

## GET /profile

### Request:

- Supported content types are:

  - `application/json;charset=utf-8`
  - `application/json`

- Headers:
  - Authorization: eyJhbGciOiJIUzI1NiIs

Ensure access token is in Authorization header

### Response:

- Supported content types are:

  - `application/json;charset=utf-8`
  - `application/json`

- Sample ReturnToken (`application/json;charset=utf-8`, `application/json`):

      ```javascript

  {
  "proChips": 3000,
  "proUsername": "Argo",
  "proEmail": "gooby@goo.com"
  }

      ```


================================================
FILE: server/package.yaml
================================================
name: poker-server
version: 0.1.0.0
github: "githubuser/poker-server"
license: Unlicense
author: "therewillbecode"
maintainer: "tomw08@gmail.com"
copyright: "2019 Tom Chambrier"

extra-source-files:
  - README.md
  - ChangeLog.md

description: A Poker Server Built With Haskell

dependencies:
  - base >= 4.12 && < 5
  - adjunctions
  - distributive
  - async
  - aeson
  - bytestring
  - comonad
  - free
  - hedis
  - ekg
  - containers
  - cryptohash
  - hashable
  - jose
  - persistent
  - persistent-postgresql
  - persistent-template
  - time
  - servant
  - servant-server
  - servant-auth
  - servant-auth-server
  - servant-auth-client
  - servant-foreign
  - servant-options
  - servant-websockets
  - pipes
  - pipes-aeson
  - pipes-concurrency
  - pipes-parse
  - transformers
  - random
  - text
  - wai
  - wai-extra
  - wai-logger
  - wai-cors
  - websockets
  - pretty-simple
  - utf8-string
  - split
  - stm
  - MonadRandom
  - monad-logger
  - mtl
  - jwt
  - listsafe
  - warp
  - lens
  - vector

library:
  source-dirs: src
  exposed-modules:
    - API
    - Bots
    - Database
    - Schema
    - Env
    - Types
    - Poker.Poker
    - Poker.Game.Actions
    - Poker.ActionValidation
    - Poker.Types
    - Poker.Game.Blinds
    - Poker.Game.Game
    - Poker.Game.Hands
    - Poker.Game.Utils
    - Poker.Game.Privacy
    - Socket
    - Socket.Table

executables:
  poker-server-exe:
    main: Main.hs
    source-dirs: app
    ghc-options:
      - -threaded
      - -rtsopts
      - -with-rtsopts=-N
    dependencies:
      - poker-server

tests:
  spec:
    main: Spec.hs
    source-dirs: test
    ghc-options:
      - -threaded
      - -rtsopts
      - -with-rtsopts=-N
    dependencies:
      - poker-server
      - hspec
      - hedgehog
      - hspec-hedgehog

================================================
FILE: server/ping.sh
================================================

#!/usr/bin/env bash
set -o errexit
set -o pipefail
set -o nounset

BINARY_PATH=".stack-work/dist/x86_64-linux/Cabal-2.4.0.1/build/poker-server-exe/poker-server-exe"
HOST="34.244.29.59"
REMOTE="ubuntu@"$HOST

RUN="sudo /opt/server/server-exe"


serverHealthCheck(){
    local url="https://tenpoker.co.uk/lobby"
    local statusCode=`echo $(curl -s -o /dev/null -w "%{http_code}" $url)`

    if [[ "$statusCode" != 2* ]] && [[ "$statusCode" != 0* ]]; then
        echo "Error: Server responded with http status: $statusCode"  # if the content of statusCode isn't a "2xx" print the error.
    fi

    if [[ "$statusCode" = 0* ]]; then
        echo "Error: Server unreachable: $statusCode" # connection refused
    fi

     if [[ "$statusCode" = 2* ]]; then
        echo "Success: Server responded with http status: $statusCode"
    fi
}

serverHealthCheck 

================================================
FILE: server/provision.sh
================================================
#!/usr/bin/env bash

set -o errexit
set -o pipefail
set -o nounset

REMOTE="ubuntu@34.244.29.59"
INSTALL_SYS_DEPENDENCIES="sudo apt-get update && sudo apt-get install -yy build-essential lzma-dev libpq-dev"


ssh -i ~/Downloads/tenprod.pem $REMOTE sudo $INSTALL_SYS_DEPENDENCIES

# create release dir and give ubuntu user permissions
ssh -i ~/.ssh/id_rsa $REMOTE sudo "sudo mkdir -pv /opt/server && sudo chown ubuntu /opt/server" -v

# give ubuntu user ownership of systemd service file dir
ssh -i ~/.ssh/id_rsa $REMOTE sudo "sudo chown ubuntu /etc/systemd/system" -v

# copy systemd service conf file to remote
scp -i ~/.ssh/id_rsa "server.service" $REMOTE:/etc/systemd/system

ssh -i ~/.ssh/id_rsa $REMOTE "sudo systemctl enable server.service"

scp -i ~/.ssh/id_rsa ".prod.env" $REMOTE:/etc/systemd/system/prod.env

================================================
FILE: server/server.service
================================================
[Unit]
Description=server

[Service]
Type=simple
ExecStart=/opt/server/poker-server-exe
Restart=always
User=ubuntu
EnvironmentFile=/etc/systemd/system/prod.env

[Install]
WantedBy=default.target 

================================================
FILE: server/shell.nix
================================================
{ nixpkgs ? import <nixpkgs> {}, compiler ? "default", doBenchmark ? false }:

let

  inherit (nixpkgs) pkgs;

  f = { mkDerivation, adjunctions, aeson, async, base, bytestring
      , comonad, containers, cryptohash, distributive, ekg, free
      , hashable, hedgehog, hedis, hpack, hspec, hspec-hedgehog, jose
      , jwt, lens, lib, listsafe, monad-logger, MonadRandom, mtl
      , persistent, persistent-postgresql, persistent-template, pipes
      , pipes-aeson, pipes-concurrency, pipes-parse, pretty-simple
      , random, servant, servant-auth, servant-auth-client
      , servant-auth-server, servant-foreign, servant-options
      , servant-server, servant-websockets, split, stm, text, time
      , transformers, utf8-string, vector, wai, wai-cors, wai-extra
      , wai-logger, warp, websockets
      }:
      mkDerivation {
        pname = "poker-server";
        version = "0.1.0.0";
        src = ./.;
        isLibrary = true;
        isExecutable = true;
        libraryHaskellDepends = [
          adjunctions aeson async base bytestring comonad containers
          cryptohash distributive ekg free hashable hedis jose jwt lens
          listsafe monad-logger MonadRandom mtl persistent
          persistent-postgresql persistent-template pipes pipes-aeson
          pipes-concurrency pipes-parse pretty-simple random servant
          servant-auth servant-auth-client servant-auth-server
          servant-foreign servant-options servant-server servant-websockets
          split stm text time transformers utf8-string vector wai wai-cors
          wai-extra wai-logger warp websockets
        ];
        libraryToolDepends = [ hpack ];
        executableHaskellDepends = [
          adjunctions aeson async base bytestring comonad containers
          cryptohash distributive ekg free hashable hedis jose jwt lens
          listsafe monad-logger MonadRandom mtl persistent
          persistent-postgresql persistent-template pipes pipes-aeson
          pipes-concurrency pipes-parse pretty-simple random servant
          servant-auth servant-auth-client servant-auth-server
          servant-foreign servant-options servant-server servant-websockets
          split stm text time transformers utf8-string vector wai wai-cors
          wai-extra wai-logger warp websockets
        ];
        testHaskellDepends = [
          adjunctions aeson async base bytestring comonad containers
          cryptohash distributive ekg free hashable hedgehog hedis hspec
          hspec-hedgehog jose jwt lens listsafe monad-logger MonadRandom mtl
          persistent persistent-postgresql persistent-template pipes
          pipes-aeson pipes-concurrency pipes-parse pretty-simple random
          servant servant-auth servant-auth-client servant-auth-server
          servant-foreign servant-options servant-server servant-websockets
          split stm text time transformers utf8-string vector wai wai-cors
          wai-extra wai-logger warp websockets
        ];
        prePatch = "hpack";
        homepage = "https://github.com/githubuser/poker-server#readme";
        license = lib.licenses.unlicense;
      };

  haskellPackages = if compiler == "default"
                       then pkgs.haskellPackages
                       else pkgs.haskell.packages.${compiler};

  variant = if doBenchmark then pkgs.haskell.lib.doBenchmark else pkgs.lib.id;

  drv = variant (haskellPackages.callPackage f {});

in

  if pkgs.lib.inNixShell then drv.env else drv


================================================
FILE: server/src/API.hs
================================================
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module API where

import Control.Concurrent (forkIO)
import Control.Lens ((&), (<>~))
import Control.Monad (forever)
import Control.Monad.Trans (liftIO)
import Crypto.JOSE.JWK (JWK)
import Data.Aeson (FromJSON, ToJSON)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import Data.Proxy (Proxy (..))
import qualified Data.Text as T
import Database.Persist.Postgresql (ConnectionString)
import Debug.Trace (traceShow)
import GHC.Generics (Generic)
import GHC.TypeLits
  ( ErrorMessage (Text),
    KnownSymbol,
    Symbol,
    TypeError,
    symbolVal,
  )
import Network.Wai (Application)
import Network.Wai.Handler.Warp (run)
import Network.Wai.Middleware.Cors
  ( CorsResourcePolicy (corsRequestHeaders),
    cors,
    simpleCorsResourcePolicy,
  )
import Network.Wai.Middleware.RequestLogger (logStdoutDev)
import Network.Wai.Middleware.Servant.Options (provideOptions)
import Servant
  ( Application,
    Context (EmptyContext, (:.)),
    Get,
    JSON,
    NoContent,
    Post,
    Proxy (..),
    ReqBody,
    Server,
    err401,
    serveWithContext,
    type (:<|>) (..),
    type (:>),
  )
import Servant.Auth.Server
  ( Auth,
    AuthResult (Authenticated),
    Cookie,
    JWT,
    JWTSettings,
    ThrowAll (throwAll),
    defaultCookieSettings,
    defaultJWTSettings,
    fromSecret,
  )
import Servant.Foreign
  ( Arg (Arg, _argName, _argType),
    HasForeign (..),
    HasForeignType (..),
    HeaderArg (HeaderArg),
    PathSegment (PathSegment),
    reqHeaders,
  )
import Servant.Server
  ( Application,
    Context (EmptyContext, (:.)),
    Server,
    err401,
    serveWithContext,
  )
import System.Environment (getArgs)
import Types
  ( Login,
    RedisConfig,
    Register,
    ReturnToken,
    UserProfile,
    Username,
  )
import Users
  ( fetchUserProfileHandler,
    getLobbyHandler,
    loginHandler,
    registerUserHandler,
  )

type API auths =
  (Servant.Auth.Server.Auth auths Username :> ProtectedUsersAPI)
    :<|> UnprotectedUsersAPI

type UnprotectedUsersAPI =
  "login" :> ReqBody '[JSON] Login :> Post '[JSON] ReturnToken
    :<|> "register" :> ReqBody '[JSON] Register :> Post '[JSON] ReturnToken
    :<|> "lobby" :> Get '[JSON] NoContent

type ProtectedUsersAPI =
  "profile" :> Get '[JSON] UserProfile

api :: Proxy (API '[JWT])
api = Proxy :: Proxy (API '[JWT])

protectedUsersApi :: Proxy ProtectedUsersAPI
protectedUsersApi = Proxy :: Proxy ProtectedUsersAPI

unprotectedUsersApi :: Proxy UnprotectedUsersAPI
unprotectedUsersApi = Proxy :: Proxy UnprotectedUsersAPI

app :: BS.ByteString -> ConnectionString -> RedisConfig -> Application
app secretKey connString redisConfig = addMiddleware $ serveWithAuth secretKey connString redisConfig

type Token = String

type family TokenHeaderName xs :: Symbol where
  TokenHeaderName (Cookie ': xs) = "X-XSRF-TOKEN"
  TokenHeaderName (JWT ': xs) = "Authorization"
  TokenHeaderName (x ': xs) = TokenHeaderName xs
  TokenHeaderName '[] = TypeError (Text "Neither JWT nor cookie auth enabled")

instance
  ( TokenHeaderName auths ~ header,
    KnownSymbol header,
    HasForeignType lang ftype Token,
    HasForeign lang ftype sub
  ) =>
  HasForeign lang ftype (Auth auths a :> sub)
  where
  type Foreign ftype (Auth auths a :> sub) = Foreign ftype sub

  foreignFor lang Proxy Proxy req =
    foreignFor lang Proxy subP $ req & reqHeaders <>~ [HeaderArg arg]
    where
      arg =
        Arg
          { _argName = PathSegment . T.pack $ symbolVal @header Proxy,
            _argType = token
          }
      token = typeFor lang (Proxy @ftype) (Proxy @Token)
      subP = Proxy @sub

-- Adds JWT Authentication to our server
serveWithAuth :: BS.ByteString -> ConnectionString -> RedisConfig -> Application
serveWithAuth secretKey c r =
  serveWithContext api cfg (server jwtCfg c r)
  where
    jwk = fromSecret secretKey
    jwtCfg = defaultJWTSettings jwk
    cfg = defaultCookieSettings :. jwtCfg :. EmptyContext
    api = Proxy :: Proxy (API '[JWT]) -- API is a type synonym for our api - type is now concrete

server :: JWTSettings -> ConnectionString -> RedisConfig -> Server (API '[JWT])
server j c r = protectedUsersServer j c r :<|> unprotectedUsersServer j c r

unprotectedUsersServer :: JWTSettings -> ConnectionString -> RedisConfig -> Server UnprotectedUsersAPI
unprotectedUsersServer jwtSettings connString redisConfig =
  loginHandler jwtSettings connString
    :<|> registerUserHandler jwtSettings connString redisConfig
    :<|> getLobbyHandler jwtSettings connString redisConfig

protectedUsersServer :: JWTSettings -> ConnectionString -> RedisConfig -> AuthResult Username -> Server ProtectedUsersAPI
protectedUsersServer j c r (Authenticated username') = fetchUserProfileHandler c username'
protectedUsersServer _ _ _ er = traceShow er (throwAll err401)

type Middleware = Application -> Application

addMiddleware :: Application -> Application
addMiddleware = logStdoutDev . cors (const $ Just policy) . (provideOptions api)
  where
    corsReqHeaders = ["content-type", "Access-Control-Allow-Origin", "POST", "GET", "*"]
    policy = simpleCorsResourcePolicy {corsRequestHeaders = corsReqHeaders}


================================================
FILE: server/src/Bots.hs
================================================
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

module Bots where

import Control.Applicative ((<$>))
import Control.Concurrent (ThreadId, forkIO, threadDelay)
import Control.Concurrent.Async (async)
import Control.Concurrent.STM
  ( TChan,
    TVar,
    atomically,
    dupTChan,
    readTChan,
    readTVarIO,
  )
import Control.Concurrent.STM.TChan (TChan, dupTChan, readTChan)
import Control.Exception ()
import Control.Lens ((^.))
import Control.Monad
  ( Monad (return, (>>)),
    forever,
    mapM_,
    unless,
    when,
  )
import Control.Monad.Except
  ( Monad (return, (>>)),
    MonadIO (liftIO),
    forever,
    mapM_,
    unless,
    when,
  )
import Control.Monad.Reader
  ( Monad (return, (>>)),
    MonadIO (liftIO),
    forever,
    mapM_,
    unless,
    when,
  )
import Control.Monad.STM (atomically)
import Control.Monad.State.Lazy
  ( Monad (return, (>>)),
    MonadIO (liftIO),
    forever,
    mapM_,
    unless,
    when,
  )
import Data.Either (Either (Left, Right), isRight)
import Data.Foldable (Foldable (length, null), mapM_)
import Data.Functor ((<$>))
import Data.Map.Lazy (Map)
import qualified Data.Map.Lazy as M
import Data.Maybe
import Data.Maybe (Maybe (..), maybe)
import Data.Monoid ((<>))
import Data.Text (Text)
import qualified Data.Text as T
import Database (dbDepositChipsIntoPlay)
import Database.Persist.Postgresql (ConnectionString)
import qualified Network.WebSockets as WS
import Pipes
import Pipes.Concurrent
import qualified Pipes.Prelude as P
import Poker.ActionValidation (validateAction)
import Poker.Game.Blinds (blindRequiredByPlayer)
import Poker.Game.Game (doesPlayerHaveToAct, initPlayer)
import Poker.Game.Utils (getGamePlayer)
import Poker.Poker (initPlayer, runPlayerAction)
import Poker.Types
import Socket.Table (toGameInMailbox, updateTable')
import Socket.Types
  ( Err (GameErr),
    MsgOut (NewGameState),
    ServerState (..),
    Table
      ( Table,
        channel,
        game,
        gameInMailbox,
        gameOutMailbox,
        subscribers,
        waitlist
      ),
  )
import Socket.Utils (unLobby)
import System.Random (randomRIO)
import Text.Pretty.Simple (pPrint)
import Types ()
import Prelude

delayThenSeatPlayer ::
  ConnectionString -> Int -> TVar ServerState -> Player -> IO ()
delayThenSeatPlayer dbConn delayDuration s p = do
  _ <- threadDelay delayDuration
  sitDownBot dbConn p s

bot1 :: Player
bot1 = initPlayer "1@1" 2000

bot2 :: Player
bot2 = initPlayer "2@2" 2000

bot3 :: Player
bot3 = initPlayer "3@3" 2000

bot4 :: Player
bot4 = initPlayer "101@101" 2000

bot5 :: Player
bot5 = initPlayer "102@102" 2000

startBotActionLoops ::
  ConnectionString -> TVar ServerState -> Int -> [PlayerName] -> IO ()
startBotActionLoops db s playersToWaitFor botNames = do
  threadDelay 2500000 -- 25 second delay so bots dont start game until all of them sat down
  ServerState {..} <- readTVarIO s
  case M.lookup tableName $ unLobby lobby of
    Nothing -> error "TableDoesNotExist "
    Just table@Table {..} -> do
      mapM_ (botActionLoop db s gameOutMailbox playersToWaitFor) botNames
  where
    tableName = "Black"

botActionLoop ::
  ConnectionString ->
  TVar ServerState ->
  Input Game ->
  Int ->
  PlayerName ->
  IO ThreadId
botActionLoop dbConn s gameOutMailbox playersToWaitFor botName = forkIO $
  forever $ do
    runEffect $
      fromInput gameOutMailbox
        >-> do
          g <- await
          liftIO $
            if (canStartGame g)
              then runBotAction dbConn s g botName
              else (actIfNeeded g botName)
  where
    canStartGame Game {..} =
      _street == PreDeal && (length _players >= playersToWaitFor)
    actIfNeeded g' pName' =
      let hasToAct = doesPlayerHaveToAct pName' g'
       in when (hasToAct || (isJust $ blindRequiredByPlayer g' pName')) $ do
            runBotAction dbConn s g' pName'

runBotAction ::
  ConnectionString -> TVar ServerState -> Game -> PlayerName -> IO ()
runBotAction dbConn serverStateTVar g pName = do
  maybeAction <- getValidBotAction g pName
  case maybeAction of
    Nothing -> return ()
    Just a -> do
      let eitherNewGame = runPlayerAction g a
      case eitherNewGame of
        Left gameErr -> print (show $ GameErr gameErr) >> return ()
        Right g -> do
          liftIO $ async $ toGameInMailbox serverStateTVar tableName g
          liftIO $ atomically $ updateTable' serverStateTVar tableName g
  where
    tableName = "Black"
    chipsToSit = 2000

sitDownBot :: ConnectionString -> Player -> TVar ServerState -> IO ()
sitDownBot dbConn player@Player {..} serverStateTVar = do
  s@ServerState {..} <- readTVarIO serverStateTVar
  let gameMove = SitDown player
  case M.lookup tableName $ unLobby lobby of
    Nothing -> error "table doesnt exist" >> return ()
    Just Table {..} -> do
      let eitherNewGame = runPlayerAction game takeSeatAction
      case eitherNewGame of
        Left gameErr -> print $ GameErr gameErr
        Right g -> do
          dbDepositChipsIntoPlay dbConn _playerName chipsToSit
          liftIO $ async $ toGameInMailbox serverStateTVar tableName g
          liftIO $ atomically $ updateTable' serverStateTVar tableName g
  where
    chipsToSit = 2000
    tableName = "Black"
    takeSeatAction = PlayerAction {name = _playerName, action = SitDown player}

getValidBotAction :: Game -> PlayerName -> IO (Maybe PlayerAction)
getValidBotAction g@Game {..} name
  | length _players < 2 = return Nothing
  | _street == PreDeal = return $ case blindRequiredByPlayer g name of
    Just SmallBlind -> Just $ PlayerAction {action = PostBlind SmallBlind, ..}
    Just BigBlind -> Just $ PlayerAction {action = PostBlind BigBlind, ..}
    Nothing -> Nothing
  | otherwise = do
    betAmount' <- randomRIO (lowerBetBound, chipCount)
    let possibleActions = actions _street $ unChips betAmount'
    let actionsValidated = validateAction g name <$> possibleActions
    let pNameActionPairs = zip possibleActions actionsValidated
    let validActions = (<$>) fst $ filter (isRight . snd) pNameActionPairs
    when (null validActions) (print g)
    randIx <- randomRIO (0, length validActions - 1)
    return $ Just $ PlayerAction {action = validActions !! randIx, ..}
  where
    actions :: Street -> Int -> [Action]
    actions st chips
      | st == PreDeal = [PostBlind BigBlind, PostBlind SmallBlind]
      | otherwise = [Check, Call, Fold, Bet $ Chips chips, Raise $ Chips chips]
    lowerBetBound = if (_maxBet > 0) then 2 * _maxBet else Chips _bigBlind
    chipCount = maybe 0 (^. chips) (getGamePlayer g name)


================================================
FILE: server/src/Database.hs
================================================
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Database where

import Control.Lens hiding ((<.))
import Control.Monad (void)
import Control.Monad.Except
  ( ExceptT,
    MonadError (throwError),
    MonadIO (liftIO),
    void,
  )
import Control.Monad.Logger
  ( LoggingT,
    NoLoggingT,
    runNoLoggingT,
    runStderrLoggingT,
    runStdoutLoggingT,
  )
import Control.Monad.Reader (runReaderT)
import Data.ByteString.Char8
  ( pack,
    unpack,
  )
import Data.Int (Int64)
import Data.Maybe (isJust)
import Data.Text (Text)
import Data.Time.Clock (getCurrentTime)
import Database.Persist
  ( Entity (Entity),
    PersistEntity (Key),
    PersistQueryRead (selectFirst),
    PersistQueryWrite (updateWhere),
    PersistStoreWrite (delete, insert),
    (+=.),
    (-=.),
    (<.),
    (=.),
    (==.),
  )
import Database.Persist.Postgresql
  ( ConnectionString,
    SqlPersistT,
    runMigration,
    withPostgresqlConn,
  )
import Database.Persist.Sql
  ( Entity (Entity),
    PersistEntity (Key),
    PersistQueryRead (selectFirst),
    PersistQueryWrite (updateWhere),
    PersistStoreWrite (delete, insert),
    SqlPersistT,
    fromSqlKey,
    runMigration,
    toSqlKey,
    (+=.),
    (-=.),
    (<.),
    (=.),
    (==.),
  )
import Database.Redis
  ( Redis,
    connect,
    runRedis,
    setex,
  )
import qualified Database.Redis as Redis
import Poker.Types (Game (..), unChips, unDeck)
import Schema
  ( EntityField
      ( TableEntityName,
        UserEntityAvailableChips,
        UserEntityChipsInPlay,
        UserEntityEmail,
        UserEntityPassword,
        UserEntityUsername
      ),
    GameEntity (..),
    Key,
    TableEntity (..),
    UserEntity (..),
    migrateAll,
  )
import Types (Login (..), RedisConfig, Username (..))

runAction :: ConnectionString -> SqlPersistT (NoLoggingT IO) a -> IO a
runAction connectionString action =
  runNoLoggingT $
    withPostgresqlConn connectionString $ \backend ->
      runReaderT action backend

migrateDB :: ConnectionString -> IO ()
migrateDB connString = runAction connString (runMigration migrateAll)

deleteUserPG :: ConnectionString -> Int64 -> IO ()
deleteUserPG connString uid = runAction connString (delete userKey)
  where
    userKey :: Key UserEntity
    userKey = toSqlKey uid

dbGetUserByEmail :: ConnectionString -> Text -> IO (Maybe UserEntity)
dbGetUserByEmail connString email = do
  maybeUserEntity <-
    runAction
      connString
      (selectFirst [UserEntityEmail ==. email] [])
  return $ case maybeUserEntity of
    Just (Entity _ user) -> Just user
    Nothing -> Nothing

dbGetUserByUsername :: ConnectionString -> Username -> IO (Maybe UserEntity)
dbGetUserByUsername connString (Username username) = do
  maybeUserEntity <-
    runAction
      connString
      (selectFirst [UserEntityUsername ==. username] [])
  return $ case maybeUserEntity of
    Just (Entity _ user) -> Just user
    Nothing -> Nothing

dbRegisterUser ::
  ConnectionString -> RedisConfig -> UserEntity -> ExceptT Text IO Int64
dbRegisterUser connString redisConfig userE@UserEntity {..} = do
  emailAvailable <-
    liftIO $
      fetchUserByEmail connString redisConfig userEntityEmail
  if isJust emailAvailable
    then throwError "Email is Already Taken"
    else do
      usernameAvailable <-
        liftIO $
          dbGetUserByUsername connString (Username userEntityUsername)
      if isJust usernameAvailable
        then throwError "Username is Already Taken"
        else liftIO $ fromSqlKey <$> runAction connString (insert userE)

dbGetUserByLogin :: ConnectionString -> Login -> IO (Maybe UserEntity)
dbGetUserByLogin connString Login {..} = do
  maybeUser <-
    runAction
      connString
      ( selectFirst
          [ UserEntityUsername ==. loginUsername,
            UserEntityPassword ==. loginPassword
          ]
          []
      )
  return $ case maybeUser of
    Just (Entity _ userE) -> Just userE
    Nothing -> Nothing

fetchUserByEmail ::
  ConnectionString -> RedisConfig -> Text -> IO (Maybe UserEntity)
fetchUserByEmail connString redisConfig email = do
  maybeCachedUser <- liftIO $ redisFetchUserByEmail redisConfig email
  case maybeCachedUser of
    Just userE -> return $ Just userE
    Nothing -> dbGetUserByEmail connString email

-------  Redis  --------
runRedisAction :: RedisConfig -> Redis a -> IO a
runRedisAction redisConfig action = do
  connection <- connect redisConfig
  runRedis connection action

-- we use emails instead of usernames for keys as users can change their usernames
cacheUser :: RedisConfig -> Text -> UserEntity -> IO ()
cacheUser redisConfig email userE =
  runRedisAction redisConfig $
    void $
      setex
        (pack . show $ email)
        3600
        (pack . show $ userE)

redisFetchUserByEmail :: RedisConfig -> Text -> IO (Maybe UserEntity)
redisFetchUserByEmail redisConfig email = runRedisAction redisConfig $ do
  result <- Redis.get (pack . show $ email)
  case result of
    Right (Just userString) -> return $ Just (read . unpack $ userString)
    _ -> return Nothing

-------  Redis  --------
-- Query is called at the end of every hand to update player balances
dbUpdateUsersChips :: ConnectionString -> [(Text, Int)] -> IO ()
dbUpdateUsersChips connString userChipCounts =
  runAction
    connString
    ( updateWhere
        ((UserEntityUsername ==.) . fst <$> userChipCounts)
        ((UserEntityAvailableChips =.) . snd <$> userChipCounts)
    )

-- Query runs when player takes or leaves a seat at a game
dbDepositChipsIntoPlay :: ConnectionString -> Text -> Int -> IO ()
dbDepositChipsIntoPlay connString username chipsToAdd =
  runAction
    connString
    ( updateWhere
        [UserEntityUsername ==. username]
        [ UserEntityAvailableChips -=. chipsToAdd,
          UserEntityChipsInPlay +=. chipsToAdd
        ]
    )

dbWithdrawChipsFromPlay :: ConnectionString -> Text -> Int -> IO ()
dbWithdrawChipsFromPlay connString username chipsToAdd =
  runAction
    connString
    ( updateWhere
        [UserEntityUsername ==. username]
        [ UserEntityAvailableChips +=. chipsToAdd,
          UserEntityChipsInPlay -=. chipsToAdd
        ]
    )

dbGetTableEntity :: ConnectionString -> Text -> IO (Maybe (Entity TableEntity))
dbGetTableEntity connString tableName =
  runAction connString (selectFirst [TableEntityName ==. tableName] [])

dbInsertTableEntity :: ConnectionString -> Text -> IO (Key TableEntity)
dbInsertTableEntity connString tableName =
  runAction connString (insert (TableEntity {tableEntityName = tableName}))

dbInsertGame :: ConnectionString -> Key TableEntity -> Game -> IO ()
dbInsertGame connString tableId Game {..} = do
  timestamp <- getCurrentTime
  runAction connString (insert (gameEntity timestamp))
  return ()
  where
    gameEntity timestamp =
      GameEntity
        { gameEntityTableID = tableId,
          gameEntityCreatedAt = timestamp,
          gameEntityPlayers = _players,
          gameEntityMinBuyInChips = unChips _minBuyInChips,
          gameEntityMaxBuyInChips = unChips _maxBuyInChips,
          gameEntityMaxPlayers = _maxPlayers,
          gameEntityBoard = _board,
          gameEntityWinners = _winners,
          gameEntityWaitlist = _waitlist,
          gameEntityDeck = unDeck _deck,
          gameEntitySmallBlind = _smallBlind,
          gameEntityBigBlind = _bigBlind,
          gameEntityStreet = _street,
          gameEntityPot = unChips _pot,
          gameEntityMaxBet = unChips _maxBet,
          gameEntityDealer = _dealer,
          gameEntityCurrentPosToAct = _currentPosToAct
        }

-- TODO - Ensure that chips in play are also taking into account when
-- determining which available chips counts to refill for plays with low balances
dbRefillAvailableChips :: ConnectionString -> Int -> IO ()
dbRefillAvailableChips connString refillThreshold =
  runAction
    connString
    ( updateWhere
        [UserEntityAvailableChips <. refillThreshold]
        [UserEntityAvailableChips =. refillThreshold]
    )


================================================
FILE: server/src/Env.hs
================================================
{-# LANGUAGE OverloadedStrings #-}

module Env where

import qualified Data.ByteString.Char8 as C
import Data.ByteString.UTF8 as BSU (fromString)
import Data.Maybe (Maybe (Just, Nothing), maybe)
import Data.Text (pack)
import Database.Redis
  ( ConnectInfo,
    Redis,
    connect,
    connectHost,
    connectPort,
    defaultConnectInfo,
    parseConnectInfo,
    runRedis,
    setex,
  )
import System.Environment (lookupEnv)
import Text.Read (readMaybe)
import Web.JWT (secret)
import Prelude

getRedisHostFromEnv :: String -> IO ConnectInfo
getRedisHostFromEnv defaultHostName = do
  maybeConnInfo <- lookupEnv "redisHost"
  case maybeConnInfo of
    Nothing -> do
      print "couldn't parse redishost from env default used"
      return defaultRedisConn
    Just hostname -> do
      print "Redis host name from env is: "
      print hostname
      return $ defaultConnectInfo {connectHost = hostname}
  where
    defaultRedisConn = defaultConnectInfo {connectHost = defaultHostName}

-- get the postgres connection string from dbConnStr env variable
getDBConnStrFromEnv :: IO C.ByteString
getDBConnStrFromEnv = do
  dbConnStr <- lookupEnv "dbConnStr"
  case dbConnStr of
    Nothing -> error "Missing dbConnStr in env"
    Just conn -> return $ C.pack conn

-- get the port from the userAPIPort env variable
getAuthAPIPort :: Int -> IO Int
getAuthAPIPort defaultPort = do
  maybeEnvPort <- lookupEnv "authAPIPort"
  case maybeEnvPort of
    Nothing -> return defaultPort
    Just port -> maybe (return defaultPort) return (readMaybe port)

-- get the port from the socketAPIPort env variable
getSocketAPIPort :: Int -> IO Int
getSocketAPIPort defaultPort = do
  maybeEnvPort <- lookupEnv "socketPort"
  case maybeEnvPort of
    Nothing -> return defaultPort
    Just port -> maybe (return defaultPort) return (readMaybe port)

-- get the secret key for signing JWT authentication tokens
getSecretKey :: IO C.ByteString
getSecretKey = do
  maybeSecretKey <- lookupEnv "secret"
  case maybeSecretKey of
    Nothing -> error "Missing secret key in env"
    Just s -> return $ BSU.fromString s


================================================
FILE: server/src/Poker/ActionValidation.hs
================================================
--  TODO - should factor out the hasEnoughChips check for each action and then just sequence it
--  inside the parent validateAction function with >>
--
-- Second TODo - remove use of fromJust
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Poker.ActionValidation where

import Control.Monad (when)
import Control.Monad.State.Lazy (when)
import Data.List (elemIndex, find)
import qualified Data.List.Safe as Safe
import Data.Maybe (fromJust, isNothing)
import Data.Text (Text)
import qualified Data.Text as T
import Poker.Game.Blinds (blindRequiredByPlayer)
import Poker.Game.Game
  ( doesPlayerHaveToAct,
    getWinners,
  )
import Poker.Game.Utils
  ( getActivePlayers,
    getGamePlayer,
    getGamePlayerNames,
    getGamePlayerState,
    getPlayerNames,
  )
import Poker.Types


validateAction :: Game -> PlayerName -> Action -> Either GameErr ()
validateAction game@Game {..} name' = \case
  PostBlind blind ->
    when (_maxBet > 0) (isPlayerActingOutOfTurn game name')
      >> checkPlayerSatAtTable game name'
      >> canPostBlind game name' blind
      >> validateBlindAction game name' blind
  Check -> isPlayerActingOutOfTurn game name' >> canCheck name' game
  Fold -> isPlayerActingOutOfTurn game name' >> canFold name' game
  Bet amount -> isPlayerActingOutOfTurn game name' >> canBet name' amount game
  Raise amount ->
    isPlayerActingOutOfTurn game name' >> canRaise name' amount game
  Call -> isPlayerActingOutOfTurn game name' >> canCall name' game
  Timeout -> canTimeout name' game
  LeaveSeat' -> canLeaveSeat name' game
  SitDown plyr -> canSit plyr game
  SitOut -> checkPlayerSatAtTable game name' >> canSitOut name' game
  SitIn -> checkPlayerSatAtTable game name' >> canSitIn name' game
  ShowHand -> validateShowOrMuckHand game name' ShowHand
  MuckHand -> validateShowOrMuckHand game name' MuckHand

-- Cannot post a blind to start a game unless at least two active players are present.
-- An active player is one whose playerStatus is set to In.
canPostBlind :: Game -> PlayerName -> Blind -> Either GameErr ()
canPostBlind game@Game {..} name blind
  | _street /= PreDeal = Left $ InvalidMove name InvalidActionForStreet
  | activePlayersCount < 2 =
    Left $
      InvalidMove name $
        CannotPostBlind
          "Cannot post blind unless a minimum of two active players are sat at table"
  | otherwise = case blind of
    BigBlind -> if unChips chipCount < _bigBlind then notEnoughChipsErr else Right ()
    SmallBlind -> if unChips chipCount < _smallBlind then notEnoughChipsErr else Right ()
  where
    chipCount = _chips $ fromJust $ getGamePlayer game name
    activePlayersCount = length $ getActivePlayers _players
    notEnoughChipsErr = Left $ InvalidMove name NotEnoughChipsForAction

-- | The first player to post their blinds in the predeal stage can do it from any
-- position as long as there aren't enough players sat in to start a game
-- Therefore the acting in turn rule wont apply for that first move
-- when (< 2 players state set to sat in)
isPlayerActingOutOfTurn :: Game -> PlayerName -> Either GameErr ()
isPlayerActingOutOfTurn game@Game {..} name
  | isNewGame = Right () -- Only Permit First Blind Posting to Be at Any Position When
  -- starting new Game"
  | currPosToActOutOfBounds = error "_currentPosToAct too big"
  | isNothing _currentPosToAct && _street /= PreDeal = Left $ InvalidMove name $ NoPlayerCanAct
  | fromJust _currentPosToAct < 0 = error "_currentPosToAct player < 0"
  | otherwise = case name `elemIndex` gamePlayerNames of
    Nothing -> Left $ NotAtTable name
    Just pos ->
      if doesPlayerHaveToAct name game
        then Right ()
        else
          Left $
            InvalidMove name $
              OutOfTurn $
                CurrentPlayerToActErr $
                  gamePlayerNames
                    !! fromJust _currentPosToAct
  where
    gamePlayerNames = getGamePlayerNames game
    numberOfPlayersSatIn =
      length $ filter (\Player {..} -> _playerStatus /= InHand Folded) _players
    currPosToActOutOfBounds =
      maybe False ((length _players - 1) <) _currentPosToAct
    isNewGame = _street == PreDeal && isNothing _currentPosToAct

checkPlayerSatAtTable :: Game -> PlayerName -> Either GameErr ()
checkPlayerSatAtTable game@Game {..} name
  | not atTable = Left $ NotAtTable name
  | otherwise = Right ()
  where
    playerNames = getGamePlayerNames game
    atTable = name `elem` playerNames

canTimeout :: PlayerName -> Game -> Either GameErr ()
canTimeout name game@Game {..}
  | _street == Showdown = Left $ InvalidMove name InvalidActionForStreet
  | otherwise = isPlayerActingOutOfTurn game name

canBet :: PlayerName -> Chips -> Game -> Either GameErr ()
canBet name amount game@Game {..}
  | unChips amount < _bigBlind =
    Left $ InvalidMove name BetLessThanBigBlind
  | amount > chipCount =
    Left $ InvalidMove name NotEnoughChipsForAction
  | _street == Showdown || _street == PreDeal =
    Left $ InvalidMove name InvalidActionForStreet
  | _maxBet > 0 && _street /= PreFlop =
    Left $
      InvalidMove name $
        CannotBetShouldRaiseInstead
          "A bet can only be carried out if no preceding player has bet"
  | otherwise =
    Right ()
  where
    chipCount = _chips $ fromJust $ getGamePlayer game name

-- Keep in mind that a player can always raise all in,
-- even if their total chip count is less than what
-- a min-bet or min-raise would be.
canRaise :: PlayerName -> Chips -> Game -> Either GameErr ()
canRaise name amount game@Game {..}
  | _street == Showdown || _street == PreDeal =
    Left $ InvalidMove name InvalidActionForStreet
  | _street == PreFlop && unChips _maxBet == _bigBlind =
    Left $ InvalidMove name CannotRaiseShouldBetInstead -- a blind doesnt count as a sufficient bet to qualify a raise
  | _maxBet == 0 =
    Left $ InvalidMove name CannotRaiseShouldBetInstead
  | amount < minRaise && amount /= chipCount =
    Left $ InvalidMove name $ RaiseAmountBelowMinRaise $ unChips minRaise
  | amount > chipCount =
    Left $ InvalidMove name NotEnoughChipsForAction
  | otherwise =
    Right ()
  where
    minRaise = 2 * _maxBet
    chipCount = _chips $ fromJust $ getGamePlayer game name

canCheck :: PlayerName -> Game -> Either GameErr ()
canCheck name Game {..}
  | _street == PreFlop && fromCommittedChips _committed < _bigBlind =
    Left $
      InvalidMove name CannotCheckShouldCallRaiseOrFold
  | _street == Showdown || _street == PreDeal =
    Left $
      InvalidMove name InvalidActionForStreet
  | fromCommittedChips _committed < unChips _maxBet =
    Left $
      InvalidMove name CannotCheckShouldCallRaiseOrFold
  | otherwise = Right ()
  where
    Player {..} = fromJust $ find (\Player {..} -> _playerName == name) _players

canFold :: PlayerName -> Game -> Either GameErr ()
canFold name Game {..}
  | _street == Showdown || _street == PreDeal =
    Left $
      InvalidMove name InvalidActionForStreet
  | otherwise = Right ()

canCall :: PlayerName -> Game -> Either GameErr ()
canCall name game@Game {..}
  | _street == Showdown || _street == PreDeal =
    Left $
      InvalidMove name InvalidActionForStreet
  | amountNeededToCall == 0 =
    Left $
      InvalidMove name CannotCallZeroAmountCheckOrBetInstead
  | otherwise = Right ()
  where
    p = fromJust (getGamePlayer game name)
    chipCount = _chips p
    amountNeededToCall = _maxBet - _bet p

canSit :: Player -> Game -> Either GameErr ()
canSit player@Player {..} game@Game {..}
  | _street /= PreDeal =
    Left $
      InvalidMove _playerName CannotSitDownOutsidePreDeal
  | _playerName `elem` getPlayerNames _players =
    Left $
      AlreadySatAtTable _playerName
  | _chips < _minBuyInChips = Left $ NotEnoughChips _playerName
  | _chips > _maxBuyInChips = Left $ OverMaxChipsBuyIn _playerName
  | length _players < _maxPlayers = Right ()
  | otherwise = Left $ CannotSitAtFullTable _playerName

canSitOut :: PlayerName -> Game -> Either GameErr ()
canSitOut name game@Game {..}
  | _street /= PreDeal = Left $ InvalidMove name CannotSitOutOutsidePreDeal
  | isNothing currentState = Left $ NotAtTable name
  | currentState == Just SatOut = Left $ InvalidMove name AlreadySatOut
  | otherwise = Right ()
  where
    currentState = getGamePlayerState game name

canSitIn :: PlayerName -> Game -> Either GameErr ()
canSitIn name game@Game {..}
  | _street /= PreDeal = Left $ InvalidMove name CannotSitInOutsidePreDeal
  | isNothing pState = Left $ NotAtTable name
  | maybe False satIn pState = Left $ InvalidMove name AlreadySatIn
  | otherwise = Right ()
  where
    pState = getGamePlayerState game name

canLeaveSeat :: PlayerName -> Game -> Either GameErr ()
canLeaveSeat playerName game@Game {..}
  | _street /= PreDeal =
    Left $
      InvalidMove playerName CannotLeaveSeatOutsidePreDeal
  | playerName `notElem` getPlayerNames _players = Left $ NotAtTable playerName
  | otherwise = Right ()

canJoinWaitList :: Player -> Game -> Either GameErr ()
canJoinWaitList player@Player {..} game@Game {..}
  | _playerName `elem` _waitlist = Left $ AlreadyOnWaitlist _playerName
  | otherwise = Right ()

validateBlindAction :: Game -> PlayerName -> Blind -> Either GameErr ()
validateBlindAction game@Game {..} playerName blind
  | _street /= PreDeal =
    Left $
      InvalidMove playerName CannotPostBlindOutsidePreDeal
  | otherwise = case getGamePlayer game playerName of
    Nothing -> Left $ PlayerNotAtTable playerName
    Just p@Player {..} -> case blindRequired of
      Nothing -> Left $ InvalidMove playerName BlindNotRequired
      Just SmallBlind ->
        if blind == SmallBlind
          then
            if fromCommittedChips _committed >= _smallBlind
              then Left $ InvalidMove playerName $ BlindAlreadyPosted SmallBlind
              else Right ()
          else Left $ InvalidMove playerName $ BlindRequiredErr SmallBlind
      Just BigBlind ->
        if blind == BigBlind
          then
            if fromCommittedChips _committed >= bigBlindValue
              then Left $ InvalidMove playerName $ BlindAlreadyPosted BigBlind
              else Right ()
          else Left $ InvalidMove playerName $ BlindRequiredErr BigBlind
      where
        blindRequired = blindRequiredByPlayer game playerName
        bigBlindValue = _smallBlind * 2

validateShowOrMuckHand :: Game -> PlayerName -> Action -> Either GameErr ()
validateShowOrMuckHand game@Game {..} name action =
  checkPlayerSatAtTable game name

-- Should Tell us if everyone has folded to the given playerName
-- and the hand is over
canShowOrMuckHand :: PlayerName -> Game -> Either GameErr ()
canShowOrMuckHand name game@Game {..}
  | _street /= Showdown = Left $ InvalidMove name InvalidActionForStreet
  | otherwise = case _winners of
    SinglePlayerShowdown winningPlayerName ->
      if winningPlayerName == name
        then Right ()
        else
          Left $
            InvalidMove name $
              CannotShowHandOrMuckHand
                "Not winner of hand"
    MultiPlayerShowdown _ ->
      Left $
        InvalidMove name $
          CannotShowHandOrMuckHand
            "Can only show or muck cards if winner of single player pot during showdown"


================================================
FILE: server/src/Poker/Game/Actions.hs
================================================
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}

module Poker.Game.Actions where

import Control.Lens ((%~), (&), (+~), (-~), (.~), (<>~), (^.))
import Control.Monad.State (Functor)
import Data.Bool (Bool (False, True), bool)
import Data.Char (toLower)
import Data.List (filter, find, findIndex, sum)
import qualified Data.List.Safe as Safe
import Data.Maybe (fromJust)
import Poker.Game.Blinds (getPosNextBlind)
import Poker.Game.Game (nextPosToAct)
import Poker.Types
import Text.Read (readMaybe)
import Prelude



makeBet :: Bool -> Chips -> PlayerName -> Game -> Game
makeBet isCall betSize pName game@Game {..} =
  updateMaxBet betSize game
    & (players %~ placePlayerBet)
      . (currentPosToAct %~ nextPosToAct _players)
      . (pot +~ betSize)
  where
    placePlayerBet = (<$>) $
      \p@Player {..} ->
        if _playerName == pName
          then placeBet isCall betSize p
          else p

-- Update table maxBet and pot as well as player state and chip count
placeBet :: Bool -> Chips -> Player -> Player
placeBet isCall betSize plyr =
  let chips' = plyr ^. chips
   in plyr
        & (chips -~ betSize)
          . (bet <>~ betSize)
          . (committed <>~ CommittedChips (unChips betSize))
          . ( playerStatus
                %~ nextPlayerStatus
                  chips'
                  (bool Call (Bet betSize) isCall)
            )

nextPlayerStatus :: Chips -> Action -> PlayerStatus -> PlayerStatus
nextPlayerStatus (Chips 0) _ _ = InHand AllIn
nextPlayerStatus _ Fold _ = InHand Folded
nextPlayerStatus _ Check playerStatus =
  InHand $ CanAct $ pure Checked
nextPlayerStatus _ Call playerStatus =
  InHand $ CanAct $ pure $ MadeBet HasCalled
nextPlayerStatus _ (Bet size) playerStatus =
  InHand $ CanAct $ pure $ MadeBet $ HasBet size
nextPlayerStatus _ (Raise size) playerStatus =
  InHand $ CanAct $ pure $ MadeBet $ HasRaised size
nextPlayerStatus _ (PostBlind blind) playerStatus =
  SatIn HasPlayedLastHand $ PostedBlind blind
nextPlayerStatus _ SitIn playerStatus =
  SatIn HasPlayedLastHand NotPostedBlind
nextPlayerStatus _ Timeout playerStatus = playerStatus
nextPlayerStatus _ SitOut playerStatus = SatOut
nextPlayerStatus _ _ playerStatus = playerStatus



updateMaxBet :: Chips -> Game -> Game
updateMaxBet amount = maxBet %~ max amount

markInForHand :: Player -> Player
markInForHand = playerStatus .~ InHand (CanAct Nothing)

-- Will increment the game's current position to act to the next position
-- where a blind is required. Skipping players that do not have to post blinds
-- during the PreDeal phase of the game is desirable as by definition
-- the only possible players actions during the PreDeal phase are to either:
--   1. Sit out of the game
--   2. Post a blind.
postBlind :: Blind -> PlayerName -> Game -> Game
postBlind blind pName game@Game {..} =
  -- hack because I dont know lens
  let game' = makeBet False (Chips blindValue) pName game
   in game'
        & (pot +~ Chips blindValue)
          . (currentPosToAct .~ pure nextRequiredBlindPos)
          . (maxBet .~ newMaxBet)
  where
    isFirstBlind = sum ((\Player {..} -> _bet) <$> _players) == 0
    gamePlayerNames = (\Player {..} -> _playerName) <$> _players
    blindValue = if blind == SmallBlind then _smallBlind else _bigBlind
    newMaxBet = Chips $ if blindValue > unChips _maxBet then blindValue else unChips _maxBet
    positionOfBlindPoster = fromJust $ findIndex ((== pName) . (^. playerName)) _players
    nextRequiredBlindPos = getPosNextBlind positionOfBlindPoster game

foldCards :: PlayerName -> Game -> Game
foldCards pName game@Game {..} =
  game & (players .~ newPlayers) . (currentPosToAct %~ nextPosToAct _players)
  where
    newPlayers =
      ( \p@Player {..} ->
          if _playerName == pName
            then p & playerStatus %~ nextPlayerStatus _chips Fold
            else p
      )
        <$> _players

call :: PlayerName -> Game -> Game
call pName game@Game {..} =
  let game' = makeBet True callAmount pName game
   in game'
        & (currentPosToAct %~ nextPosToAct _players)
          . (pot +~ callAmount)
  where
    player = fromJust $ find (\Player {..} -> _playerName == pName) _players
    callAmount =
      let maxBetShortfall = _maxBet - (player ^. bet)
          playerChips = player ^. chips
       in if maxBetShortfall > playerChips
            then playerChips
            else maxBetShortfall

check :: PlayerName -> Game -> Game
check pName game@Game {..} =
  game & (players .~ newPlayers) . (currentPosToAct %~ nextPosToAct _players)
  where
    newPlayers =
      ( \p@Player {..} ->
          if _playerName == pName
            then p & playerStatus %~ nextPlayerStatus _chips Check
            else p
      )
        <$> _players

-- Sets state of a given player to SatOut (sat-out)
-- In order to sit in again the player must post a blind
sitOut :: PlayerName -> Game -> Game
sitOut plyrName =
  players
    %~ (<$>)
      ( \p@Player {..} ->
          if _playerName == plyrName
            then Player {_playerStatus = SatOut, ..}
            else p
      )

sitIn :: PlayerName -> Game -> Game
sitIn plyrName =
  players
    %~ (<$>)
      ( \p@Player {..} ->
          if _playerName == plyrName
            then
              Player
                { _playerStatus =
                    SatIn HasNotPlayedLastHand NotPostedBlind,
                  ..
                }
            else p
      )

seatPlayer :: Player -> Game -> Game
seatPlayer plyr = players <>~ pure plyr

joinWaitlist :: Player -> Game -> Game
joinWaitlist plyr = waitlist %~ (:) (plyr ^. playerName)

leaveSeat :: PlayerName -> Game -> Game
leaveSeat plyrName =
  players %~ filter (\Player {..} -> plyrName /= _playerName)


================================================
FILE: server/src/Poker/Game/Blinds.hs
================================================
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}

module Poker.Game.Blinds where

import Control.Lens ((%~), (&))
import Control.Monad.State ()
import Data.Char (toLower)
import Data.List (all, find, length, splitAt, tail, zip, zipWith)
import qualified Data.List.Safe as Safe
import Data.Maybe
import Data.Monoid ((<>))
import Data.Text (Text)
import Poker.Game.Utils
  ( getGamePlayer,
    getPlayerNames,
    getPlayerPosition,
    modInc,
  )
import Poker.Types
import Text.Read (readMaybe)
import Prelude

-- Gets the player position where the next required blind is
-- This function always us timeout players in the blinds stage if they don't post
-- the required blinds in order
getPosNextBlind :: Int -> Game -> Int
getPosNextBlind currIx game@Game {..} = nextIx
  where
    iplayers = zip [0 ..] _players
    iplayers' = let (a, b) = splitAt currIx iplayers in b <> a
    (nextIx, nextPlayer) =
      fromJust $
        find
          ( \(_, p@Player {..}) ->
              isJust $ blindRequiredByPlayer game _playerName
          )
          (tail iplayers')

haveRequiredBlindsBeenPosted :: Game -> Bool
haveRequiredBlindsBeenPosted game@Game {..} =
  all (== True) $
    zipWith
      ( \requiredBlind Player {..} -> case requiredBlind of
          Nothing -> True
          Just BigBlind -> fromCommittedChips _committed == _bigBlind
          Just SmallBlind -> fromCommittedChips _committed == _smallBlind
      )
      requiredBlinds
      _players
  where
    requiredBlinds = getRequiredBlinds game

getRequiredBlinds :: Game -> [Maybe Blind]
getRequiredBlinds game@Game {..}
  | _street /= PreDeal = []
  | otherwise = blindRequiredByPlayer game <$> getPlayerNames _players

-- We use the list of required blinds to calculate if a player has posted
-- chips sufficient to be "In" for this hand.
activatePlayersWhenNoBlindNeeded :: [Maybe Blind] -> [Player] -> [Player]
activatePlayersWhenNoBlindNeeded = zipWith updatePlayer
  where
    updatePlayer blindReq Player {..} =
      Player
        { _playerStatus =
            if isNothing blindReq
              then InHand (CanAct Nothing)
              else _playerStatus,
          ..
        }

-- Sets player state to in if they don't need to post blind
updatePlayersInHand :: Game -> Game
updatePlayersInHand game =
  game & (players %~ activatePlayersWhenNoBlindNeeded (getRequiredBlinds game))

getSmallBlindPosition :: [Text] -> Int -> Int
getSmallBlindPosition playersSatIn dealerPos =
  if length playersSatIn == 2
    then dealerPos
    else modInc incAmount dealerPos (length playersSatIn - 1)
  where
    incAmount = 1

-- if a player does not post their blind at the appropriate time then their state will be changed to
-- SatOut signifying that they have a seat but are now sat out
-- blind is required either if player is sitting in bigBlind or smallBlind position relative to dealer
-- or if their current playerStatus is set to Out
-- If no blind is required for the player to remain In for the next hand then we will return Nothing
blindRequiredByPlayer :: Game -> PlayerName -> Maybe Blind
blindRequiredByPlayer game playerName
  | playerPosition == smallBlindPos =
    Just SmallBlind
  | playerPosition == bigBlindPos = Just BigBlind
  | otherwise = Nothing
  where
    player = fromJust $ getGamePlayer game playerName
    playerNames = getPlayerNames (_players game)
    playerPosition = fromJust $ getPlayerPosition playerNames playerName
    smallBlindPos = getSmallBlindPosition playerNames (_dealer game)
    incAmount = 1
    bigBlindPos = modInc incAmount smallBlindPos (length playerNames - 1)


================================================
FILE: server/src/Poker/Game/Game.hs
================================================
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}

module Poker.Game.Game where

import Control.Lens (Field2 (_2), (%~), (&), (.~), (?~), (^.))
import Data.List (find, mapAccumR)
import qualified Data.List.Safe as Safe
import Data.Maybe (fromJust, isNothing)
import Data.Text (Text)
import Poker.Game.Blinds
import Poker.Game.Hands (value)
import Poker.Game.Utils
import Poker.Types

-- | Returns both the dealt players and remaining cards left in deck.
-- We return the new deck for the purposes of dealing the board cards
-- over the remaining course of the hand.
dealToPlayers :: Deck -> [Player] -> (Deck, [Player])
dealToPlayers =
  mapAccumR
    ( \deck player ->
        if player ^. playerStatus == InHand (CanAct Nothing)
          then
            let (pocketCs, remainingDeck) = dealPockets deck
             in (remainingDeck, (pockets ?~ pocketCs) player)
          else (deck, player)
    )

dealPockets :: Deck -> (PocketCards, Deck)
dealPockets (Deck cs) = (PocketCards fstC sndC, Deck remainingDeck)
  where
    ([fstC, sndC], remainingDeck) = splitAt 2 cs

dealBoardCards :: Int -> Game -> Game
dealBoardCards n game@Game {..} =
  Game
    { _board = _board <> boardCards,
      _deck = Deck shuffledDeck,
      ..
    }
  where
    (boardCards, shuffledDeck) = splitAt n (unDeck _deck)

deal :: Game -> Game
deal game@Game {..} =
  Game
    { _players = dealtPlayers,
      _deck = remainingDeck,
      ..
    }
  where
    (remainingDeck, dealtPlayers) = dealToPlayers _deck _players

-- Gets the next data constructor of the Street which represents
-- the name of the next game stage.
-- The term Street is poker terminology for hand stage.
getNextStreet :: Street -> Street
getNextStreet Showdown = minBound
getNextStreet _street = succ _street

initPlayer :: Text -> Int -> Player
initPlayer playerName chips =
  Player
    { _pockets = Nothing,
      _playerStatus = SatIn HasNotPlayedLastHand NotPostedBlind,
      _playerName = playerName,
      _bet = 0,
      _possibleActions = [],
      _committed = CommittedChips 0,
      _chips = Chips chips
    }

-- Everytime the game progresses to another street we need to
-- reset player statuses if the player has the possibility of acting
-- this street, that is the player has not folded or still has chips left
-- to make further bets.
nextHandStatus :: Chips -> PlayerStatus -> PlayerStatus
nextHandStatus (Chips 0) _ = SatOut
nextHandStatus _ a@(InHand _) = SatIn HasPlayedLastHand NotPostedBlind
nextHandStatus _ SatOut = SatIn HasNotPlayedLastHand NotPostedBlind
nextHandStatus _ (SatIn playedLastHand hasPostedBlind) = SatIn playedLastHand hasPostedBlind

-- Update active players states to prepare them for the next hand.
nextHandPlayer :: Player -> Player
nextHandPlayer Player {..} =
  Player
    { _pockets = Nothing,
      _playerStatus = nextHandStatus _chips _playerStatus,
      _committed = CommittedChips 0,
      ..
    }

nextHandPlayers :: Game -> Game
nextHandPlayers = players %~ (<$>) nextHandPlayer

-- Everytime the game progresses to another street we need to
-- reset player statuses if the player has the possibility of acting
-- this street, that is the player has not folded or still has chips left
-- to make further bets.
nextStreetStatus :: PlayerStatus -> PlayerStatus
nextStreetStatus (InHand AllIn) = InHand AllIn
nextStreetStatus (InHand Folded) = InHand Folded
nextStreetStatus (InHand _) = InHand $ CanAct Nothing
nextStreetStatus s = s

nextStreetPlayers :: Game -> Game
nextStreetPlayers = players %~ (<$>) (playerStatus %~ nextStreetStatus)

updatePosToAct :: Game -> Game
updatePosToAct g = g & currentPosToAct %~ nextPosToAct (_players g)

-- Unless in the scenario where everyone is all in
-- if no further player actions are possible (i.e betting has finished)
-- then actedThisTurn should be set to True for all active players in Hand.
-- This scenario occurs when all players or all but one players are all in.
--updatePlayerStatus :: Street -> PlayerStatus -> PlayerStatus
--updatePlayerStatus PreFlop = (bet .~ 0) . (Pla .~ False) <$> _players

-- When there are only two players in game (Heads Up) then the first player
-- to act PreFlop is the player at the dealer position.
-- First player to act is the player sitting to the right of the player
-- in the big blind position
progressToPreFlop :: Game -> Game
progressToPreFlop game@Game {..} =
  game
    & (street .~ PreFlop)
      . (currentPosToAct .~ firstPosToAct)
      . deal
      . nextStreetPlayers
  where
    firstPosToAct
      | countActive _players == 2 = pure _dealer
      | -- When heads up dealer goes first
        otherwise =
        nextPosToAct _players _currentPosToAct

progressToFlop :: Game -> Game
progressToFlop game
  | allButOneAllIn (_players game) =
    game & (street .~ Flop) . dealBoardCards 3
  | otherwise =
    game
      & (street .~ Flop)
        . updatePosToAct
        . (maxBet .~ 0)
        . dealBoardCards 3
        . nextStreetPlayers

progressToTurn :: Game -> Game
progressToTurn game
  | allButOneAllIn (_players game) =
    game & (street .~ Turn) . dealBoardCards 1
  | otherwise =
    game
      & (street .~ Turn)
        . (maxBet .~ 0)
        . updatePosToAct
        . dealBoardCards 1
        . nextStreetPlayers

progressToRiver :: Game -> Game
progressToRiver game@Game {..}
  | allButOneAllIn _players =
    game & (street .~ River) . dealBoardCards 1
  | otherwise =
    game
      & (street .~ River)
        . (maxBet .~ 0)
        . updatePosToAct
        . dealBoardCards 1
        . nextStreetPlayers

progressToShowdown :: Game -> Game
progressToShowdown game@Game {..} =
  game
    & (street .~ Showdown)
      . (winners .~ winners')
      . (currentPosToAct .~ Nothing)
      . (players .~ awardedPlayers)
      . (currentPosToAct .~ Nothing)
  where
    winners' = getWinners game
    awardedPlayers = awardWinners _players (unChips _pot) winners'

-- need to give players the chips they are due and split pot if necessary
-- if only one active player then this is a result of everyone else folding
-- and they are awarded the entire pot
--
-- If only one player is active during the showdown stage then this means all other players
-- folded to him. The winning player then has the choice of whether to "muck"
-- (not show) his cards or not.
-- SinglePlayerShowdown occurs when everyone folds to one player
awardWinners :: [Player] -> Int -> Winners -> [Player]
awardWinners _players pot' = \case
  MultiPlayerShowdown winners' ->
    let chipsPerPlayer = pot' `div` length winners'
        playerNames = snd <$> winners'
     in ( \p@Player {..} ->
            if _playerName `elem` playerNames
              then Player {_chips = _chips <> (Chips chipsPerPlayer), ..}
              else p
        )
          <$> _players
  SinglePlayerShowdown _ ->
    ( \p@Player {..} ->
        if p `elem` getActivePlayers _players
          then Player {_chips = _chips <> (Chips pot'), ..}
          else p
    )
      <$> _players

-- Can we show the active players' pocket cards to the world? Only if everyone is all in
-- (no more than 1 player not all (> 0 chips) per pot and every player has acted
canPubliciseActivesCards :: Game -> Bool
canPubliciseActivesCards g =
  allButOneAllIn (_players g)
    || multiplayerShowdown
  where
    multiplayerShowdown =
      _street g == Showdown && isMultiPlayerShowdown (_winners g)

-- TODO move players from waitlist to players list
-- TODO need to send msg to players on waitlist when a seat frees up to inform them
-- to choose a seat and set limit for them t pick one
-- TODO - have newBlindNeeded field which new players will initially be put into in order to
-- ensure they cant play without posting a blind before the blind position comes round to them
-- new players can of course post their blinds early. In the case of an early posting the initial
-- blind must be the big blind. After this 'early' blind or the posting of a normal blind in turn the
-- new player will be removed from the newBlindNeeded field and can play normally.
getNextHand :: Game -> Deck -> Game
getNextHand Game {..} shuffledDeck =
  Game
    { _waitlist = newWaitlist,
      _maxBet = 0,
      _players = newPlayers,
      _board = [],
      _deck = shuffledDeck,
      _winners = NoWinners,
      _street = PreDeal,
      _dealer = newDealer,
      _pot = 0,
      _currentPosToAct = Just nextPlayerToAct,
      ..
    }
  where
    incAmount = 1
    newDealer = modInc incAmount _dealer (length (getPlayersSatIn _players) - 1)
    freeSeatsNo = _maxPlayers - length _players
    newPlayers =
      filterSatOutPlayers $
        filterPlayersWithLtChips _bigBlind $
          nextHandPlayer
            <$> _players
    newWaitlist = drop freeSeatsNo _waitlist
    nextPlayerToAct = modInc incAmount newDealer (length newPlayers - 1)

-- | If all players have acted and their bets are equal
-- to the max bet then we can move to the next stage
haveAllPlayersActed :: Game -> Bool
haveAllPlayersActed g@Game {..}
  | _street == Showdown = True
  | _street == PreDeal = haveRequiredBlindsBeenPosted g
  | length activePlayers < 2 = True
  | otherwise = not (awaitingPlayerAction g)
  where
    activePlayers = getActivePlayers _players

awaitingPlayerAction :: Game -> Bool
awaitingPlayerAction Game {..} =
  length activePlayers >= 2 && any (callNeeded _maxBet) activePlayers
  where
    activePlayers = getActivePlayers _players
    callNeeded maxBet' Player {..} =
      canAct _playerStatus == PlayerCanAct
        && unChips _chips > 0
        && _bet < maxBet'

-- If all players have folded apart from a remaining player then the mucked boolean
-- inside the player value will determine if we show the remaining players hand to the
-- table.
--
-- Otherwise we just get the handrankings of all active players.
getWinners :: Game -> Winners
getWinners game@Game {..} =
  if allButOneFolded _players
    then
      SinglePlayerShowdown $
        head $
          flip (^.) playerName
            <$> filter (\Player {..} -> _playerStatus /= InHand Folded) _players
    else MultiPlayerShowdown $ maximums $ getHandRankings _players _board

-- Return the best hands and the active players (playerStatus of In) who hold
-- those hands.
--
-- If more than one player holds the same winning hand then the second part
-- of the tuple will consist of all the players holding the hand
getHandRankings ::
  [Player] -> [Card] -> [((HandRank, PlayerShowdownHand), PlayerName)]
getHandRankings plyrs boardCards =
  ( \(showdownHand, Player {..}) ->
      ((_2 %~ PlayerShowdownHand) showdownHand, _playerName)
  )
    <$> map
      ( \plyr@Player {..} ->
          let showHand = (++ boardCards) $ unPocketCards $ fromJust _pockets
           in (value showHand, plyr)
      )
      remainingPlayersInHand
  where
    remainingPlayersInHand = getActivePlayers plyrs

-- During PreDeal we start timing out players who do not post their respective blinds
-- in turn after an initial blind has been posted
--
-- No player is forced to post first blind during PreDeal (blind betting stage).
--
-- Important to note that this function is mainly for asserting whether we need to
-- time a player's action. Player actions which are not mandatory such as posting a blind
-- to start a game will not be timed actions.
--
-- All possible player actions are either compulsary or optional. For example SitIn as a player is never forced to play a game. However if a player is already active in an
-- ongoing hand then all future actions for this hand will be mandatory and therefore timed so that a given
-- player cannot postpone the game through inactivity for an indefinite amount of time.
--
-- Optional actions as as SitIn (changing player state to In to denote that they are active this hand)
-- would return False in this function.
--
-- PostBlind actions are trickier. Depending on the context they will be compulsary or optional.
-- True is for a situation where the continued progression
-- of the game in a satisfactory timeframe is determined by the expediancy of the current
-- player's action.
doesPlayerHaveToAct :: Text -> Game -> Bool
doesPlayerHaveToAct playerName game@Game {..}
  | length _players < 2 = False
  | not $ inPositionToAct playerName game = False
  | isNothing _currentPosToAct = False
  | otherwise =
    if currPosToActOutOfBounds
      then error $ "_currentPosToAct too large " <> show game
      else case _players Safe.!! fromJust _currentPosToAct of
        Nothing -> False
        Just Player {..}
          | unChips _chips == 0 ->
            False
          | _street
              == Showdown
              || countActive _players < 2
              || haveAllPlayersActed game
              || (PlayerCannotAct == canAct _playerStatus)
              || _street
              == PreDeal && _maxBet
              == 0 ->
            False
          | _street == PreDeal ->
            _playerName
              == playerName
              && ( isNothing $
                     blindRequiredByPlayer game playerName
                 )
          | otherwise ->
            _playerName == playerName
  where
    currPosToActOutOfBounds =
      maybe False ((length _players - 1) <) _currentPosToAct

-- returns the index of the next active player with chips after the given current index who has chips
--
-- return a Nothing if everyone is all in and we cannot increment the position since
-- there are no players who can act

-- updates position to next player if there is another player who can act otherwise
-- return the same position

-- second param is the position we start from when calculating the next position to act
-- unless this is the beginning of the next stage then the initialPos == _currentPosToAct
nextIxPlayerToAct :: [Player] -> Maybe Int -> Maybe (Int, Player)
nextIxPlayerToAct ps = nextIPlayer
  where
    iplayers = zip [0 ..] ps
    iplayers' currPosToAct =
      let (a, b) = splitAt currPosToAct iplayers in b <> a
    nextIPlayer = \case
      Nothing -> Nothing
      Just currPos ->
        let nextIxPlayerToAct = tail $ iplayers' currPos
         in find
              (\(_, Player {..}) -> PlayerCanAct == canAct _playerStatus)
              nextIxPlayerToAct

-- gets the position of the next player which needs to act
-- if currentPosToAct is already a Nothing then this means we are starting a new hand
-- and will just return the initial player to act for a new hand
nextPosToAct :: [Player] -> Maybe Int -> Maybe Int
nextPosToAct ps currPostToAct
  | status == EveryoneFolded = Nothing
  | status == EveryoneAllIn = Nothing
  | status == NotAwaitingPlayerAction = Nothing
  | otherwise = fst <$> nextIxPlayerToAct ps currPostToAct
  where
    activePs = getActivePlayers ps
    activePCount = length activePs
    status = bettingActionStatus ps

-- used to get the initial player to act when progressing to a new game stage
firstPosToAct :: Game -> Maybe Int
firstPosToAct g@Game {..}
  | activePCount == 2 =
    if _street == PreFlop
      then firstPToAct _dealer
      else firstPToAct 1
  | otherwise = if _street == PreFlop then firstPToAct 3 else firstPToAct 1
  where
    activePs = getActivePlayers _players
    activePCount = length activePs
    incPosBy n = Just $ modInc n _dealer (activePCount - 1)
    firstPToAct dealerIncAmount =
      fst
        <$> nextIxPlayerToAct
          _players
          (incPosBy (modDec dealerIncAmount activePCount))

isMultiPlayerShowdown :: Winners -> Bool
isMultiPlayerShowdown (MultiPlayerShowdown _) = True
isMultiPlayerShowdown _ = False

================================================
FILE: server/src/Poker/Game/Hands.hs
================================================
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-}

module Poker.Game.Hands where

import Data.Function (on)
import Data.List (foldl', groupBy, nubBy, sort, sortBy)
import Data.Ord (comparing)
import Poker.Types
  ( Card (rank, suit),
    HandRank (..),
    Rank (Ace, Five, Four, Three, Two),
  )

type RankGroup = Int

value :: [Card] -> (HandRank, [Card])
value hand = maybe (ifNotFlush hand) ifFlush (maybeFlush hand)

ifNotFlush :: [Card] -> (HandRank, [Card])
ifNotFlush hand = maybe (checkGroups hand) (Straight,) (maybeStraight hand)

ifFlush :: [Card] -> (HandRank, [Card])
ifFlush hand =
  maybe (Flush, take 5 hand) (StraightFlush,) (maybeStraight hand)

lastNelems :: Int -> [a] -> [a]
lastNelems n xs = foldl' (const . drop 1) xs (drop n xs)

maybeFlush :: [Card] -> Maybe [Card]
maybeFlush cs
  | length cs' >= 5 = Just cs'
  | otherwise = Nothing
  where
    sortBySuit = sortBy (comparing suit <> flip compare)
    groupBySuit = groupBy ((==) `on` suit)
    cs' = head $ sortByLength $ groupBySuit $ sortBySuit cs

maybeStraight :: [Card] -> Maybe [Card]
maybeStraight cards
  | length cs'' >= 5 = Just (lastNelems 5 cs'')
  | otherwise = maybeWheel cardsUniqRanks
  where
    cardsUniqRanks = nubBy ((==) `on` rank) cards
    cs'' = head $ sortByLength $ groupBySuccCards $ sort cardsUniqRanks

maybeWheel :: [Card] -> Maybe [Card]
maybeWheel cards
  | length filteredCards == 5 = Just filteredCards
  | otherwise = Nothing
  where
    filteredCards =
      (flip elem [Ace, Two, Three, Four, Five] . rank) `filter` cards

checkGroups :: [Card] -> (HandRank, [Card])
checkGroups hand = (hRank, cards)
  where
    groups = sortByLength $ groupBy ((==) `on` rank) $ sort hand
    cards = take 5 $ concat groups
    groupedRankLengths = length <$> groups
    hRank = evalGroupedRanks groupedRankLengths

evalGroupedRanks :: [RankGroup] -> HandRank
evalGroupedRanks = \case
  (4 : _) -> Quads
  (3 : 2 : _) -> FullHouse
  (3 : _) -> Trips
  (2 : 2 : _) -> TwoPair
  (2 : _) -> Pair
  _ -> HighCard

groupBySuccCards :: [Card] -> [[Card]]
groupBySuccCards = foldr f []
  where
    f :: Card -> [[Card]] -> [[Card]]
    f a [] = [[a]]
    f a xs@(x : xs')
      | succ (rank a) == rank (head x) = (a : x) : xs'
      | otherwise = [a] : xs

sortByLength :: Ord a => [[a]] -> [[a]]
sortByLength = sortBy (flip (comparing length) <> flip compare)


================================================
FILE: server/src/Poker/Game/Privacy.hs
================================================
{-
  Logic for excluding sensitive game data from game state.
-}
{-# LANGUAGE RecordWildCards #-}

module Poker.Game.Privacy where

import Control.Lens ((%~), (&), (.~))
import Data.Text (Text)
import Poker.Game.Game (canPubliciseActivesCards)
import Poker.Types

-- For players that are sat in game
excludeOtherPlayerCards :: PlayerName -> Game -> Game
excludeOtherPlayerCards playerName = excludePrivateCards $ Just playerName

--  -- For spectators who aren't in game
excludeAllPlayerCards :: Game -> Game
excludeAllPlayerCards = excludePrivateCards Nothing

-- Exclude player cards and Deck so spectators can't see private cards.
--
-- Takes an optional playerName. If no playerName is given then all private
-- cards are excluded. However if playerName is given then their cards
-- will not be excluded.
--
-- So if a game update is going to be sent to a user then we pass in his playerName
-- so that information that is private to him is not excluded from the
-- Game state (his pocket cards)
--
-- If everyone in the game is AllIn then their pocket cards should all be visible.
--
---- We show all active players cards in the case of every active player being all in
-- or during the final showdown stage of the game
--
-- If they are
-- then all the pocket cards held by players whose _playerStatus
-- is set to In (active and) are public and therefore not removed.
excludePrivateCards :: Maybe PlayerName -> Game -> Game
excludePrivateCards maybePlayerName game =
  game & (players %~ (<$>) pocketCardsPrivacyModifier) . (deck .~ Deck [])
  where
    showAllActivesCards = canPubliciseActivesCards game
    pocketCardsPrivacyModifier =
      maybe
        (updatePocketCardsForSpectator showAllActivesCards)
        (updatePocketCardsForPlayer showAllActivesCards)
        maybePlayerName

updatePocketCardsForSpectator :: Bool -> (Player -> Player)
updatePocketCardsForSpectator showAllActivesCards
  | showAllActivesCards = \player@Player {..} ->
    if _playerStatus /= InHand Folded then player else Player {_pockets = Nothing, ..}
  | otherwise = \Player {..} -> Player {_pockets = Nothing, ..}

updatePocketCardsForPlayer :: Bool -> PlayerName -> (Player -> Player)
updatePocketCardsForPlayer showAllActivesCards playerName
  | showAllActivesCards = \player@Player {..} ->
    if (_playerStatus /= InHand Folded) || (_playerName == playerName)
      then player
      else Player {_pockets = Nothing, ..}
  | otherwise = \player@Player {..} ->
    if _playerName == playerName
      then player
      else Player {_pockets = Nothing, ..}


================================================
FILE: server/src/Poker/Game/Utils.hs
================================================
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}

module Poker.Game.Utils where

import Control.Lens ((^.))
import Data.Bool (bool)
import Data.Foldable (find)
import Data.List (elemIndex, find)
import Data.Map.Lazy (Map)
import qualified Data.Map.Lazy as M
import Data.Text (Text)
import Poker.Types
import System.Random (Random (randomR), RandomGen)

-- | A standard deck of cards.
initialDeck :: Deck
initialDeck = Deck $ Card <$> [minBound ..] <*> [minBound ..]

-- Get a shuffled deck of cards.
shuffledDeck :: RandomGen g => g -> Deck
shuffledDeck gen = Deck <$> fst $ shuffle gen (unDeck initialDeck)

fisherYatesStep :: RandomGen g => (Map Int a, g) -> (Int, a) -> (Map Int a, g)
fisherYatesStep (m, gen) (i, x) =
  ((M.insert j x . M.insert i (m M.! j)) m, gen')
  where
    (j, gen') = randomR (0, i) gen

-- shuffle using the Fisher Yates algorithm
shuffle :: RandomGen g => g -> [a] -> ([a], g)
shuffle gen [] = ([], gen)
shuffle gen l =
  toElems $
    foldl fisherYatesStep (initial (head l) gen) (numerate (tail l))
  where
    toElems (x, y) = (M.elems x, y)
    numerate = zip [1 ..]
    initial x gen = (M.singleton 0 x, gen)

modInc :: Int -> Int -> Int -> Int
modInc incAmount num modulo
  | incNum > modulo = 0
  | otherwise = incNum
  where
    incNum = num + incAmount
    modInc = incNum `mod` modulo

modDec :: Int -> Int -> Int
modDec num modulo
  | decNum < modulo = 0
  | otherwise = decNum
  where
    decNum = num - 1
    modInc = decNum `mod` modulo

-- return players which have the ability to make further moves i.e not all in or folded
-- the distinction between sat in and active is important
-- if a player is sat out then there has been no historical participation in this hand
-- as there can be no future participation in this hand
-- whereas sat in means that the player has at the very least had some historical participation
-- in the current hand
getActivePlayers :: [Player] -> [Player]
getActivePlayers = filter ((==) PlayerCanAct . canAct . _playerStatus)

filterPlayersWithLtChips :: Int -> [Player] -> [Player]
filterPlayersWithLtChips count =
  filter
    ( \Player {..} ->
        unChips _chips >= count
    )

filterSatOutPlayers :: [Player] -> [Player]
filterSatOutPlayers = filter (\Player {..} -> _playerStatus /= SatOut)

countActive :: [Player] -> Int
countActive = length . getActivePlayers

canAct :: PlayerStatus -> CanPlayerAct
canAct (InHand (CanAct _)) = PlayerCanAct
canAct _ = PlayerCannotAct

canPlayersAct :: Functor f => f Player -> f CanPlayerAct
canPlayersAct ps = canAct . _playerStatus <$> ps

canAnyPlayerAct :: [Player] -> Bool
canAnyPlayerAct = elem PlayerCanAct . canPlayersAct

bettingActionStatus :: [Player] -> BettingAction
bettingActionStatus ps
  | allButOneFolded ps = EveryoneFolded
  | playersNotAllIn ps == 1 = EveryoneAllIn
  | canAnyPlayerAct ps = AwaitingPlayerAction
  | not (canAnyPlayerAct ps) = NotAwaitingPlayerAction
  | otherwise = error "undhandled guard"

allButOneAllIn :: [Player] -> Bool
allButOneAllIn = (== 1) . playersNotAllIn

playersNotAllIn :: [Player] -> Int
playersNotAllIn ps
  | numPlayersIn < 2 = 0
  | otherwise = numPlayersIn - numPlayersAllIn
  where
    numPlayersIn = length $ getActivePlayers ps
    numPlayersAllIn =
      length $ filter (\Player {..} -> _playerStatus == InHand AllIn) ps

-- The game should go straight to showdown if all but one players is In hand
allButOneFolded :: [Player] -> Bool
allButOneFolded ps = length playersInHand <= 1
  where
    playersInHand = filter ((== InHand Folded) . (^. playerStatus)) ps

-- get all players who are not currently sat out
getPlayersSatIn :: [Player] -> [Player]
getPlayersSatIn = filter ((/= SatOut) . (^. playerStatus))

-- player position is the order of a given player in the set of all players with a
-- playerStatus of In or in other words the players that are both sat at the table and active
-- return Nothing if the given playerName is not sat at table
getPlayerPosition :: [PlayerName] -> PlayerName -> Maybe Int
getPlayerPosition playersSatIn playerName = playerName `elemIndex` playersSatIn

getPlayerPosition' :: PlayerName -> [Player] -> Maybe Int
getPlayerPosition' playerName = flip getPlayerPosition playerName . getPlayerNames . getPlayersSatIn

getGameStage :: Game -> Street
getGameStage game = game ^. street

getGamePlayers :: Game -> [Player]
getGamePlayers game = game ^. players

getGamePlayer :: Game -> PlayerName -> Maybe Player
getGamePlayer game playerName =
  find (\Player {..} -> _playerName == playerName) $ _players game

getGamePlayerState :: Game -> PlayerName -> Maybe PlayerStatus
getGamePlayerState game playerName = do
  Player {..} <- getGamePlayer game playerName
  return _playerStatus

getGamePlayerNames :: Game -> [Text]
getGamePlayerNames game = _playerName <$> _players game

getPlayerChipCounts :: Game -> [(Text, Int)]
getPlayerChipCounts Game {..} =
  (\Player {..} -> (_playerName, unChips _chips)) <$> _players

getPlayerNames :: [Player] -> [Text]
getPlayerNames players = (^. playerName) <$> players

-- Nothing for currentPosToAct during Predeal means that the first blind
-- can be posted from any position as this is the first blind to get a new game started
-- on the otherhand a value of Just pos means that pos is the position that we require a blind to
-- be posted from next as a game is underway.
inPositionToAct :: PlayerName -> Game -> Bool
inPositionToAct playerName Game {..} =
  case playerPos of
    Nothing -> False
    Just pos -> case _currentPosToAct of
      Nothing -> _street == PreDeal -- Wheareas Nothing during Predeal means anyone can act
      -- Nothing in currentPostToAct field after predeal means no player can act.
      Just posToAct -> pos == posToAct
  where
    playerPos = getPlayerPosition' playerName _players

maximums :: Ord a => [(a, b)] -> [(a, b)]
maximums [] = []
maximums (x : xs) = foldl f [x] xs
  where
    f ys y = case fst (head ys) `compare` fst y of
      GT -> ys
      EQ -> y : ys
      LT -> [y]


================================================
FILE: server/src/Poker/Poker.hs
================================================
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}

{-
  Public API for Poker Game Logic
-}
module Poker.Poker
  ( initialGameState,
    initPlayer,
    progressGame,
    canProgressGame,
    runPlayerAction,
    handlePlayerTimeout,
    getAllValidPlayerActions,
  )
where

import Control.Lens ((^.))
import Data.Either (isRight)
import Data.Functor (($>))
import Data.Text (Text)
import Poker.ActionValidation (canCheck, validateAction)
import Poker.Game.Actions
  ( call,
    check,
    foldCards,
    leaveSeat,
    makeBet,
    postBlind,
    seatPlayer,
    sitIn,
    sitOut,
  )
import Poker.Game.Blinds
  ( blindRequiredByPlayer,
    haveRequiredBlindsBeenPosted,
  )
import Poker.Game.Game
import Poker.Game.Utils
import Poker.Types
import System.Random (RandomGen)
import Text.Pretty.Simple (pPrint)

-- the function takes a player action and returns either a new game for a valid
-- player action or an err signifying an invalid player action with the reason why
-- if the current game stage is showdown then the next game state will have a newly shuffled
-- deck and pocket cards/ bets reset
runPlayerAction :: Game -> PlayerAction -> Either GameErr Game
runPlayerAction game playerAction'@PlayerAction {..} =
  updatePlayersPossibleActions <$> handlePlayerAction game playerAction'

canProgressGame :: Game -> Bool
canProgressGame game@Game {..}
  | length _players < 2 = False
  | _street == Showdown = True
  | _street == PreDeal && haveRequiredBlindsBeenPosted game = True
  | _street == PreDeal && haveAllPlayersActed game = True
  | otherwise = haveAllPlayersActed game

-- when no player action is possible we can can call this function to get the game
-- to the next stage.
-- When the stage is showdown there are no possible player actions so this function is called
-- to progress the game to the next hand.
-- A similar situation occurs when no further player action is possible but  the game is not over
-- in other words more than one players are active and all or all but one are all in
progressGame :: RandomGen g => g -> Game -> Game
progressGame gen = updatePlayersPossibleActions . nextStage gen

nextStage :: RandomGen g => g -> Game -> Game
nextStage gen game@Game {..}
  | _street == Showdown =
    nextHand
  | notEnoughPlayersToStartGame =
    nextHand
  | haveAllPlayersActed game
      && ( not (allButOneFolded _players)
             || (_street == PreDeal || _street == Showdown)
         ) =
    case getNextStreet _street of
      PreFlop -> progressToPreFlop game
      Flop -> progressToFlop game
      Turn -> progressToTurn game
      River -> progressToRiver game
      Showdown -> progressToShowdown game
      PreDeal -> nextHand
  | allButOneFolded _players && _street /= Showdown =
    progressToShowdown game
  | otherwise =
    game
  where
    nextHand = getNextHand game (shuffledDeck gen)
    numberPlayersSatIn = length $ getActivePlayers _players
    notEnoughPlayersToStartGame =
      _street == PreDeal && haveAllPlayersActed game && numberPlayersSatIn < 2

handlePlayerAction :: Game -> PlayerAction -> Either GameErr Game
handlePlayerAction game@Game {..} PlayerAction {..} = case action of
  PostBlind blind ->
    validateAction game name action $> postBlind blind name game
  Fold -> validateAction game name action $> foldCards name game
  Call -> validateAction game name action $> call name game
  Raise amount -> validateAction game name action $> makeBet False amount name game
  Check -> validateAction game name action $> check name game
  Bet amount -> validateAction game name action $> makeBet False amount name game
  SitDown player -> validateAction game name action $> seatPlayer player game
  SitIn -> validateAction game name action $> sitIn name game
  LeaveSeat' -> validateAction game name action $> leaveSeat name game
  Timeout -> handlePlayerTimeout name game


handlePlayerTimeout :: PlayerName -> Game -> Either GameErr Game
handlePlayerTimeout name game@Game {..}
  | playerCanCheck && handStarted =
    validateAction game name Check $> check name game
  | not playerCanCheck && handStarted =
    validateAction game name Timeout $> foldCards name game
  | not handStarted =
    validateAction game name SitOut $> sitOut name game
  where
    handStarted = _street /= PreDeal
    playerCanCheck = isRight $ canCheck name game

initialGameState :: Deck -> Game
initialGameState shuffledDeck =
  Game
    { _players = [],
      _waitlist = [],
      _minBuyInChips = 1500,
      _maxBuyInChips = 3000,
      _maxPlayers = 6,
      _dealer = 0,
      _currentPosToAct = Nothing,
      _board = [],
      _deck = shuffledDeck,
      _smallBlind = 25,
      _bigBlind = 50,
      _pot = 0,
      _street = PreDeal,
      _maxBet = 0,
      _winners = NoWinners
    }

updatePlayersPossibleActions :: Game -> Game
updatePlayersPossibleActions g@Game {..} =
  Game
    { _players = updatedPlayers,
      ..
    }
  where
    updatedPlayers =
      ( \Player {..} ->
          Player {_possibleActions = getValidPlayerActions g _playerName, ..}
      )
        <$> _players

getAllValidPlayerActions :: Game -> [[Action]]
getAllValidPlayerActions g@Game {..} =
  getValidPlayerActions g . _playerName <$> _players

getValidPlayerActions :: Game -> PlayerName -> [Action]
getValidPlayerActions g@Game {..} name
  | length _players < 2 =
    []
  | _street == PreDeal =
    case blindRequiredByPlayer g name of
      Just SmallBlind -> [PostBlind SmallBlind]
      Just BigBlind -> [PostBlind BigBlind]
      Nothing -> []
  | otherwise =
    let minRaise = 2 * _maxBet
        possibleActions = actions _street $ unChips chipCount
     in filter (isRight . validateAction g name) possibleActions
  where
    actions :: Street -> Int -> [Action]
    actions st chips
      | st == PreDeal = [PostBlind BigBlind, PostBlind SmallBlind]
      | otherwise = [Check, Call, Fold, Bet $ Chips chips, Raise $ Chips chips]
    lowerBetBound = if _maxBet > 0 then 2 * _maxBet else Chips _bigBlind
    chipCount = maybe 0 (^. chips) (getGamePlayer g name)
    panic = do
      error "no valid actions"


================================================
FILE: server/src/Poker/Types.hs
================================================
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}

module Poker.Types where

import Control.Lens (makeLenses)
import Data.Aeson (FromJSON, ToJSON)
import Data.Function (on)
import Data.Text (Text)
import qualified Data.Text.Lazy as LT
import Database.Persist.TH (derivePersistField)
import GHC.Base (NonEmpty)
import GHC.Generics (Generic)
import System.Random

data Rank
  = Two
  | Three
  | Four
  | Five
  | Six
  | Seven
  | Eight
  | Nine
  | Ten
  | Jack
  | Queen
  | King
  | Ace
  deriving (Eq, Read, Ord, Bounded, Enum, Generic, ToJSON, FromJSON)

instance Show Rank where
  show x = case x of
    Two -> "2"
    Three -> "3"
    Four -> "4"
    Five -> "5"
    Six -> "6"
    Seven -> "7"
    Eight -> "8"
    Nine -> "9"
    Ten -> "T"
    Jack -> "J"
    Queen -> "Q"
    King -> "K"
    Ace -> "A"

data Suit
  = Clubs
  | Diamonds
  | Hearts
  | Spades
  deriving (Eq, Ord, Bounded, Enum, Read, Generic, ToJSON, FromJSON)

instance Show Suit where
  show x = case x of
    Clubs -> "♧ "
    Diamonds -> "♢ "
    Hearts -> "♡ "
    Spades -> "♤ "

data Card = Card
  { rank :: Rank,
    suit :: Suit
  }
  deriving (Eq, Read, Generic, ToJSON, FromJSON)

instance Ord Card where
  compare = compare `on` rank

instance Show Card where
  show (Card r s) = show r ++ show s

data HandRank
  = HighCard
  | Pair
  | TwoPair
  | Trips
  | Straight
  | Flush
  | FullHouse
  | Quads
  | StraightFlush
  deriving (Eq, Ord, Show, Read, Generic, ToJSON, FromJSON)

type Bet = Int

--data ActivePlayerState
--  = SatOut -- SatOut denotes a player that will not be dealt cards unless they send a postblinds action to the server
--  | Folded
--  | In
--  deriving (Eq, Show, Ord, Enum, Bounded, Read, Generic, ToJSON, FromJSON)

data PocketCards
  = PocketCards Card Card
  deriving (Show, Eq, Read, Ord, Generic, ToJSON, FromJSON)

unPocketCards :: PocketCards -> [Card]
unPocketCards (PocketCards c1 c2) = [c1, c2]

newtype Chips = Chips Int
  deriving newtype (Num, Random)
  deriving (Eq, Show, Ord, Read, Generic, ToJSON, FromJSON)

instance Semigroup Chips where
  (<>) (Chips a) (Chips b) = Chips $ a + b

-- The amount of chips bet by the player this turn.
newtype CommittedChips = CommittedChips Int deriving (Eq, Show, Ord, Read, Generic, ToJSON, FromJSON)

instance Semigroup CommittedChips where
  (<>) (CommittedChips a) (CommittedChips b) =
    CommittedChips $ a + b

mkChips :: Int -> Maybe Chips
mkChips n
  | n < 0 = Nothing
  | otherwise = pure $ Chips n

unChips :: Chips -> Int
unChips (Chips n) = n

fromCommittedChips :: CommittedChips -> Int
fromCommittedChips (CommittedChips cs) = cs

data CanPlayerAct = PlayerCanAct | PlayerCannotAct
  deriving (Eq, Ord, Show, Read, Generic, ToJSON, FromJSON)

-- WasNotInLastHand:
--   Sometimes a player joins an in progress game and thus are
--   not on BB or SB position. PlayerWasNotInLastHand denotes
--   the fact the new player can choose to post an 'extra' blind
--   to play immediately. Or the player can wait till the blind
--   comes around to them.
--
newtype RequiredBlind = RequiredBlind (Maybe Blind)
  deriving (Eq, Ord, Show, Read, Generic, ToJSON, FromJSON)

data PlayedLastHand = HasNotPlayedLastHand | HasPlayedLastHand
  deriving (Eq, Show, Read, Ord, Generic, ToJSON, FromJSON)

data HasPostedBlind = NotPostedBlind | PostedBlind Blind
  deriving (Eq, Ord, Show, Read, Generic, ToJSON, FromJSON)

data Blind
  = SmallBlind
  | BigBlind
  deriving (Show, Eq, Read, Ord, Generic, ToJSON, FromJSON)

data PlayerInHandStatus
  = CanAct (Maybe LastBetOrCheck)
  | Folded
  | AllIn
  deriving (Eq, Show, Read, Ord, Generic, ToJSON, FromJSON)

data HasBet = HasCalled | HasBet Chips | HasRaised Chips
  deriving (Eq, Show, Read, Ord, Generic, ToJSON, FromJSON)

--betSize :: HasBet -> Int
--betSize = \case
--  HasCalled -> n
--  HasBet n -> n
--  HasRaised n -> n

data LastBetOrCheck = MadeBet HasBet | Checked
  deriving (Eq, Show, Read, Ord, Generic, ToJSON, FromJSON)

satIn :: PlayerStatus -> Bool
satIn (SatIn _ _) = True
satIn _ = False

data PlayerStatus
  = SatOut
  | SatIn PlayedLastHand HasPostedBlind
  | InHand PlayerInHandStatus
  deriving (Eq, Show, Read, Ord, Generic, ToJSON, FromJSON)

data Player = Player
  { _pockets :: Maybe PocketCards,
    _chips :: Chips,
    _bet :: Chips,
    _playerStatus :: PlayerStatus,
    _committed :: CommittedChips,
    _playerName :: Text,
    _possibleActions :: [Action]
  }
  deriving (Eq, Show, Ord, Read, Generic, ToJSON, FromJSON)

--data HasActedThisStreet = HasActed | HasNotActed
--  deriving (Eq, Show, Ord, Read, Generic, ToJSON, FromJSON)

-- data GameStage = NotStarted | PostBlinds | HandUnderway Street

newtype PlayerPosition = PlayerPosition Int

data BettingAction
  = AwaitingPlayerAction
  | NotAwaitingPlayerAction
  | EveryoneFolded
  | EveryoneAllIn
  deriving (Eq, Show, Ord, Read, Generic, ToJSON, FromJSON)

data Street
  = PreDeal
  | PreFlop
  | Flop
  | Turn
  | River
  | Showdown
  deriving (Eq, Ord, Show, Read, Bounded, Enum, Generic, ToJSON, FromJSON)

-- Highest ranking hand for a given Player that is in the game
-- during the Showdown stage of the game (last stage)
newtype PlayerShowdownHand
  = PlayerShowdownHand [Card]
  deriving (Show, Eq, Read, Ord, Generic, ToJSON, FromJSON)

unPlayerShowdownHand :: PlayerShowdownHand -> [Card]
unPlayerShowdownHand (PlayerShowdownHand cards) = cards

-- Folded To Signifies a a single player pot where everyone has
-- folded to them in this case the hand ranking is irrelevant
-- and the winner takes all. Therefore the winner has the choice of showing
-- or mucking (hiding) their cards as they are the only player in the pot.
--
-- Whereas in a MultiPlayer showdown all players must show their cards
-- as hand rankings are needed to ascertain the winner of the pot.
data Winners
  = MultiPlayerShowdown [((HandRank, PlayerShowdownHand), PlayerName)]
  | SinglePlayerShowdown PlayerName -- occurs when everyone folds to one player
  | NoWinners -- todo - remove this and wrap whole type in a Maybe
  deriving (Show, Eq, Read, Ord, Generic, ToJSON, FromJSON)

newtype Deck
  = Deck [Card]
  deriving (Show, Eq, Read, Ord, Generic, ToJSON, FromJSON)

unDeck :: Deck -> [Card]
unDeck (Deck cards) = cards

-- Idea - Could generalise the project to become
-- a DSL for card game servers.
-- (Game [Card]) [Player] actions

-- With card games the rulechecking gets pretty nasty.
--
-- To tame the nastiness of validating game rules
-- we model the poker game as a products of mealy machines.
-- The table is a mealy machine and N players are N mealy machines.
-- So we have N machines for checking all players,
--  a few extra machines for checking the global rules
--  player is a mealy machine and game is a mealy machine?
--  like, this might be a good way to fight the complexity of building the whole state checker yourself
--
-- coding it ain't much hard either, but with having the composition abstracted out you kinda ensure that you don't forget about something when composing it manually
--
-- The key idea is
-- "small coherent parts of the ruleset to keep are different mealy machines"
--
-- We can then use property based testing to ensure invariants
-- hold between mealy machines. Also by modelling the game as a product
-- of machines it is easier to build game generators in PBT as we can
-- compose smaller generators which represent coherent rules of our game.
data Game = Game
  { _players :: [Player],
    _minBuyInChips :: Chips,
    _maxBuyInChips :: Chips,
    _maxPlayers :: Int,
    _board :: [Card],
    _winners :: Winners,
    _waitlist :: [PlayerName],
    _deck :: Deck,
    _smallBlind :: Int,
    _bigBlind :: Int,
    _street :: Street,
    _pot :: Chips,
    _maxBet :: Chips,
    _dealer :: Int,
    _currentPosToAct :: Maybe Int -- If Nothing and not PreDeal stage of game then this signifies that
    -- no  player can act (i.e everyone all in) or
    -- if during PreDeal (blinds stage) any player can act first in order to get the game started
    -- TODO refactor this logic into ADT such as  Nobody | Anyone | Someone PlayerName PlayerPos
  }
  deriving (Eq, Read, Ord, Generic, ToJSON, FromJSON)

instance Show Game where
  show Game {..} =
    "\n dealer: "
      <> show _dealer
      <> "\n _currentPosToAct: "
      <> show _currentPosToAct
      <> "\n _smallBlind: "
      <> show _smallBlind
      <> "\n _big_blind: "
      <> show _bigBlind
      <> "\n _minBuyin: "
      <> show _minBuyInChips
      <> "\n _maxBuyin: "
      <> show _maxBuyInChips
      <> "\n _pot: "
      <> show _pot
      <> "\n _maxBet: "
      <> show _maxBet
      <> "\n _street: "
      <> show _street
      <> "\n _winners: "
      <> show _winners
      <> "\n _board: "
      <> show _board
      <> "\n _players: "
      <> show _players

type PlayerName = Text

data PlayerAction = PlayerAction
  { name :: PlayerName,
    action :: Action
  }
  deriving (Show, Eq, Read, Generic, ToJSON, FromJSON)

-- If you can check, that is you aren't facing an amount you have to call,
-- then when you put in chips it is called a bet. If you have to put in
-- some amount of chips to continue with the hand, and you want to
-- increase the pot, it's called a raise. If it is confusing, just remember
-- this old poker adage: "You can't raise yourself."
--
-- Mucking hands refers to a player choosing not to
-- show his hands after everyone has folded to them. Essentially in
-- this scenario mucking or showing refers to the decision to
-- show ones hand or not to the table after everyone else has folded.
data Action
  = SitDown Player -- doesnt progress the game
  | LeaveSeat' -- doesnt progress the game
  | PostBlind Blind
  | Fold
  | Call
  | Raise Chips
  | Check
  | Bet Chips
  | ShowHand
  | MuckHand
  | SitOut
  | SitIn
  | Timeout
  deriving (Show, Ord, Eq, Read, Generic, ToJSON, FromJSON)

data GameErr
  = NotEnoughChips PlayerName
  | OverMaxChipsBuyIn PlayerName
  | PlayerNotAtTable PlayerName
  | AlreadySatAtTable PlayerName
  | NotAtTable PlayerName
  | CannotSitAtFullTable PlayerName
  | AlreadyOnWaitlist PlayerName
  | InvalidMove
      PlayerName
      InvalidMoveErr
  deriving (Show, Eq, Read, Ord, Generic, ToJSON, FromJSON)

-- ToDO -- ONLY ONE ERR MSG FOR EACH POSSIBLE ACTION
--
-- additional text field for more detailed info
--
-- i.e cannotBet "Cannot Bet Should Raise Instead - bets can only be made if there have been zero bets this street"
data InvalidMoveErr
  = BlindNotRequired
  | BlindRequiredErr Blind
  | NoBlindRequiredErr
  | BlindAlreadyPosted Blind
  | OutOfTurn CurrentPlayerToActErr -- _currentPosToAct is Just but not the player's index
  | NoPlayerCanAct -- _currentPosToAct is Nothing
  | CannotPostBlindOutsidePreDeal
  | CannotPostNoBlind -- if player tries to apply postBlind with a value of NoBlind
  | CannotPostBlind Text
  | InvalidActionForStreet
  | BetLessThanBigBlind
  | NotEnoughChipsForAction
  | CannotBetShouldRaiseInstead Text
  | PlayerToActNotAtTable
  | CannotRaiseShouldBetInstead
  | RaiseAmountBelowMinRaise Int
  | CannotCheckShouldCallRaiseOrFold
  | CannotCallZeroAmountCheckOrBetInstead
  | CannotShowHandOrMuckHand Text
  | CannotLeaveSeatOutsidePreDeal
  | CannotSitDownOutsidePreDeal
  | CannotSitInOutsidePreDeal
  | AlreadySatIn
  | AlreadySatOut -- cannot sitout when already satout
  | CannotSitOutOutsidePreDeal
  deriving (Show, Eq, Read, Ord, Generic, ToJSON, FromJSON)

newtype CurrentPlayerToActErr
  = CurrentPlayerToActErr PlayerName
  deriving (Show, Eq, Read, Ord, Generic, ToJSON, FromJSON)

makeLenses ''Player

makeLenses ''PlayerAction

makeLenses ''Game

makeLenses ''Winners

-- Due to the GHC Stage Restriction, the call to the Template Haskell function derivePersistField must be
-- in a separate module than where the generated code is used.
-- Perform marshaling using the Show and Read
-- instances of the datatype to string field in db
derivePersistField "Player"

derivePersistField "Winners"

derivePersistField "HandRank"

derivePersistField "Street"

derivePersistField "Card"


================================================
FILE: server/src/Schema.hs
================================================
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Schema where

import Control.Monad ()
import Data.Aeson ()
import Data.Aeson.Types ()
import Data.Text (Text)
import Data.Time.Clock (UTCTime)
import Database.Persist.TH
  ( mkMigrate,
    mkPersist,
    persistLowerCase,
    share,
    sqlSettings,
  )
import Poker.Types
  ( Bet,
    Card,
    Player,
    PlayerName,
    Street,
    Winners,
  )

share
  [mkPersist sqlSettings, mkMigrate "migrateAll"]
  [persistLowerCase|
  UserEntity json sql=users
    username Text
    email Text
    password Text
    availableChips Int
    chipsInPlay Int
    createdAt UTCTime default=now()
    UniqueEmail email
    UniqueUsername username
    deriving Show Read
  TableEntity json sql=tables
    name Text
    UniqueName name
    deriving Show Read
  GameEntity json sql=games
    tableID TableEntityId
    createdAt UTCTime default=now()
    players [Player]
    minBuyInChips Int
    maxBuyInChips Int
    maxPlayers Int
    board [Card]
    winners Winners
    waitlist [PlayerName]
    deck [Card]
    smallBlind Int
    bigBlind Int
    street Street
    pot Int
    maxBet Bet
    dealer Int
    currentPosToAct Int Maybe
    deriving Show Read
|]


================================================
FILE: server/src/Socket/Auth.hs
================================================
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Socket.Auth where

import Control.Monad.Except (runExceptT)
import Crypto.JOSE as Jose (decodeCompact)
import Crypto.JWT
  ( ClaimsSet,
    JWTError,
    decodeCompact,
    defaultJWTValidationSettings,
    verifyClaims,
  )
import Crypto.JWT as Jose
  ( ClaimsSet,
    JWTError,
    JWTValidationSettings,
    decodeCompact,
    defaultJWTValidationSettings,
    verifyClaims,
  )
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import Data.Either (Either)
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import Database.Persist.Postgresql
  ( ConnectionString,
    entityVal,
  )
import qualified Network.WebSockets as WS
import Servant.Auth.Server
  ( IsMatch (DoesNotMatch, Matches),
    JWTSettings (audienceMatches),
    defaultJWTSettings,
    fromSecret,
  )
import Text.Pretty.Simple (pPrint)
import Prelude

verifyJWT :: BS.ByteString -> BL.ByteString -> IO (Either JWTError ClaimsSet)
verifyJWT key jwt = runExceptT $ do
  jwt' <- decodeCompact jwt
  -- decode JWT
  verifyClaims jwtCfg jwk jwt'
  where
    jwk = fromSecret key
    jwtCfg = jwtSettingsToJwtValidationSettings $ defaultJWTSettings jwk

jwtSettingsToJwtValidationSettings :: JWTSettings -> Jose.JWTValidationSettings
jwtSettingsToJwtValidationSettings s =
  defaultJWTValidationSettings
    (toBool <$> audienceMatches s)
  where
    toBool Matches = True
    toBool DoesNotMatch = False


================================================
FILE: server/src/Socket/Clients.hs
================================================
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Socket.Clients where

import Control.Concurrent.Async (async)
import Control.Concurrent.STM
  ( STM,
    TVar,
    atomically,
    readTVar,
    readTVarIO,
    swapTVar,
  )
import Control.Lens (At (at), (^.))
import Control.Monad (Monad (return), forM_, void)
import Control.Monad.Except (MonadIO (liftIO), runExceptT)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Map.Lazy (Map)
import qualified Data.Map.Lazy as M
import Data.Maybe (Maybe (Just))
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import Database.Persist.Postgresql
  ( ConnectionString,
    entityVal,
  )
import qualified Network.WebSockets as WS
import Pipes (each, for, runEffect, yield, (>->))
import Pipes.Concurrent (toOutput)
import Pipes.Core (push)
import Poker.Game.Privacy
  ( excludeOtherPlayerCards,
    excludePrivateCards,
  )
import Servant.Auth.Server (FromJWT (decodeJWT))
import Socket.Auth (verifyJWT)
import Socket.Types
  ( Client (..),
    Err (AuthFailed),
    Lobby (..),
    MsgIn,
    MsgOut
      ( NewGameState,
        SuccessfullySatDown,
        SuccessfullySubscribedToTable
      ),
    ServerState (..),
    Table (..),
    TableName,
    Token (..),
  )
import Socket.Utils (encodeMsgToJSON, encodeMsgX)
import Types (RedisConfig, Username (..))
import Prelude

authClient ::
  BS.ByteString ->
  TVar ServerState ->
  ConnectionString ->
  RedisConfig ->
  WS.Connection ->
  Token ->
  IO (Either Err Username)
authClient secretKey state dbConn redisConfig conn (Token token) = do
  authResult <- runExceptT $ liftIO $ verifyJWT secretKey token'
  case authResult of
    Left err -> return $ Left $ AuthFailed err
    Right (Left err) -> return $ Left $ AuthFailed $ T.pack $ show err
    Right (Right claimsSet) -> case decodeJWT claimsSet of
      Left jwtErr -> return $ Left $ AuthFailed $ T.pack $ show jwtErr
      Right username@(Username name) -> return $ pure $ Username name
  where
    token' = C.pack $ T.unpack token

removeClient :: Username -> TVar ServerState -> IO ServerState
removeClient username serverStateTVar = do
  ServerState {..} <- readTVarIO serverStateTVar
  let newClients = M.delete username clients
      newState = ServerState {clients = newClients, ..}
  atomically $ swapTVar serverStateTVar newState

clientExists :: Username -> Map Username Client -> Bool
clientExists = M.member

insertClient :: Client -> Username -> Map Username Client -> Map Username Client
insertClient client username = M.insert username client

addClient :: TVar ServerState -> Client -> STM ServerState
addClient s c@Client {..} = do
  ServerState {..} <- readTVar s
  swapTVar
    s
    ( ServerState
        { clients = insertClient c (Username clientUsername) clients,
          ..
        }
    )

getClient :: Map Username Client -> Username -> Maybe Client
getClient cs username = cs ^. at username

broadcastAllClients :: Map Username Client -> MsgOut -> IO ()
broadcastAllClients clients msg =
  forM_ (M.elems clients) (\Client {..} -> sendMsg conn msg)

broadcastTableSubscribers :: Table -> Map Username Client -> MsgOut -> IO ()
broadcastTableSubscribers Table {..} clients msg =
  forM_
    subscriberConns
    (\Client {..} -> sendMsg conn msg)
  where
    subscriberConns = clients `M.restrictKeys` Set.fromList subscribers

sendMsgs :: [WS.Connection] -> MsgOut -> IO ()
sendMsgs conns msg = forM_ conns $ \conn -> sendMsg conn msg

sendMsg :: WS.Connection -> MsgOut -> IO ()
sendMsg conn msg = WS.sendTextData conn (encodeMsgToJSON msg)

sendMsgX :: WS.Connection -> MsgIn -> IO ()
sendMsgX conn msg = WS.sendTextData conn (encodeMsgX msg)

getClientConn :: Client -> WS.Connection
getClientConn Client {..} = conn

broadcastMsg :: Map Username Client -> [Username] -> MsgOut -> IO ()
broadcastMsg clients usernames msg =
  forM_
    conns
    (\Client {..} -> sendMsg conn $ filterPrivateGameData clientUsername msg)
  where
    conns = clients `M.restrictKeys` Set.fromList usernames

-- Filter out private data such as other players cards which is not
-- intended for the client.
filterPrivateGameData :: Text -> MsgOut -> MsgOut
filterPrivateGameData username (SuccessfullySatDown tableName game) =
  SuccessfullySatDown tableName (excludeOtherPlayerCards username game)
filterPrivateGameData username (SuccessfullySubscribedToTable tableName game) =
  SuccessfullySubscribedToTable
    tableName
    (excludePrivateCards (Just username) game)
filterPrivateGameData username (NewGameState tableName game) =
  NewGameState tableName (excludeOtherPlayerCards username game)
filterPrivateGameData _ unfilteredMsg = unfilteredMsg

getTablesUserSubscribedTo :: Client -> Lobby -> [(TableName, Table)]
getTablesUserSubscribedTo Client {..} (Lobby lobby) =
  filter
    (subscriberIncludesClient . snd)
    (M.toList lobby)
  where
    subscriberIncludesClient Table {..} =
      Username clientUsername `elem` subscribers

tablesToMsgs :: Text -> [(TableName, Table)] -> [MsgOut]
tablesToMsgs clientUsername' = (<$>) toFilteredMsg
  where
    gameToMsg (tableName, Table {..}) = NewGameState tableName game
    toFilteredMsg = filterPrivateGameData clientUsername' . gameToMsg

getSubscribedGameStates :: Client -> Lobby -> [MsgOut]
getSubscribedGameStates c@Client {..} l =
  tablesToMsgs clientUsername $ getTablesUserSubscribedTo c l

-- Used so that reconnected users can get up to speed on games when they regain connection
-- after a disconnect.
updateWithLatestGames :: Client -> Lobby -> IO ()
updateWithLatestGames client@Client {..} lobby =
  void $
    async $
      runEffect $
        for
          (each latestGameStates)
          (\msg -> yield msg >-> toOutput outgoingMailbox)
  where
    latestGameStates = getSubscribedGameStates client lobby


================================================
FILE: server/src/Socket/Lobby.hs
================================================
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Socket.Lobby where

import Control.Concurrent
  ( MVar,
    modifyMVar,
    modifyMVar_,
    readMVar,
  )
import Control.Concurrent.STM (atomically, newBroadcastTChan)
import Control.Concurrent.STM.TChan (newBroadcastTChan)
import Control.Lens (At (at), (.~), (?~))
import Control.Lens.At (At (at))
import Control.Monad (void)
import Control.Monad.STM (atomically)
import Data.ByteString.Char8
  ( pack,
    unpack,
  )
import Data.Int (Int64)
import Data.List (unfoldr)
import Data.Map.Lazy (Map)
import qualified Data.Map.Lazy as M
import Data.Text (Text)
import Pipes.Concurrent (atomically, newest, spawn)
import Poker.Game.Utils (shuffledDeck)
import Poker.Poker (initPlayer, initialGameState)
import Poker.Types (Game (..), unChips)
import Socket.Types
  ( Lobby (..),
    Table (..),
    TableName,
    TableSummary (..),
    headsUpBotsConfig,
  )
import Socket.Utils (unLobby)
import System.Random (getStdGen)
import Types (Username (..))

initialLobby :: IO Lobby
initialLobby = do
  chan <- atomically newBroadcastTChan
  randGen <- getStdGen
  let shuffledDeck' = shuffledDeck randGen
  (output, input) <- spawn $ newest 1
  let tableName = "Black"
  let table' =
        Table
          { subscribers = [],
            gameInMailbox = output,
            gameOutMailbox = input,
            waitlist = [],
            game = initialGameState shuffledDeck',
            channel = chan,
            config = headsUpBotsConfig
          }
  return $ Lobby $ M.fromList [("Black", table')]

joinGame :: Username -> Int -> Game -> Game
joinGame (Username username) chips Game {..} =
  Game {_players = _players <> pure player, ..}
  where
    player = initPlayer username chips

joinTableWaitlist :: Username -> Table -> Table
joinTableWaitlist username Table {..} =
  Table {waitlist = waitlist <> [username], ..}

insertTable :: TableName -> Table -> Lobby -> Lobby
insertTable tableName newTable = Lobby . (at tableName ?~ newTable) . unLobby

canJoinGame :: Game -> Bool
canJoinGame Game {..} = length _players < _maxPlayers

summariseGame :: TableName -> Table -> TableSummary
summariseGame tableName Table {game = Game {..}, ..} =
  TableSummary
    { _tableName = tableName,
      _playerCount = length _players,
      _waitlistCount = length _waitlist,
      _minBuyInChips = unChips _minBuyInChips,
      _maxBuyInChips = unChips _maxBuyInChips,
      ..
    }

summariseTables :: Lobby -> [TableSummary]
summariseTables (Lobby lobby) = uncurry summariseGame <$> M.toList lobby


================================================
FILE: server/src/Socket/Msg.hs
================================================
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}

module Socket.Msg where

import Control.Applicative (Applicative ((<*)), (<$>))
import Control.Concurrent.STM (atomically, readTVarIO)
import Control.Monad (Monad (return))
import Control.Monad.Except (Monad (return), MonadIO (liftIO))
import Control.Monad.Reader
  ( Monad (return),
    MonadIO (liftIO),
    MonadReader (ask),
    ReaderT,
  )
import Control.Monad.STM (atomically)
import Control.Monad.State.Lazy (Monad (return), MonadIO (liftIO))
import Data.Either (Either (..), either)
import Data.Foldable (find, notElem)
import Data.Functor ((<$>))
import Data.Map.Lazy (Map)
import qualified Data.Map.Lazy as M
import Data.Maybe (Maybe (Just, Nothing))
import Data.Text (Text)
import qualified Data.Text as T
import Database
  ( dbDepositChipsIntoPlay,
    dbGetUserByUsername,
    dbWithdrawChipsFromPlay,
  )
import Database.Persist.Postgresql (ConnectionString)
import qualified Network.WebSockets as WS
import Poker.Game.Game (initPlayer)
import Poker.Game.Utils (getGamePlayerNames)
import Poker.Poker (initPlayer, runPlayerAction)
import Poker.Types
import Schema
  ( UserEntity
      ( UserEntity,
        userEntityAvailableChips,
        userEntityChipsInPlay,
        userEntityCreatedAt,
        userEntityEmail,
        userEntityPassword,
        userEntityUsername
      ),
  )
import Socket.Clients (sendMsg)
import Socket.Lobby (summariseTables)
import Socket.Subscriptions (subscribeToTableHandler)
import Socket.Table (getTable, updateTable')
import Socket.Types
  ( Err
      ( ChipAmountNotWithinBuyInRange,
        GameErr,
        NotEnoughChipsToSit,
        NotSatInGame,
        TableDoesNotExist,
        UserDoesNotExistInDB
      ),
    GameMsgIn (..),
    MsgHandlerConfig (..),
    MsgIn (GameMsgIn, GetTables, SubscribeToTable),
    MsgOut (NewGameState, SuccessfullySatDown, TableList),
    ServerState (ServerState, clients, lobby),
    Table (..),
    TableName,
  )
import Socket.Utils (unLobby)
import Text.Pretty.Simple (pPrint)
import Types (unUsername)
import Prelude

msgHandler :: MsgIn -> ReaderT MsgHandlerConfig IO (Either Err MsgOut)
msgHandler GetTables {} = getTablesHandler
msgHandler msg@SubscribeToTable {} = subscribeToTableHandler msg
msgHandler (GameMsgIn msg) = gameMsgHandler msg

gameMsgHandler :: GameMsgIn -> ReaderT MsgHandlerConfig IO (Either Err MsgOut)
gameMsgHandler msg@TakeSeat {} = takeSeatHandler msg
gameMsgHandler msg@LeaveSeat {} = leaveSeatHandler msg
gameMsgHandler m@(GameMove tableName action) = do
  conf@MsgHandlerConfig {..} <- ask
  let playerAction = PlayerAction {name = unUsername username, ..}
  moveResult <- liftIO $ playMove conf tableName playerAction
  return $ NewGameState tableName <$> moveResult

playMove ::
  MsgHandlerConfig -> TableName -> PlayerAction -> IO (Either Err Game)
playMove conf@MsgHandlerConfig {..} tableName playerAction = do
  maybeTable <- liftIO $ atomically $ getTable serverStateTVar tableName
  case maybeTable of
    Nothing -> return $ Left $ TableDoesNotExist tableName
    Just Table {..} ->
      return $ either (Left . GameErr) Right $ runPlayerAction game playerAction

getTablesHandler :: ReaderT MsgHandlerConfig IO (Either Err MsgOut)
getTablesHandler = do
  MsgHandlerConfig {..} <- ask
  ServerState {..} <- liftIO $ readTVarIO serverStateTVar
  let tableSummaries = TableList $ summariseTables lobby
  liftIO $ print tableSummaries
  liftIO $ sendMsg clientConn tableSummaries
  return $ Right tableSummaries

-- We fork a new thread for each game joined to receive game updates and propagate them to the client
-- We link the new thread to the current thread so on any exception in either then both threads are
-- killed to prevent memory leaks.
--
---- If game is in predeal stage then add player to game else add to waitlist
-- the waitlist is a queue awaiting the next predeal stage of the game
takeSeatHandler :: GameMsgIn -> ReaderT MsgHandlerConfig IO (Either Err MsgOut)
takeSeatHandler (TakeSeat tableName chipsToSit) = do
  conf@MsgHandlerConfig {..} <- ask
  ServerState {..} <- liftIO $ readTVarIO serverStateTVar
  case M.lookup tableName $ unLobby lobby of
    Nothing -> return $ Left $ TableDoesNotExist tableName
    Just table@Table {..} -> do
      canSit <- canTakeSeat chipsToSit tableName table
      case canSit of
        Left err -> return $ Left err
        Right () -> do
          let player = initPlayer (unUsername username) chipsToSit
              playerAction =
                PlayerAction
                  { name = unUsername username,
                    action = SitDown player
                  }
              takeSeatAction = GameMove tableName (SitDown player)
          case runPlayerAction
            game
            PlayerAction
              { name = unUsername username,
                action = SitDown player
              } of
            Left gameErr -> return $ Left $ GameErr gameErr
            Right newGame -> do
              liftIO $ postTakeSeat conf tableName chipsToSit
              liftIO $
                sendMsg clientConn (SuccessfullySatDown tableName newGame)
              let msgOut = NewGameState tableName newGame
              liftIO $
                atomically $
                  updateTable'
                    serverStateTVar
                    tableName
                    newGame
              return $ Right msgOut

postTakeSeat :: MsgHandlerConfig -> TableName -> Int -> IO ()
postTakeSeat conf@MsgHandlerConfig {..} name chipsSatWith =
  dbDepositChipsIntoPlay dbConn (unUsername username) chipsSatWith

leaveSeatHandler :: GameMsgIn -> ReaderT MsgHandlerConfig IO (Either Err MsgOut)
leaveSeatHandler leaveSeatMove@(LeaveSeat tableName) = do
  msgHandlerConfig@MsgHandlerConfig {..} <- ask
  ServerState {..} <- liftIO $ readTVarIO serverStateTVar
  case M.lookup tableName $ unLobby lobby of
    Nothing -> return $ Left $ TableDoesNotExist tableName
    Just table@Table {..} ->
      if unUsername username `notElem` getGamePlayerNames game
        then return $ Left $ NotSatInGame tableName
        else do
          let eitherProgressedGame =
                runPlayerAction
                  game
                  PlayerAction {name = unUsername username, action = LeaveSeat'}

          case eitherProgressedGame of
            Left gameErr -> return $ Left $ GameErr gameErr
            Right newGame -> do
              let maybePlayer =
                    find
                      (\Player {..} -> unUsername username == _playerName)
                      (_players game)
              case maybePlayer of
                Nothing -> return $ Left $ NotSatInGame tableName
                Just Player {_chips = chipsInPlay, ..} -> do
                  liftIO $
                    dbWithdrawChipsFromPlay
                      dbConn
                      (unUsername username)
                      (unChips chipsInPlay)
                  let msgOut = NewGameState tableName newGame
                  liftIO $
                    atomically $
                      updateTable'
                        serverStateTVar
                        tableName
                        newGame
                  return $ Right msgOut

canTakeSeat ::
  Int -> Text -> Table -> ReaderT MsgHandlerConfig IO (Either Err ())
canTakeSeat chipsToSit tableName Table {game = Game {..}, ..}
  | Chips chipsToSit >= _minBuyInChips && Chips chipsToSit <= _maxBuyInChips = do
    availableChipsE <- getPlayersAvailableChips
    MsgHandlerConfig {..} <- ask
    case availableChipsE of
      Left err -> return $ Left err
      Right chips -> do
        tableE <- liftIO $ checkTableExists serverStateTVar tableName
        return $ tableE <* hasEnoughChips chips chipsToSit
  | otherwise = return $ Left $ ChipAmountNotWithinBuyInRange tableName
  where
    hasEnoughChips availableChips chipsNeeded =
      if availableChips >= chipsToSit
        then return $ Right ()
        else return $ Left NotEnoughChipsToSit
    checkTableExists s name = do
      t <- atomically $ getTable s name
      case t of
        Nothing -> return $ Left $ TableDoesNotExist name
        _ -> return $ Right ()

getPlayersAvailableChips :: ReaderT MsgHandlerConfig IO (Either Err Int)
getPlayersAvailableChips = do
  MsgHandlerConfig {..} <- ask
  maybeUser <- liftIO $ dbGetUserByUsername dbConn username
  return $ case maybeUser of
    Nothing -> Left $ UserDoesNotExistInDB (unUsername username)
    Just UserEntity {..} ->
      Right $ userEntityAvailableChips - userEntityChipsInPlay


================================================
FILE: server/src/Socket/Setup.hs
================================================
{-# LANGUAGE OverloadedStrings #-}

module Socket.Setup where

import Control.Concurrent.Async (Async)
import Control.Monad (void)
import Control.Monad.Except (void)
import Control.Monad.Reader (runReaderT)
import Data.ByteString.Char8
  ( pack,
    unpack,
  )
import Data.Int (Int64)
import Data.List (unfoldr)
import Data.Map.Lazy (Map)
import qualified Data.Map.Lazy as M
import Data.Text (Text)
import Database (runRedisAction)
import Database.Persist.Postgresql (ConnectionString)
import Database.Redis
  ( Redis,
    connect,
    runRedis,
    setex,
  )
import qualified Database.Redis as Redis
import Socket.Lobby (initialLobby)
import Types (RedisConfig)

-- lobby including all game state is stored in redis
setInitialLobby :: RedisConfig -> IO ()
setInitialLobby redisConfig = do
  lobby <- initialLobby
  runRedisAction redisConfig $
    void $
      Redis.hsetnx
        "gamesState"
        "lobby"
        (pack $ show lobby)

intialiseGameStateInRedis :: RedisConfig -> IO ()
intialiseGameStateInRedis = setInitialLobby


================================================
FILE: server/src/Socket/Subscriptions.hs
================================================
{-
  Logic for updating players about table changes
-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Socket.Subscriptions where

import Control.Concurrent.STM
  ( STM,
    atomically,
    readTVar,
    readTVarIO,
    swapTVar,
    throwSTM,
  )
import Control.Monad (Monad (return))
import Control.Monad.Except (Monad (return), MonadIO (liftIO))
import Control.Monad.Reader
  ( Monad (return),
    MonadIO (liftIO),
    MonadReader (ask),
    ReaderT,
  )
import Control.Monad.STM (STM, atomically, throwSTM)
import Control.Monad.State.Lazy (Monad (return), MonadIO (liftIO))
import Data.Either (Either (..))
import Data.Map.Lazy (Map)
import qualified Data.Map.Lazy as M
import Data.Maybe (Maybe (Just, Nothing))
import Data.Monoid ((<>))
import Data.Text (Text)
import qualified Data.Text as T
import qualified Network.WebSockets as WS
import Poker.Game.Privacy (excludePrivateCards)
import Socket.Clients (sendMsg)
import Socket.Lobby (insertTable)
import Socket.Types
  ( CannotAddAlreadySubscribed (CannotAddAlreadySubscribed),
    Err (TableDoesNotExist),
    Lobby (..),
    MsgHandlerConfig (..),
    MsgIn (SubscribeToTable),
    MsgOut (SuccessfullySubscribedToTable),
    ServerState (ServerState, clients, lobby),
    Table (..),
    TableDoesNotExistInLobby (TableDoesNotExistInLobby),
    TableName,
  )
import Socket.Utils (unLobby)
import Text.Pretty.Simple (pPrint)
import Types (Username, unUsername)
import Prelude

getTableSubscribers :: TableName -> Lobby -> [Username]
getTableSubscribers tableName (Lobby lobby) = case M.lookup tableName lobby of
  Nothing -> []
  Just Table {..} -> subscribers

-- First we check the table exists and if the user is not already subscribed then we add them to the list of subscribers
-- Game and any other table updates will be propagated to those on the subscriber list
subscribeToTableHandler ::
  MsgIn -> ReaderT MsgHandlerConfig IO (Either Err MsgOut)
subscribeToTableHandler (SubscribeToTable tableName) = do
  msgHandlerConfig@MsgHandlerConfig {..} <- ask
  ServerState {..} <- liftIO $ readTVarIO serverStateTVar
  case M.lookup tableName $ unLobby lobby of
    Nothing -> return $ Left $ TableDoesNotExist tableName
    Just Table {..} -> do
      let privatisedGame = excludePrivateCards (Just (unUsername username)) game
          msg' = SuccessfullySubscribedToTable tableName privatisedGame
      if username `notElem` subscribers
        then do
          liftIO $ atomically $ subscribeToTable tableName msgHandlerConfig
          liftIO $ sendMsg clientConn msg'
          return $ Right msg'
        else do
          return $ Right msg'

subscribeToTable :: TableName -> MsgHandlerConfig -> STM ()
subscribeToTable tableName MsgHandlerConfig {..} = do
  ServerState {..} <- readTVar serverStateTVar
  let maybeTable = M.lookup tableName $ unLobby lobby
  case maybeTable of
    Nothing -> throwSTM $ TableDoesNotExistInLobby tableName
    Just table@Table {..} ->
      if username `notElem` subscribers
        then do
          let updatedTable =
                Table {subscribers = subscribers <> [username], ..}
          let updatedLobby = insertTable tableName updatedTable lobby
          let newServerState = ServerState {lobby = updatedLobby, ..}
          swapTVar serverStateTVar newServerState
          return ()
        else throwSTM $ CannotAddAlreadySubscribed tableName


================================================
FILE: server/src/Socket/Table.hs
================================================
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Socket.Table where

import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (Async, async)
import Control.Concurrent.STM
  ( STM,
    TVar,
    atomically,
    readTVar,
    readTVarIO,
    swapTVar,
    throwSTM,
  )
import Control.Lens ((^.))
import Control.Monad
  ( Monad (return),
    forM_,
    forever,
    mapM_,
    unless,
    void,
    when,
  )
import Control.Monad.Except
  ( Monad (return),
    MonadIO (liftIO),
    forM_,
    forever,
    mapM_,
    when,
  )
import Control.Monad.Reader
  ( Monad (return),
    MonadIO (liftIO),
    forM_,
    forever,
    mapM_,
    when,
  )
import qualified Data.ByteString.Lazy.Char8 as C
import Data.ByteString.UTF8 (fromString)
import Data.Either (Either (Left, Right), isRight)
import qualified Data.Map.Lazy as M
import Data.Maybe (Maybe (..), fromMaybe)
import Data.Text as T (Text, pack)
import Database (dbGetTableEntity, dbInsertGame)
import Database.Persist (Entity (Entity), PersistEntity (Key))
import Database.Persist.Postgresql
  ( ConnectionString,
    SqlPersistT,
    runMigration,
    withPostgresqlConn,
  )
import qualified Network.WebSockets as WS
import Pipes
  ( Consumer,
    Effect,
    Pipe,
    await,
    runEffect,
    yield,
    (>->),
  )
import Pipes.Concurrent
  ( Input,
    Output,
    STM,
    atomically,
    fromInput,
    readTVar,
    toOutput,
  )
import Pipes.Core (push)
import Pipes.Parse (yield)
import qualified Pipes.Prelude as P
import Poker.ActionValidation (validateAction)
import Poker.Game.Game (doesPlayerHaveToAct, initPlayer)
import Poker.Game.Privacy (excludeOtherPlayerCards)
import Poker.Game.Utils
import Poker.Poker
  ( canProgressGame,
    progressGame,
    runPlayerAction,
  )
import Poker.Types
import Schema (Key, TableEntity)
import Socket.Types
  ( Client (..),
    Lobby (..),
    MsgOut (NewGameState),
    ServerState (..),
    Table (..),
    TableConfig (..),
    TableDoesNotExistInLobby (TableDoesNotExistInLobby),
    TableName,
  )
import Socket.Utils (unLobby)
import System.Random
import Types ()
import Prelude

setUpTablePipes ::
  ConnectionString -> TVar ServerState -> TableName -> Table -> IO (Async ())
setUpTablePipes connStr s name Table {..} = do
  t <- dbGetTableEntity connStr name
  let (Entity key _) = fromMaybe notFoundErr t
  async $
    forever $
      runEffect $
        gamePipeline
          connStr
          s
          key
          name
          gameOutMailbox
          gameInMailbox
  where
    --threadDelay (7 * 1000000) -- delay so can see whats going on

    --    botPipes botNames = mapM_ (runBot gameInMailbox gameOutMailbox) botNames
    notFoundErr = error $ "Table " <> show name <> " doesn't exist in DB"


getValidBotActions :: Game -> PlayerName -> IO [Action]
getValidBotActions g@Game {..} name = do
  betAmount' <- randomRIO (lowerBetBound, chipCount)
  let possibleActions = actions _street betAmount'
      actionsValidated = validateAction g name <$> possibleActions
      pNameActionPairs = zip possibleActions actionsValidated
  return $ (<$>) fst $ filter (isRight . snd) pNameActionPairs
  where
    actions :: Street -> Chips -> [Action]
    actions st chips
      | st == PreDeal = [PostBlind BigBlind, PostBlind SmallBlind, SitDown (initPlayer name 1500)]
      | otherwise = [Check, Call, Fold, Bet chips, Raise chips]
    lowerBetBound = if _maxBet > 0 then 2 * _maxBet else Chips _bigBlind
    chipCount = maybe 0 (^. chips) (getGamePlayer g name)

-- this is the pipeline of effects we run everytime a new game state
-- is placed in the tables
-- incoming mailbox for new game states.
--
-- New game states are send to the table's incoming mailbox every time a player acts
-- in a way that follows the game rules
--
-- Delays with "pause" at the end of each game stage (Flop, River etc) for UX
-- are done client side.
gamePipeline ::
  ConnectionString ->
  TVar ServerState ->
  Key TableEntity ->
  TableName ->
  Input Game ->
  Output Game ->
  Effect IO ()
gamePipeline connStr s key tableName outMailbox inMailbox = do
  fromInput outMailbox -- game actions go in this input sink from websocket connections
    >-> broadcast s tableName
    >-> logGame tableName
    >-> updateTable s tableName
    >-> writeGameToDB connStr key
    >-> nextStagePause
    >-> timePlayer s tableName
    >-> progress inMailbox -- new gamestates go in this output source

-- TODO should group as manny effect in stm monad not IO -- perhaps

-- Delay to enhance UX based on game stages
timePlayer :: TVar ServerState -> TableName -> Pipe Game Game IO ()
timePlayer s tableName = do
  g@Game {..} <- await
  let currPlyrToAct = (!!) (getGamePlayerNames g) <$> _currentPosToAct
  liftIO $ forM_ currPlyrToAct $ runPlayerTimer s tableName g
  yield g

-- We watch incoming game states. We compare the initial gamestates
-- with the game state when the timer ends.
-- If the state is still the same then we timeout the player to act
-- to force the progression of the game.
runPlayerTimer ::
  TVar ServerState -> TableName -> Game -> PlayerName -> IO (Async ())
runPlayerTimer s tableName gameWhenTimerStarts plyrName = async $ do
  threadDelay (3 * 10000000) -- 30 seconds
  mbTable <- atomically $ getTable s tableName
  case mbTable of
    Nothing -> return ()
    Just Table {..} -> do
      let gameHasNotProgressed = gameWhenTimerStarts == game
          playerStillHasToAct = doesPlayerHaveToAct plyrName game
      when (gameHasNotProgressed && playerStillHasToAct) $
        case runPlayerAction game timeoutAction of
          Left err -> print err
          Right progressedGame ->
            runEffect $ yield progressedGame >-> toOutput gameInMailbox
  where
    timeoutAction = PlayerAction {name = plyrName, action = Timeout}

-- Delay to enhance UX so game doesn't move through stages
-- instantly when no players can act i.e everyone all in.
nextStagePause :: Pipe Game Game IO ()
nextStagePause = do
  g <- await
  when (canProgressGame g) $ liftIO $ threadDelay $ pauseDuration g
  yield g
  where
    pauseDuration :: Game -> Int
    pauseDuration g@Game {..}
      | _street == PreDeal = 0
      | _street == Showdown =
        5 * 1000000
      |
        playersNotAllIn _players <= 1 =
        5 * 1000000 -- everyone all in
      | otherwise = 2 * 1000000 -- 1 seconds

-- Progresses to the next state which awaits a player action.
--
--- If the next game state is one where no player action is possible
--  then we need to recursively progress the game.

--  These such states are:
--
--  1. everyone is all in.
--  1. All but one player has folded or the game.
--  3. Game is in the Showdown stage.
--
-- After each progression the new game state is sent to the table
-- mailbox. This sends the new game state through the pipeline that
-- the previous game state just went through.
progress :: Output Game -> Consumer Game IO ()
progress gameInMailbox = do
  g <- await
  when (canProgressGame g) (progress' g)
  where
    progress' game = do
      gen <- liftIO getStdGen
      liftIO $ setStdGen $ snd $ next gen
      runEffect $ yield (progressGame gen game) >-> toOutput gameInMailbox

writeGameToDB :: ConnectionString -> Key TableEntity -> Pipe Game Game IO ()
writeGameToDB connStr tableKey = do
  g <- await
  _ <- liftIO $ async $ dbInsertGame connStr tableKey g
  yield g

-- write MsgOuts for new game states to outgoing mailbox for
-- client's who are observing the table
-- ensure they only get to see data they are allowed to see
informSubscriber :: TableName -> Game -> Client -> IO ()
informSubscriber n g Client {..} = do
  let filteredGame = excludeOtherPlayerCards clientUsername g
  runEffect $ yield (NewGameState n filteredGame) >-> toOutput outgoingMailbox
  return ()

-- sends new game states to subscribers
-- At the moment all clients receive updates from every game indiscriminately
broadcast :: TVar ServerState -> TableName -> Pipe Game Game IO ()
broadcast s n = do
  g <- await
  ServerState {..} <- liftIO $ readTVarIO s
  let usernames' = M.keys clients -- usernames to broadcast to
  liftIO $ async $ mapM_ (informSubscriber n g) clients
  yield g

logGame :: TableName -> Pipe Game Game IO ()
logGame tableName = do
  g <- await
  liftIO $ print g
  yield g

-- Lookups up a table with the given name and writes the new game state
-- to the gameIn mailbox for propagation to observers.
--
-- If table with tableName is not found in the serverState lobby
-- then we just return () and do nothing.
toGameInMailbox :: TVar ServerState -> TableName -> Game -> IO ()
toGameInMailbox s name game = do
  table' <- atomically $ getTable s name
  forM_ table' send
  where
    send Table {..} = runEffect $ yield game >-> toOutput gameInMailbox

-- Get a combined outgoing mailbox for a group of clients who are observing a table
--
-- Here we monoidally combined so we then have one mailbox
-- we use to broadcast new game states to which will be sent out to each client's
-- socket connection under the hood
combineOutMailboxes :: [Client] -> Consumer MsgOut IO ()
combineOutMailboxes clients = toOutput $ foldMap outgoingMailbox clients

getTable :: TVar ServerState -> TableName -> STM (Maybe Table)
getTable s tableName = do
  ServerState {..} <- readTVar s
  return $ M.lookup tableName $ unLobby lobby

updateTable :: TVar ServerState -> TableName -> Pipe Game Game IO ()
updateTable serverStateTVar tableName = do
  g <- await
  liftIO $ atomically $ updateTable' serverStateTVar tableName g
  yield g

updateTable' :: TVar ServerState -> TableName -> Game -> STM ()
updateTable' serverStateTVar tableName newGame = do
  ServerState {..} <- readTVar serverStateTVar
  case M.lookup tableName $ unLobby lobby of
    Nothing -> throwSTM $ TableDoesNotExistInLobby tableName
    Just table@Table {..} -> do
      let updatedLobby = updateTableGame tableName newGame lobby
      swapTVar serverStateTVar ServerState {lobby = updatedLobby, ..}
      return ()

updateTableAndGetMailbox ::
  TVar ServerState -> TableName -> Game -> STM (Maybe (Output Game))
updateTableAndGetMailbox serverStateTVar tableName newGame = do
  ServerState {..} <- readTVar serverStateTVar
  case M.lookup tableName $ unLobby lobby of
    Nothing -> throwSTM $ TableDoesNotExistInLobby tableName
    Just table@Table {..} -> do
      let updatedLobby = updateTableGame tableName newGame lobby
      swapTVar serverStateTVar ServerState {lobby = updatedLobby, ..}
      return $ Just gameInMailbox

updateTableGame :: TableName -> Game -> Lobby -> Lobby
updateTableGame tableName newGame (Lobby lobby) =
  Lobby $
    M.adjust updateTable tableName lobby
  where
    updateTable Table {..} = Table {game = newGame, ..}


================================================
FILE: server/src/Socket/Types.hs
================================================
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Socket.Types where

import Control.Concurrent (MVar)
import Control.Concurrent.STM (TChan, TVar)
import Control.Concurrent.STM.TChan (TChan)
import Control.Exception (Exception)
import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson.Types (FromJSON, ToJSON)
import Data.Map.Lazy (Map)
import qualified Data.Map.Lazy as M
import Data.Text (Text)
import Database.Persist.Postgresql (ConnectionString)
import GHC.Generics (Generic)
import qualified Network.WebSockets as WS
import Pipes.Concurrent (Input, Output)
import Pipes
  ( Consumer,
    Effect,
    Pipe,
    await,
    runEffect,
    yield,
    (>->),
  )
import Poker.Types
  ( Action,
    Game,
    GameErr,
  )
import Types
  ( RedisConfig,
    Username,
  )

data MsgHandlerConfig = MsgHandlerConfig
  { dbConn :: ConnectionString,
    serverStateTVar :: TVar ServerState,
    username :: Username,
    clientConn :: WS.Connection,
    redisConfig :: RedisConfig
  }

type TableName = Text

newtype Lobby
  = Lobby (Map TableName Table)
  deriving (Ord, Eq, Show)

instance Show ServerState where
  show _ = ""

-- exception when adding subscriber to table if subscriber already exists inside STM transaction
newtype CannotAddAlreadySubscribed
  = CannotAddAlreadySubscribed Text
  deriving (Show)

instance Exception CannotAddAlreadySubscribed

-- exception for cannot find a table with given TableName in Lobby inside STM transaction
newtype TableDoesNotExistInLobby
  = TableDoesNotExistInLobby Text
  deriving (Show)

instance Exception TableDoesNotExistInLobby

data TableConfig = TableConfig
  { botCount :: Int, -- number of bots to maintain at table
    minHumans :: Int -- number of humans to wait for before starting a game
  } deriving (Show, Eq, Generic, FromJSON, ToJSON)

headsUpBotsConfig :: TableConfig
headsUpBotsConfig =
  TableConfig
    { botCount = 2,
      minHumans = 0
    }

data Table = Table
  { subscribers :: [Username], -- observing public game state includes players sat down
    gameOutMailbox :: Input Game, -- outgoing MsgOuts broadcasts -> write source for msgs to propagate new game states to clients
    gameInMailbox :: Output Game, --incoming gamestates -> read (consume) source for new game states
    waitlist :: [Username], -- waiting to join a full table
    bots :: Maybe (Consumer Game IO ()),
    game :: Game,
    channel :: TChan MsgOut,
    config :: TableConfig
  }

instance Show Table where
  show Table {..} =
    show subscribers <> "\n" <> show waitlist <> "\n" <> show game

instance Eq Table where
  Table {game = game1} == Table {game = game2} = game1 == game2

instance Ord Table where
  Table {game = game1} `compare` Table {game = game2} =
    game1 `compare` game2

data Client = Client
  { clientUsername :: Text,
    conn :: WS.Connection,
    outgoingMailbox :: Output MsgOut
  }

instance Show Client where
  show Client {..} = show clientUsername

data ServerState = ServerState
  { clients :: Map Username Client,
    lobby :: Lobby
  }

instance Eq Client where
  Client {clientUsername = clientUsername1} == Client {clientUsername = clientUsername2} =
    clientUsername1 == clientUsername2

-- incoming messages from a ws client
data MsgIn
  = GetTables
  | SubscribeToTable TableName
  | LeaveTable
  | GameMsgIn GameMsgIn
  deriving (Show, Eq, Generic, FromJSON, ToJSON)

data GameMsgIn
  = TakeSeat
      TableName
      Int
  | LeaveSeat TableName
  | GameMove TableName Action
  deriving (Show, Eq, Generic, FromJSON, ToJSON)

-- For the lobby view so client can make an informed decision about which game to join
data TableSummary = TableSummary
  { _tableName :: Text,
    _playerCount :: Int,
    _minBuyInChips :: Int,
    _maxBuyInChips :: Int,
    _maxPlayers :: Int,
    _waitlistCount :: Int,
    _smallBlind :: Int,
    _bigBlind :: Int
  }
  deriving (Show, Eq, Generic, FromJSON, ToJSON)

-- outgoing messages for clients
data MsgOut
  = TableList [TableSummary]
  | SuccessfullySatDown
      TableName
      Game
  | SuccessfullyLeftSeat TableName
  | SuccessfullySubscribedToTable
      TableName
      Game
  | GameMsgOut GameMsgOut
  | NewGameState TableName Game
  | ErrMsg Err
  | AuthSuccess
  | Noop
  deriving (Show, Eq, Generic, FromJSON, ToJSON)

data GameMsgOut
  = GameMoveErr Err
  | PlayerLeft
  | PlayerJoined TableName Text
  deriving (Show, Eq, Generic, FromJSON, ToJSON)

data Err
  = TableFull TableName
  | TableDoesNotExist TableName
  | NotSatAtTable TableName
  | AlreadySatInGame TableName
  | NotSatInGame TableName
  | AlreadySatAtTable TableName
  | AlreadySubscribedToTable TableName
  | NotEnoughChipsToSit
  | GameErr GameErr
  | InvalidGameAction
  | ChipAmountNotWithinBuyInRange TableName
  | UserDoesNotExistInDB Text
  | AuthFailed Text
  deriving (Show, Eq, Generic, FromJSON, ToJSON)

newtype Token = Token Text -- JWT


================================================
FILE: server/src/Socket/Utils.hs
================================================
module Socket.Utils where

import Data.Aeson (decode, encode)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Map.Lazy (Map)
import qualified Data.Map.Lazy as M
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as X
import qualified Data.Text.Lazy.Encoding as D
import Data.Time.Calendar (Day (ModifiedJulianDay))
import Data.Time.Clock (UTCTime (UTCTime), secondsToDiffTime)
import Socket.Types (Lobby (..), MsgIn, MsgOut, Table, TableName)
import Text.Pretty.Simple (pPrint)
import Prelude

encodeMsgToJSON :: MsgOut -> Text
encodeMsgToJSON a = T.pack $ show $ X.toStrict $ D.decodeUtf8 $ encode a

encodeMsgX :: MsgIn -> Text
encodeMsgX a = T.pack $ show $ X.toStrict $ D.decodeUtf8 $ encode a

parseMsgFromJSON :: Text -> Maybe MsgIn
parseMsgFromJSON jsonTxt = decode $ C.pack $ T.unpack jsonTxt

parseMsgFromJSON' :: BS.ByteString -> Maybe MsgIn
parseMsgFromJSON' jsonTxt = decode $ C.fromStrict jsonTxt

getTimestamp :: UTCTime
getTimestamp = UTCTime (ModifiedJulianDay 0) (secondsToDiffTime 0)

unLobby :: Lobby -> Map TableName Table
unLobby (Lobby lobby) = lobby


================================================
FILE: server/src/Socket/Workers.hs
================================================
{-# LANGUAGE RecordWildCards #-}

module Socket.Workers where

import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (Async, async)
import Control.Concurrent.STM
  ( TChan,
    TVar,
    atomically,
    dupTChan,
    readTChan,
  )
import Control.Concurrent.STM.TChan (TChan, dupTChan, readTChan)
import Control.Monad (forever)
import Control.Monad.STM (atomically)
import Data.Map.Lazy (Map)
import qualified Data.Map.Lazy as M
import Data.Text (Text)
import Database
  ( dbGetTableEntity,
    dbInsertTableEntity,
    dbRefillAvailableChips,
  )
import Database.Persist (Entity (Entity), PersistEntity (Key))
import Database.Persist.Postgresql
  ( ConnectionString,
    SqlPersistT,
    runMigration,
    withPostgresqlConn,
  )
import Schema (Key, TableEntity)
import Socket.Types
  ( Lobby (..),
    MsgOut (NewGameState),
    ServerState,
    Table
      ( Table,
        channel,
        game,
        gameInMailbox,
        gameOutMailbox,
        subscribers,
        waitlist
      ),
    TableName,
  )

forkBackgroundJobs ::
  ConnectionString -> TVar ServerState -> Lobby -> IO [Async ()]
forkBackgroundJobs connString serverStateTVar lobby = do
  forkChipRefillDBWriter connString chipRefillInterval chipRefillThreshold -- Periodically refill player chip balances when too low.
  forkGameDBWriters connString lobby -- At the end of game write new game and player data to the DB.
  where
    chipRefillInterval = 50000000 -- 1 mins
    chipRefillThreshold = 200000 -- any lower chip count will be topped up on refill to this amount

-- Fork a new thread for each table that writes game updates received from the table channel to the DB
forkGameDBWriters :: ConnectionString -> Lobby -> IO [Async ()]
forkGameDBWriters connString (Lobby lobby) =
  sequence $
    ( \(tableName, Table {..}) -> forkGameDBWriter connString channel tableName
    )
      <$> M.toList lobby

-- Looks up the tableName in the DB to get the key and if no corresponsing  table is found in the db then
-- we insert a new table to the db. This step is necessary as we use the TableID as a foreign key in the
-- For Game Entities in the DB.
-- After we have the TableID we fork a new process which listens to the channel which emits new game states
-- for a given table. For each new game state msg received we write the new game state into the DB.
forkGameDBWriter ::
  ConnectionString -> TChan MsgOut -> TableName -> IO (Async ())
forkGameDBWriter connString chan tableName = do
  maybeTableEntity <- dbGetTableEntity connString tableName
  case maybeTableEntity of
    Nothing -> do
      tableKey <- dbInsertTableEntity connString tableName
      forkGameWriter tableKey
    Just (Entity tableKey _) -> forkGameWriter tableKey
  where
    forkGameWriter tableKey =
      async (writeNewGameStatesToDB connString chan tableKey)

writeNewGameStatesToDB ::
  ConnectionString -> TChan MsgOut -> Key TableEntity -> IO ()
writeNewGameStatesToDB connString chan tableKey = do
  dupChan <- atomically $ dupTChan chan
  forever $ do
    chanMsg <- atomically $ readTChan dupChan
    case chanMsg of
      (NewGameState tableName game) -> return ()
      _ -> return ()

-- Fork a thread which refills low player chips balances in DB at a given interval
forkChipRefillDBWriter :: ConnectionString -> Int -> Int -> IO (Async ())
forkChipRefillDBWriter connString interval chipsThreshold =
  async $
    forever $ do
      dbRefillAvailableChips connString chipsThreshold
      threadDelay interval


================================================
FILE: server/src/Socket.hs
================================================
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

module Socket
  ( runSocketServer,
  )
where

import Bots
import Bots (bot1, bot2)
import Control.Concurrent (forkIO, threadDelay)
import Control.Concurrent.Async (Async, async)
import Control.Concurrent.STM
  ( STM,
    TVar,
    atomically,
    newTVarIO,
    readTVar,
    readTVarIO,
    writeTVar,
  )
import Control.Exception ()
import Control.Lens ((^.))
import Control.Monad (Monad (return), forever, void)
import Control.Monad.Except
  ( Monad (return),
    MonadIO (liftIO),
    MonadTrans (lift),
    forever,
    void,
  )
import Control.Monad.Reader
  ( Monad (return),
    MonadIO (liftIO),
    MonadTrans (lift),
    ReaderT (runReaderT),
    forever,
    void,
  )
import Control.Monad.STM (STM, atomically)
import Crypto.JWT ()
import Data.Aeson
  ( FromJSON,
    ToJSON,
  )
import qualified Data.Aeson as A
import qualified Data.ByteString as BS
import Data.ByteString.Lazy
  ( fromStrict,
    toStrict,
  )
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as C
import Data.ByteString.UTF8 (fromString)
import Data.Either (Either (Left, Right))
import Data.Foldable (traverse_)
import qualified Data.List as L
import qualified Data.Map.Lazy as M
import Data.Maybe (Maybe (Just, Nothing))
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as X
import qualified Data.Text.Lazy.Encoding as D
import Database ()
import Database.Persist.Postgresql (ConnectionString)
import qualified GHC.IO.Exception as G
import qualified Network.WebSockets as WS
import Pipes
  ( MonadIO (liftIO),
    MonadTrans (lift),
    Pipe,
    Producer,
    await,
    for,
    runEffect,
    void,
    yield,
    (>->),
  )
import Pipes.Aeson (decode)
import Pipes.Concurrent
  ( Input,
    Output (send),
    STM,
    atomically,
    forkIO,
    fromInput,
    newTVarIO,
    newest,
    readTVar,
    spawn,
    toOutput,
  )
import Pipes.Core (push)
import Pipes.Parse
  ( Producer,
    StateT (runStateT),
    draw,
    lift,
    yield,
  )
import qualified Pipes.Prelude as P
import Poker.ActionValidation ()
import Poker.Game.Blinds ()
import Poker.Game.Game ()
import Poker.Game.Utils ()
import Poker.Poker ()
import Poker.Types (Game, playerName)
import Socket.Clients
  ( addClient,
    authClient,
    sendMsg,
    updateWithLatestGames,
  )
import Socket.Lobby (initialLobby, summariseTables)
import Socket.Msg (msgHandler)
import Socket.Setup ()
import Socket.Subscriptions ()
import Socket.Table
  ( setUpTablePipes,
    updateTableAndGetMailbox,
    updateTableGame,
  )
import Socket.Types
  ( Client (Client, clientUsername, conn, outgoingMailbox),
    GameMsgIn (GameMove),
    Lobby,
    MsgHandlerConfig (..),
    MsgIn,
    MsgOut (AuthSuccess, ErrMsg, NewGameState, TableList),
    ServerState (..),
    TableName,
    Token (Token),
  )
import Socket.Utils (encodeMsgToJSON, unLobby)
import Socket.Workers (forkBackgroundJobs)
import System.Random ()
import System.Timeout ()
import Types (RedisConfig, Username (Username))
import Web.JWT (Secret)
import Prelude

initialServerState :: Lobby -> ServerState
initialServerState lobby = ServerState {clients = M.empty, lobby = lobby}

-- Create the initial lobby holding all game state and then fork a new thread for each table in the lobby
-- to write new game states to the DB
runSocketServer ::
  BS.ByteString -> Int -> ConnectionString -> RedisConfig -> IO ()
runSocketServer secretKey port connString redisConfig = do
  lobby <- initialLobby
  serverStateTVar <- newTVarIO (initialServerState lobby)
  -- set up pipelines for broadcasting, progressing and logging new game states
  traverse_
    (uncurry $ setUpTablePipes connString serverStateTVar)
    (M.toList $ unLobby lobby)
  -- workers for refilling chips
  forkBackgroundJobs connString serverStateTVar lobby
  print $ "Socket server listening on " ++ (show port :: String)
  _ <-
    async $
      WS.runServer "0.0.0.0" port $
        application
          secretKey
          connString
          redisConfig
          serverStateTVar
  return ()
  where
    botNames = (^. playerName) <$> [bot1]
    playersToWaitFor = 2

-- subscriptions are handled by combining each subscribers mailbox into one large mailbox
-- where mew MsgOuts with new game states are posted
--
-- The new game state msgs will then propogate to to the subscribers mailbox and
-- sent via their websocket connection automatically
subscribeToTable :: Output MsgOut -> Output MsgOut -> Output MsgOut
subscribeToTable tableOutput playerOutput = tableOutput <> playerOutput

-- Note this doesn't propagate new game state to clients just updates the game in the lobby
updateGame :: TVar ServerState -> TableName -> Game -> STM ()
updateGame s tableName g = do
  ServerState {..} <- readTVar s
  let newLobby = updateTableGame tableName g lobby
  writeTVar s ServerState {lobby = newLobby, ..}

-- creates a mailbox which has both an input sink and output source which
-- models the bidirectionality of websockets.
-- We return input source which emits our received socket msgs.
websocketInMailbox :: MsgHandlerConfig -> IO (Output MsgIn, Output MsgOut)
websocketInMailbox conf@MsgHandlerConfig {..} = do
  (writeMsgInSource, readMsgInSource) <- spawn $ newest 1
  (writeMsgOutSource, readMsgOutSource) <- spawn $ newest 1
  async $
    forever $
      runEffect $
        fromInput readMsgInSource
          >-> msgInHandler conf
          >-> toOutput writeMsgOutSource -- process received MsgIn's and place resulting MsgOut in outgoing mailbox
  async $ socketMsgOutWriter clientConn readMsgOutSource -- send encoded MsgOuts from outgoing mailbox to socket
  return (writeMsgInSource, writeMsgOutSource)

-- Runs an IO action forever which parses read MsgIn's from the websocket connection
-- and puts them in our mailbox waiting to be processed by our MsgIn handler
--
--  Note - only parsed MsgIns make it into the mailbox - socket msgs which cannot be parsed
-- are silently ignored but logged anyway.
socketMsgInWriter :: WS.Connection -> Output MsgIn -> IO ()
socketMsgInWriter conn writeMsgInSource = do
  _ <-
    async $
      forever $
        runEffect $
          msgInDecoder (socketReader conn >-> logMsgIn)
            >-> toOutput writeMsgInSource
  return ()

socketMsgOutWriter :: WS.Connection -> Input MsgOut -> IO (Async ())
socketMsgOutWriter conn is =
  forever $
    runEffect $
      for
        (fromInput is >-> msgOutEncoder)
        (lift . WS.sendTextData conn)

-- Converts a websocket connection into a producer
socketReader :: WS.Connection -> Producer BS.ByteString IO ()
socketReader conn = forever $ do
  msg <- liftIO $ WS.receiveData conn
  yield msg

-- Convert a raw Bytestring producer of raw JSON into a new producer which yields
-- only successfully parsed values of type MsgIn.
--
-- Note that this parser deliberately ignores parsing errors as the naive implementation
-- would lead to parse errors closing the stream pipeline and thus the socket connection
msgInDecoder :: Producer BS.ByteString IO () -> Producer MsgIn IO ()
msgInDecoder rawMsgProducer = do
  (x, p') <- lift $ runStateT decode rawMsgProducer
  case x of
    Nothing -> return ()
    Just (Left a) -> do
      (_invalidMsg, p'') <- lift $ runStateT draw p'
      msgInDecoder p''
    Just c@(Right parsedMsgIn) -> do
      yield parsedMsgIn
      msgInDecoder p'

msgOutEncoder :: Pipe MsgOut Text IO ()
msgOutEncoder = do
  msgOut <- await
  yield $ encodeMsgToJSON msgOut

-- branches of code which do not yield messages place the burden of informing the client
-- onto the table pipeline as opposed to the remaining components after the player's socket
-- pipeline. Or in other words without yielding a msg this pipe will not directly inform the client
-- about what has happened.
msgInHandler :: MsgHandlerConfig -> Pipe MsgIn MsgOut IO ()
msgInHandler conf@MsgHandlerConfig {..} = do
  msgIn <- await
  res <- lift $ runReaderT (msgHandler msgIn) conf
  case res of
    Left err -> yield $ ErrMsg err
    Right (NewGameState tableName g) ->
      liftIO $ atomically $ updateGameState serverStateTVar tableName g
    Right m -> yield m

-- The main function for handling game updates which consists of
-- a series of events whose order must be guaranteed which
-- is why they are grouped in a STM block.
--
-- 1 - We update our game in the server state
-- 2 - We send new game to
-- the table's mailbox for broadcasting to clients and other actions
-- such as progressing the game along if possible
updateGameState :: TVar ServerState -> TableName -> Game -> STM ()
updateGameState serverStateTVar tableName newGame = do
  mbGameInMailbox' <- updateTableAndGetMailbox serverStateTVar tableName newGame
  case mbGameInMailbox' of
    Nothing -> return ()
    Just gameInMailbox' -> void (send gameInMailbox' newGame)

logMsgIn :: Pipe BS.ByteString BS.ByteString IO ()
logMsgIn = do
  msg <- await
  yield msg

logMsgOut :: Pipe MsgOut MsgOut IO ()
logMsgOut = do
  msg <- await
  yield msg


-- get a pipe which only forwards the game moves which occur at the given table
filterMsgsForTable :: Monad m => TableName -> Pipe GameMsgIn GameMsgIn m ()
filterMsgsForTable tableName =
  P.filter $ \(GameMove tableName' _) -> tableName == tableName'

-- New WS connections are expected to supply an access token as an initial msg
-- Once the token is verified the connection only then will the server state be
-- updated with the newly authenticated client.
--
-- After the client has been authenticated we fork a thread which writes
-- the clients msgs to a channel.
application ::
  BS.ByteString ->
  ConnectionString ->
  RedisConfig ->
  TVar ServerState ->
  WS.ServerApp
application secretKey dbConnString redisConfig s pending = do
  conn <- WS.acceptRequest pending
  WS.forkPingThread conn 30
  authMsg <- WS.receiveData conn
  ServerState {..} <- readTVarIO s
  eUsername <-
    authClient
      secretKey
      s
      dbConnString
      redisConfig
      conn
      (Token authMsg)
  case eUsername of
    Right u@(Username clientUsername) -> do
      (incomingMailbox, outgoingMailbox) <- websocketInMailbox $ msgConf conn u
      let client = Client {..}
      sendMsg conn AuthSuccess
      let isReconnect = client `elem` clients -- if client already on our list of clients then this is a reconnect
      updateWithLatestGames client lobby -- Sync game state with reconnected clients
      let tableSummaries = TableList $ summariseTables lobby
      liftIO $ sendMsg conn tableSummaries
      atomically $ addClient s client
      ServerState {..} <- liftIO $ atomically $ readTVar s
      forever $ do
        m <- WS.receiveData conn
        runEffect $
          msgInDecoder (yield m >-> logMsgIn)
            >-> toOutput incomingMailbox
        return ()
    Left err -> sendMsg conn (ErrMsg err)
  where
    msgConf c username =
      MsgHandlerConfig
        { serverStateTVar = s,
          dbConn = dbConnString,
          clientConn = c,
          redisConfig = redisConfig,
          ..
        }


================================================
FILE: server/src/Types.hs
================================================
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}

module Types where

import Data.Aeson (FromJSON, ToJSON)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Clock (UTCTime)
import Database.Redis (ConnectInfo)
import GHC.Generics (Generic)
import Servant ()
import Servant.API
  ( Capture,
    Get,
    JSON,
    (:>),
  )
import Servant.Auth.Server (FromJWT, ToJWT)

type RedisConfig = ConnectInfo

type Password = Text

data Login = Login
  { loginUsername :: Text,
    loginPassword :: Text
  }
  deriving (Eq, Show, Generic, ToJSON, FromJSON)

data Register = Register
  { newUserEmail :: Text,
    newUsername :: Username,
    newUserPassword :: Text
  }
  deriving (Eq, Show, Generic, FromJSON, ToJSON)

newtype Username
  = Username Text
  deriving (Generic, Show, Read, Eq, Ord, ToJWT, FromJWT)

unUsername :: Username -> Text
unUsername (Username username) = username

instance ToJSON Username

instance FromJSON Username

type UserID = Text

data UserProfile = UserProfile
  { proUsername :: Username,
    proEmail :: Text,
    proAvailableChips :: Int,
    proChipsInPlay :: Int,
    proUserCreatedAt :: UTCTime
  }
  deriving (Eq, Show, Generic, ToJSON, FromJSON)

data ReturnToken = ReturnToken
  { access_token :: Text,
    refresh_token :: Text,
    expiration :: Int --seconds to expire
  }
  deriving (Generic, ToJSON, FromJSON)


================================================
FILE: server/src/Users.hs
================================================
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Users where

import Control.Monad.Except
  ( MonadError (throwError),
    MonadIO (liftIO),
    runExceptT,
  )
import qualified Crypto.Hash.SHA256 as H
import qualified Crypto.JOSE as Jose
import Crypto.JWT (JWK)
import qualified Crypto.JWT as Jose
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.Lazy.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as CL
import Data.ByteString.Lazy.UTF8 as BLU (toString)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Data.Time.Clock (getCurrentTime)
import Database
  ( dbGetUserByLogin,
    dbGetUserByUsername,
    dbRegisterUser,
  )
import Database.Persist.Postgresql (ConnectionString)
import Schema
  ( UserEntity
      ( UserEntity,
        userEntityAvailableChips,
        userEntityChipsInPlay,
        userEntityCreatedAt,
        userEntityEmail,
        userEntityPassword,
        userEntityUsername
      ),
  )
import Servant
  ( Handler,
    NoContent (..),
    ServerError (errBody),
    err401,
    err404,
  )
import Servant.Auth.Server (JWTSettings, makeJWT)
import Types
  ( Login (..),
    RedisConfig,
    Register (..),
    ReturnToken (..),
    UserProfile (..),
    Username (..),
  )

fetchUserProfileHandler :: ConnectionString -> Username -> Handler UserProfile
fetchUserProfileHandler connString username' = do
  maybeUser <- liftIO $ dbGetUserByUsername connString username'
  case maybeUser of
    Nothing -> throwError err404
    Just UserEntity {..} ->
      return $
        UserProfile
          { proEmail = userEntityEmail,
            proAvailableChips = userEntityAvailableChips,
            proChipsInPlay = userEntityChipsInPlay,
            proUsername = Username userEntityUsername,
            proUserCreatedAt = userEntityCreatedAt
          }

hashPassword :: Text -> Text
hashPassword password = T.pack $ C.unpack $ H.hash $ encodeUtf8 password

signToken :: JWTSettings -> Username -> Handler ReturnToken
signToken jwtSettings username' = do
  eToken <- liftIO $ makeJWT username' jwtSettings expiryTime
  case eToken of
    Left e -> throwError $ unAuthErr $ BS.pack $ show eToken
    Right token ->
      return $
        ReturnToken
          { access_token = T.pack (BLU.toString token),
            refresh_token = "",
            expiration = 9999999,
            ..
          }
  where
    expiryTime = Nothing
    unAuthErr e = err401 {errBody = e}

loginHandler :: JWTSettings -> ConnectionString -> Login -> Handler ReturnToken
loginHandler jwtSettings connString l@Login {..} = do
  liftIO (print l)
  maybeUser <- liftIO $ dbGetUserByLogin connString loginWithHashedPswd
  case maybeUser of
    Nothing -> throwError unAuthErr
    Just u@UserEntity {..} ->
      signToken jwtSettings (Username userEntityUsername)
  where
    unAuthErr = err401 {errBody = "Incorrect email or password"}
    loginWithHashedPswd =
      Login {loginPassword = hashPassword loginPassword, ..}

-- when we register new user we check to see if email and username are already taken
-- if they are then the exception will be propagated to the client
registerUserHandler ::
  JWTSettings ->
  ConnectionString ->
  RedisConfig ->
  Register ->
  Handler ReturnToken
registerUserHandler jwtSettings connString redisConfig Register {..} = do
  currTime <- liftIO getCurrentTime
  let hashedPassword = hashPassword newUserPassword
      (Username username) = newUsername
      newUser =
        UserEntity
          { userEntityUsername = username,
            userEntityEmail = newUserEmail,
            userEntityPassword = hashedPassword,
            userEntityAvailableChips = 3000,
            userEntityChipsInPlay = 0,
            userEntityCreatedAt = currTime
          }
  registrationResult <-
    liftIO $
      runExceptT $
        dbRegisterUser connString redisConfig newUser
  case registrationResult of
    Left err -> throwError $ err401 {errBody = CL.pack $ T.unpack err}
    _ -> signToken jwtSettings newUsername

getLobbyHandler :: JWTSettings -> ConnectionString -> RedisConfig -> Handler NoContent
getLobbyHandler _ _ _ = do
  return NoContent


================================================
FILE: server/stack.yaml
================================================
# Resolver to choose a 'specific' stackage snapshot or a compiler version.
# A snapshot resolver dictates the compiler version and the set of packages
# to be used for project dependencies. For example:
#
# resolver: lts-3.5
# resolver: nightly-2015-09-21
# resolver: ghc-7.10.2
# resolver: ghcjs-0.1.0_ghc-7.10.2
#
# The location of a snapshot can be provided as a file or url. Stack assumes
# a snapshot provided as a file might change, whereas a url resource does not.
#
# resolver: ./custom-snapshot.yaml
# resolver: https://example.com/snapshots/2018-01-01.yaml
resolver: lts-18.13

# User packages to be built.
# Various formats can be used as shown in the example below.
#
# packages:
# - some-directory
# - https://example.com/foo/bar/baz-0.0.2.tar.gz
# - location:
#    git: https://github.com/commercialhaskell/stack.git
#    commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
#  subdirs:
#  - auto-update
#  - wai
packages:
  - .
allow-newer: true
extra-deps:
  - servant-options-0.1.0.0
  - jwt-0.7.2
  - servant-websockets-2.0.0@sha256:6e9e3600bced90fd52ed3d1bf632205cb21479075b20d6637153cc4567000234,2253
  - servant-auth-client-0.4.1.0@sha256:96d8153907a00ef05e8918ca03a972d95ecde485da0df12f6532d248f057eb60,3437
  - ekg-0.4.0.15@sha256:d6e48859a89fbbe23496f871581e44a41f97dac627c2b9db81f49b92fa066516,2031
  - ekg-core-0.1.1.7@sha256:c4356aefea0e1e2f80a236d3b3f81b83b445c1e53519302e96477da0adee2e9f,2039
  - ekg-json-0.1.0.6@sha256:e16efc1b09ae7635db3f0535335ee3e8aa666fe4bf3749783f4022020f6ca3b8,1050


nix:
  enable: false
  pure: false
  packages: [ postgresql zlib ]

  # This file was automatically generated by 'stack init'
#
# Some commonly used options have been documented as comments in this file.
# For advanced use and comprehensive documentation of the format, please see:
# https://docs.haskellstack.org/en/stable/yaml_configuration/

local-bin-path: build
# Dependency packages to be pulled from upstream that are not in the resolver
# using the same syntax as the packages field.
# (e.g., acme-missiles-0.3)
# extra-deps: []

# Override default flag values for local packages and extra-deps
# flags: {}

# Extra package databases containing global packages
# extra-package-dbs: []

# Control whether we use the GHC we find on the path
# system-ghc: true
#
# Require a specific version of stack, using version ranges
# require-stack-version: -any # Default
# require-stack-version: ">=1.7"
#
# Override the architecture used by stack, especially useful on Windows
# arch: i386
# arch: x86_64
#
ghc-options:
  "$locals": -j # Parallel Builds
  "$locals": -O0 # No GHC optimisations

# Extra directories used by stack for building
# extra-include-dirs: [/path/to/dir]
# extra-lib-dirs: [/path/to/dir]
#
# Allow a newer minor version of GHC than the snapshot specifies
# compiler-check: newer-minor


================================================
FILE: server/test/Poker/ActionSpec.hs
================================================
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Poker.ActionSpec where

import Control.Lens (Ixed (ix), (.~), (^.), (^?))
import Data.Text (Text)
import qualified Data.Text as T
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Poker.Game.Actions
  ( call,
    check,
    foldCards,
    makeBet,
    postBlind,
    sitOut,
  )
import Poker.Game.Utils (initialDeck)
import Poker.Poker (initialGameState)
import Poker.Types
  ( Blind (SmallBlind),
    Game (_pot, _smallBlind),
    Player (..),
    PlayerState (..),
    SatInState (..),
    Street (PreDeal, PreFlop),
    actedThisTurn,
    chips,
    committed,
    currentPosToAct,
    maxBet,
    playerStatus,
    players,
    pot,
    street,
  )
import Test.Hspec (describe, it, shouldBe)

initialGameState' :: Game
initialGameState' = initialGameState initialDeck

player1 :: Player
player1 =
  Player
    { _pockets = Nothing,
      _chips = 2000,
      _bet = 0,
      _playerStatus = SatIn NotFolded,
      _playerName = "player1",
      _committed = 100,
      _actedThisTurn = True,
      _possibleActions = []
    }

player2 :: Player
player2 =
  Player
    { _pockets = Nothing,
      _chips = 2000,
      _bet = 0,
      _playerStatus = SatIn Folded,
      _playerName = "player2",
      _committed = 50,
      _actedThisTurn = False,
      _possibleActions = []
    }

player3 :: Player
player3 =
  Player
    { _pockets = Nothing,
      _chips = 2000,
      _bet = 0,
      _playerStatus = SatIn NotFolded,
      _playerName = "player3",
      _committed = 50,
      _actedThisTurn = False,
      _possibleActions = []
    }

player4 :: Player
player4 =
  Player
    { _pockets = Nothing,
      _chips = 2000,
      _bet = 0,
      _playerStatus = SatIn NotFolded,
      _playerName = "player3",
      _committed = 0,
      _actedThisTurn = False,
      _possibleActions = []
    }

player5 :: Player
player5 =
  Player
    { _pockets = Nothing,
      _chips = 4000,
      _bet = 4000,
      _playerStatus = SatIn NotFolded,
      _playerName = "player5",
      _committed = 4000,
      _actedThisTurn = True,
      _possibleActions = []
    }

player6 :: Player
player6 =
  Player
    { _pockets = Nothing,
      _chips = 2000,
      _bet = 200,
      _playerStatus = SatIn NotFolded,
      _playerName = "player6",
      _committed = 250,
      _actedThisTurn = True,
      _possibleActions = []
    }

bettingFinishedGame :: Game
bettingFinishedGame =
  ((players .~ [player1, player2]) . (street .~ PreFlop)) initialGameState'

bettingNotFinishedGame :: Game
bettingNotFinishedGame =
  ((players .~ [player1, player2, player3, player4]) . (street .~ PreFlop))
    initialGameState'

spec = do
  describe "postBlind" $ do
    it "should update player attributes correctly" $ do
      let game =
            (street .~ PreDeal)
              . (players .~ [(committed .~ 0) player1, player3])
              $ initialGameState'
          pName = "player1"
          blind = SmallBlind
          newGame = postBlind blind pName game
          playerWhoBet = newGame ^? players . ix 0
          smallBlindValue = _smallBlind game
          expectedPlayer =
            Player
              { _pockets = Nothing,
                _chips = 2000 - smallBlindValue,
                _bet = smallBlindValue,
                _playerStatus = SatIn NotFolded,
                _playerName = "player1",
                _committed = smallBlindValue,
                _actedThisTurn = True,
                _possibleActions = []
              }
      playerWhoBet `shouldBe` Just expectedPlayer

    it "should add blind bet to pot" $ do
      let game =
            (street .~ PreDeal) . (players .~ [player1, player3]) $
              initialGameState'
          pName = "player1"
          blind = SmallBlind
          newGame = postBlind blind pName game
          playerWhoBet = newGame ^? players . ix 0
      _pot newGame `shouldBe` _smallBlind game

  describe "bet" $ do
    it "should update player attributes correctly" $ do
      let game =
            (street .~ PreFlop) . (players .~ [player1, player2, player3]) $
              initialGameState'
          betValue = 200
          pName = "player1"
          newGame = makeBet betValue pName game
          playerWhoBet = newGame ^? players . ix 0
          expectedPlayer =
            Player
              { _pockets = Nothing,
                _chips = 2000 - betValue,
                _bet = betValue,
                _playerStatus = SatIn NotFolded,
                _playerName = "player1",
                _committed = 100 + betValue,
                _actedThisTurn = True,
                _possibleActions = []
              }
      playerWhoBet `shouldBe` Just expectedPlayer

    it "should add bet amount to pot" $ do
      let game =
            (street .~ PreFlop) . (players .~ [player1, player2, player3]) $
              initialGameState'
          betValue = 200
          pName = "player1"
          newGame = makeBet betValue pName game
      (newGame ^. pot) `shouldBe` betValue

    it "should update maxBet if amount greater than current maxBet" $ do
      let game =
            (street .~ PreFlop) . (players .~ [player1, player2, player3]) $
              initialGameState'
          betValue = 200
          pName = "player1"
          newGame = makeBet betValue pName game
      (newGame ^. maxBet) `shouldBe` betValue

    it "should update player attributes correctly when bet all in" $ do
      let game =
            (street .~ PreFlop) . (players .~ [player1, player2, player3]) $
              initialGameState'
          betValue = player1 ^. chips
          pName = "player1"
          newGame = makeBet betValue pName game
          playerWhoBet = newGame ^? players . ix 0
          expectedPlayer =
            Player
              { _pockets = Nothing,
                _chips = 0,
                _bet = betValue,
                _playerStatus = SatIn NotFolded,
                _playerName = "player1",
                _committed = 100 + betValue,
                _actedThisTurn = True,
                _possibleActions = []
              }
      playerWhoBet `shouldBe` Just expectedPlayer

    it "should increment position to act" $ do
      let game =
            (street .~ PreFlop) . (currentPosToAct .~ pure 0)
              . (players .~ [player1, player2, player3])
              $ initialGameState'
          betValue = 200
          pName = "player1"
          newGame = makeBet betValue pName game
          newPositionToAct = newGame ^. currentPosToAct
          expectedNewPositionToAct = Just 2
      newPositionToAct `shouldBe` expectedNewPositionToAct

  describe "foldCards" $ do
    it "should update player attributes correctly" $ do
      let game =
            (street .~ PreFlop) . (players .~ [player1, player2, player3]) $
              initialGameState'
          pName = "player1"
          newGame = foldCards pName game
          playerWhoFolded = newGame ^? players . ix 0
          expectedPlayer =
            Player
              { _pockets = Nothing,
                _chips = 2000,
                _bet = 0,
                _playerStatus = SatIn Folded,
                _playerName = "player1",
                _committed = 100,
                _actedThisTurn = True,
                _possibleActions = []
              }
      playerWhoFolded `shouldBe` Just expectedPlayer
    it "should increment position to act" $ do
      let game =
            (street .~ PreFlop) . (currentPosToAct .~ pure 0)
              . (players .~ [player1, player2, player3])
              $ initialGameState'
          pName = "player1"
          newGame = foldCards pName game
          newPositionToAct = newGame ^. currentPosToAct
          expectedNewPositionToAct = Just 2
      newPositionToAct `shouldBe` expectedNewPositionToAct

  describe "call" $ do
    it "should update player attributes correctly when calling a bet" $ do
      let game =
            (street .~ PreFlop) . (maxBet .~ 400)
              . (players .~ [player1, player6])
              $ initialGameState'
          pName = "player6"
          newGame = call pName game
          playerWhoCalled = newGame ^? players . ix 1
          expectedPlayer =
            Player
              { _pockets = Nothing,
                _chips = 1800,
                _bet = 400,
                _playerStatus = SatIn NotFolded,
                _playerName = "player6",
                _committed = 450,
                _actedThisTurn = True,
                _possibleActions = []
              }
      playerWhoCalled `shouldBe` Just expectedPlayer

    it "should update player attributes correctly when calling AllIn" $ do
      let game' =
            (street .~ PreFlop) . (maxBet .~ 4000)
              . (players .~ [player5, player1])
              $ initialGameState'
          pName' = "player1"
          newGame' = call pName' game'
          playerWhoCalled' = newGame' ^? players . ix 1
          expectedPlayer' =
            Player
              { _pockets = Nothing,
                _chips = 0,
                _bet = 2000,
                _playerStatus = SatIn NotFolded,
                _playerName = "player1",
                _committed = 2100,
                _actedThisTurn = True,
                _possibleActions = []
              }
      playerWhoCalled' `shouldBe` Just expectedPlayer'

    it "should increment position to act" $ do
      let game =
            (street .~ PreFlop) . (currentPosToAct .~ pure 0)
              . (players .~ [player1, player2, player3])
              $ initialGameState'
          pName = "player1"
          newGame = call pName game
          newPositionToAct = newGame ^. currentPosToAct
          expectedNewPositionToAct = Just 2
      newPositionToAct `shouldBe` expectedNewPositionToAct

  describe "check" $ do
    it "should update player attributes correctly" $ do
      let game =
            (street .~ PreFlop) . (players .~ [player1, player2]) $
              initialGameState'
          pName = "player1"
          expectedPlayers = [player1, player2, player3]
          newGame = check pName game
          playerWhoChecked = newGame ^? players . ix 0
          expectedPlayer = (actedThisTurn .~ True) player1
      playerWhoChecked `shouldBe` Just expectedPlayer

    it "should increment position to act" $ do
      let game =
            (street .~ PreFlop) . (currentPosToAct .~ pure 0)
              . (players .~ [player1, player3])
              $ initialGameState'
          pName = "player1"
          newGame = check pName game
          newPositionToAct = newGame ^. currentPosToAct
          expectedNewPositionToAct = Just 1
      newPositionToAct `shouldBe` expectedNewPositionToAct

  describe "SitOut" $
    it "should set playerStatus to SatOut" $ do
      let game =
            (street .~ PreDeal) . (players .~ [player1, player6]) $
              initialGameState'
          pName = "player6"
          expectedPlayer = (playerStatus .~ SatOut) player6
          newGame = sitOut pName game
          playerWhoChecked = newGame ^? players . ix 1
      playerWhoChecked `shouldBe` Just expectedPlayer


================================================
FILE: server/test/Poker/ActionValidationSpec.hs
================================================
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Poker.ActionValidationSpec where

import Control.Lens (element, (%~), (&), (.~), (?~))
import Data.Either (isLeft, isRight)
import Data.Text (Text)
import qualified Data.Text as T
import Hedgehog (Property, forAll, property, withDiscards, (===))
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Poker.ActionValidation
  ( canBet,
    canCall,
    canCheck,
    canFold,
    canPostBlind,
    canRaise,
    canShowOrMuckHand,
    checkPlayerSatAtTable,
    isPlayerActingOutOfTurn,
    validateAction,
    validateBlindAction,
  )
import Poker.Game.Utils (initialDeck)
import Poker.Generators (allPStates, allPStreets, genGame)
import Poker.Poker (initialGameState)
import Poker.Types
  ( Action (Check, Fold, LeaveSeat', PostBlind, SitOut, Timeout),
    Blind (BigBlind, SmallBlind),
    CurrentPlayerToActErr (CurrentPlayerToActErr),
    Deck (Deck),
    Game (..),
    GameErr (InvalidMove, NotAtTable),
    HandRank (Pair),
    InvalidMoveErr
      ( AlreadySatOut,
        BetLessThanBigBlind,
        CannotBetShouldRaiseInstead,
        CannotCallZeroAmountCheckOrBetInstead,
        CannotCheckShouldCallRaiseOrFold,
        CannotLeaveSeatOutsidePreDeal,
        CannotShowHandOrMuckHand,
        CannotSitOutOutsidePreDeal,
        InvalidActionForStreet,
        NoPlayerCanAct,
        NotEnoughChipsForAction,
        OutOfTurn
      ),
    Player
      ( Player,
        _actedThisTurn,
        _bet,
        _chips,
        _committed,
        _playerName,
        _playerStatus,
        _pockets,
        _possibleActions
      ),
    PlayerShowdownHand (PlayerShowdownHand),
    PlayerState (..),
    SatInState (..),
    Street (Flop, PreDeal, PreFlop, River, Showdown, Turn),
    Winners (MultiPlayerShowdown, NoWinners, SinglePlayerShowdown),
    actedThisTurn,
    bet,
    chips,
    committed,
    currentPosToAct,
    dealer,
    deck,
    maxBet,
    playerStatus,
    players,
    pot,
    street,
    winners,
  )
import Test.Hspec (describe, it, shouldBe)
import Test.Hspec.Hedgehog
  ( PropertyT,
    diff,
    forAll,
    hedgehog,
    modifyMaxDiscardRatio,
    (/==),
    (===),
  )

initialGameState' :: Game
initialGameState' = initialGameState initialDeck

player1 :: Player
player1 =
  Player
    { _pockets = Nothing,
      _chips = 2000,
      _bet = 200,
      _playerStatus = SatIn NotFolded,
      _playerName = "player1",
      _committed = 250,
      _actedThisTurn = False,
      _possibleActions = []
    }

player2 :: Player
player2 =
  Player
    { _pockets = Nothing,
      _chips = 2000,
      _bet = 0,
      _playerStatus = SatIn Folded,
      _playerName = "player2",
      _committed = 50,
      _actedThisTurn = False,
      _possibleActions = []
    }

player3 :: Player
player3 =
  Player
    { _pockets = Nothing,
      _chips = 300,
      _bet = 0,
      _playerStatus = SatIn NotFolded,
      _playerName = "player3",
      _committed = 50,
      _actedThisTurn = False,
      _possibleActions = []
    }

player4 :: Player
player4 =
  Player
    { _pockets = Nothing,
      _chips = 2000,
      _bet = 0,
      _playerStatus = SatOut,
      _playerName = "player4",
      _committed = 0,
      _actedThisTurn = False,
      _possibleActions = []
    }

player5 :: Player
player5 =
  Player
    { _pockets = Nothing,
      _chips = 2000,
      _bet = 0,
      _playerStatus = SatIn NotFolded,
      _playerName = "player5",
      _committed = 50,
      _actedThisTurn = False,
      _possibleActions = []
    }

playerFixtures :: [Player]
playerFixtures = [player1, player2, player3, player4]

playerFixtures2 :: [Player]
playerFixtures2 = [player3, player5]

callAllInHeadsUpFixture :: Game
callAllInHeadsUpFixture =
  Game
    { _dealer = 1,
      _currentPosToAct = Just 0,
      _smallBlind = 25,
      _bigBlind = 50,
      _minBuyInChips = 1500,
      _maxBuyInChips = 3000,
      _pot = 2500,
      _maxBet = 2400,
      _street = Turn,
      _winners = NoWinners,
      _board = [],
      _maxPlayers = 6,
      _waitlist = [],
      _deck = Deck [],
      _players =
        [ Player
            { _pockets = Nothing,
              _chips = 3500,
              _bet = 0,
              _playerStatus = SatIn NotFolded,
              _playerName = "player0",
              _committed = 50,
              _actedThisTurn = True,
              _possibleActions = []
            },
          Player
            { _pockets = Nothing,
              _chips = 0,
              _bet = 2400,
              _playerStatus = SatIn NotFolded,
              _playerName = "player1",
              _committed = 2450,
              _actedThisTurn = True,
              _possibleActions = []
            }
        ]
    }

preDealHeadsUpFixture :: Game
preDealHeadsUpFixture =
  Game
    { _dealer = 0,
      _currentPosToAct = Just 0,
      _smallBlind = 25,
      _bigBlind = 50,
      _minBuyInChips = 1500,
      _maxBuyInChips = 3000,
      _pot = 50,
      _maxBet = 50,
      _street = PreDeal,
      _winners = NoWinners,
      _board = [],
      _maxPlayers = 6,
      _waitlist = [],
      _deck = Deck [],
      _players =
        [ Player
            { _pockets = Nothing,
              _chips = 3000,
              _bet = 0,
              _playerStatus = SatIn NotFolded,
              _playerName = "player0",
              _committed = 0,
              _actedThisTurn = False,
              _possibleActions = []
            },
          Player
            { _pockets = Nothing,
              _chips = 2950,
              _bet = 50,
              _playerStatus = SatIn NotFolded,
              _playerName = "player1",
              _committed = 50,
              _actedThisTurn = True,
              _possibleActions = []
            }
        ]
    }

turnGameThreePlyrs :: Game
turnGameThreePlyrs =
  Game
    { _dealer = 2,
      _currentPosToAct = Just 0,
      _smallBlind = 25,
      _bigBlind = 50,
      _minBuyInChips = 1500,
      _maxBuyInChips = 3000,
      _pot = 550,
      _maxBet = 0,
      _street = Turn,
      _winners = NoWinners,
      _board = [],
      _maxPlayers = 6,
      _waitlist = [],
      _deck = Deck [],
      _players =
        [ Player
            { _pockets = Nothing,
              _chips = 2197,
              _bet = 0,
              _playerStatus = SatIn NotFolded,
              _playerName = "player0",
              _committed = 50,
              _actedThisTurn = False,
              _possibleActions = []
            },
          Player
            { _pockets = Nothing,
              _chips = 1847,
              _bet = 0,
              _playerStatus = SatIn NotFolded,
              _playerName = "player1",
              _committed = 250,
              _actedThisTurn = False,
              _possibleActions = []
            },
          Player
            { _pockets = Nothing,
              _chips = 2072,
              _bet = 0,
              _playerStatus = SatIn NotFolded,
              _playerName = "player2",
              _committed = 250,
              _actedThisTurn = False,
              _possibleActions = []
            }
        ]
    }

spec = do
  describe "Player Acting in Turn Validation" $ do
    let game =
          (currentPosToAct ?~ 0)
            . (street .~ PreFlop)
            . (players .~ playerFixtures)
            $ initialGameState'
    it
      "returns Just OutOfTurn Error if given player is not in current position to act"
      $ do
        let playerName = "player3"
        let expectedErr =
              Left $
                InvalidMove playerName $ OutOfTurn $ CurrentPlayerToActErr "player1"
        isPlayerActingOutOfTurn game playerName `shouldBe` expectedErr

    it
      "returns return Right () when player is acting in turn during heads up game"
      $ do
        let game =
              (street .~ PreFlop)
                . (dealer .~ 0)
                . (currentPosToAct ?~ 1)
                . ( players
                      .~ [ ( (playerStatus .~ SatIn NotFolded)
                               . (actedThisTurn .~ False)
                               . (bet .~ 25)
                               . (committed .~ 25)
                           )
                             player1,
                           ( (playerStatus .~ SatIn NotFolded)
                               . (actedThisTurn .~ False)
                               . (bet .~ 50)
                               . (committed .~ 50)
                           )
                             player2
                         ]
                  )
                $ initialGameState'
        let playerName2 = "player2"
        isPlayerActingOutOfTurn game playerName2 `shouldBe` Right ()
        let game2 =
              (street .~ PreFlop)
                . (dealer .~ 1)
                . (currentPosToAct ?~ 0)
                . ( players
                      .~ [ ( (playerStatus .~ SatIn NotFolded)
                               . (actedThisTurn .~ False)
                               . (bet .~ 50)
                               . (committed .~ 50)
                           )
                             player1,
                           ( (playerStatus .~ SatIn NotFolded)
                               . (actedThisTurn .~ True)
                               . (bet .~ 50)
                               . (committed .~ 50)
                           )
                             player2
                         ]
                  )
                $ initialGameState'
        let playerName1 = "player1"
        isPlayerActingOutOfTurn game2 playerName1 `shouldBe` Right ()

    it "return no Error if player is acting in turn" $
      isPlayerActingOutOfTurn game "player1" `shouldBe` Right ()

    it "return no error for player acting in turn calling an all in during 2 plyr game" $
      isPlayerActingOutOfTurn callAllInHeadsUpFixture "player0" `shouldBe` Right ()

    it
      "returns Just NotAtTable Error if no player with playerName is sat at table"
      $ do
        let expectedErr = Left $ NotAtTable "MissingPlayer"
        checkPlayerSatAtTable game "MissingPlayer" `shouldBe` expectedErr

  describe "canBet" $ do
    it
      "should return NotEnoughChipsForAction InvalidMoveErr if raise value is greater than remaining chips"
      $ do
        let game2 =
              (players .~ playerFixtures2) . (street .~ Flop) $ initialGameState'
            playerName = "player3"
            amount = 10000
            expectedErr = Left $ InvalidMove playerName $ NotEnoughChipsForAction
        canBet playerName amount game2 `shouldBe` expectedErr

    it
      "should return CannotBetShouldRaiseInstead InvalidMoveErr if players have already bet or raised already"
      $ do
        let game2 =
              (players .~ playerFixtures) . (street .~ Flop) . (maxBet .~ 100) $
                initialGameState'
        let playerName = "player3"
        let amount = 50
        let errMsg =
              "A bet can only be carried out if no preceding player has bet"
        let expectedErr =
              Left $ InvalidMove playerName $ CannotBetShouldRaiseInstead errMsg
        canBet playerName amount game2 `shouldBe` expectedErr

    it
      "should return BetLessThanBigBlind InvalidMoveErr if bet is less than the current big blind"
      $ do
        let game2 =
              (players .~ playerFixtures2) . (street .~ Flop) $ initialGameState'
        let playerName = "player3"
        let amount = 2
        let expectedErr = Left $ InvalidMove playerName $ BetLessThanBigBlind
        canBet playerName amount game2 `shouldBe` expectedErr

    it "should not return an error if player can bet" $ do
      let game2 =
            (players .~ playerFixtures2) . (maxBet .~ 0) . (street .~ Flop) $
              initialGameState'
      let playerName = "player3"
      let amount = 100
      canBet playerName amount game2 `shouldBe` Right ()

    it
      "should return InvalidActionForStreet InvalidMoveErr if game stage is PreDeal"
      $ do
        let preDealGame =
              (street .~ PreDeal) . (players .~ playerFixtures2) $
                initialGameState'
        let playerName = "player3"
        let amount = 100
        let expectedErr = Left $ InvalidMove playerName $ InvalidActionForStreet
        canBet playerName amount preDealGame `shouldBe` expectedErr

    it
      "should return InvalidActionForStreet InvalidMoveErr if game stage is Showdown"
      $ do
        let showdownGame =
              (street .~ Showdown) . (players .~ playerFixtures2) $
                initialGameState'
        let playerName = "player3"
        let amount = 100
        let expectedErr = Left $ InvalidMove playerName $ InvalidActionForStreet
        canBet playerName amount showdownGame `shouldBe` expectedErr

  describe "canRaise" $ do
    it
      "should return InvalidActionForStreet InvalidMoveErr if game stage is PreDeal"
      $ do
        let preDealGame =
              (street .~ PreDeal) . (players .~ playerFixtures2) $
                initialGameState'
        let playerName = "player3"
        let amount = 100
        let expectedErr = Left $ InvalidMove playerName $ InvalidActionForStreet
        canBet playerName amount preDealGame `shouldBe` expectedErr

    it "should return InvalidActionForStreet if game stage is PreDeal" $ do
      let game =
            (street .~ PreDeal) . (players .~ playerFixtures) $
              initialGameState'
      let playerName = "player3"
      let amount = 50
      let minRaise = 400
      let expectedErr = Left $ InvalidMove playerName $ InvalidActionForStreet
      canRaise playerName amount game `shouldBe` expectedErr

    it
      "should be able to raise all in when chip count is less than minimum raise amount"
      $ do
        let game =
              (street .~ PreFlop) . (players .~ playerFixtures) . (maxBet .~ 200) $
                initialGameState'
        let playerName = "player3"
        let amount = 300
        canRaise playerName amount game `shouldBe` Right ()

    it
      "should return InvalidActionForStreet InvalidMoveErr if game stage is PreDeal"
      $ do
        let preDealGame =
              (street .~ PreDeal) . (players .~ playerFixtures2) $
                initialGameState'
        let playerName = "player3"
        let amount = 100
        let expectedErr = Left $ InvalidMove playerName $ InvalidActionForStreet
        canRaise playerName amount preDealGame `shouldBe` expectedErr

    it
      "should return InvalidActionForStreet InvalidMoveErr if game stage is Showdown"
      $ do
        let showdownGame =
              (street .~ Showdown) . (players .~ playerFixtures2) $
                initialGameState'
        let playerName = "player3"
        let amount = 100
        let expectedErr = Left $ InvalidMove playerName $ InvalidActionForStreet
        canRaise playerName amount showdownGame `shouldBe` expectedErr

  describe "canCheck" $ do
    it
      "should return CannotCheckShouldCallRaiseOrFold InvalidMoveErr if maxBet is greater than zero and player bet is not equal to maxBet"
      $ do
        let game =
              (street .~ PreFlop) . (players .~ playerFixtures) . (maxBet .~ 200) $
                initialGameState'
        let playerName = "player3"
        let expectedErr =
              Left $ InvalidMove playerName $ CannotCheckShouldCallRaiseOrFold
        canCheck playerName game `shouldBe` expectedErr

    it
      "should allow BigBlind Blind player to check during PreFlop when no bets or raises have occurred"
      $ do
        let game =
              (street .~ PreFlop)
                . ( players
                      .~ [ ( (playerStatus .~ SatIn NotFolded)
                               . (actedThisTurn .~ True)
                               . (bet .~ 50)
                               . (committed .~ 50)
                           )
                             player1,
                           ( (playerStatus .~ SatIn NotFolded)
                               . (actedThisTurn .~ False)
                               . (bet .~ 50)
                               . (committed .~ 50)
                           )
                             player2
                         ]
                  )
                $ initialGameState'
        let playerName = "player2"
        canCheck playerName game `shouldBe` Right ()

    it
      "should return InvalidActionForStreet InvalidMoveErr if game stage is PreDeal"
      $ do
        let preDealGame =
              (street .~ PreDeal) . (players .~ playerFixtures2) $
                initialGameState'
        let playerName = "player3"
        let amount = 100
        let expectedErr = Left $ InvalidMove playerName $ InvalidActionForStreet
        canCheck playerName preDealGame `shouldBe` expectedErr

    it
      "should return InvalidActionForStreet InvalidMoveErr if game stage is Showdown"
      $ do
        let showdownGame =
              (street .~ Showdown) . (players .~ playerFixtures2) $
                initialGameState'
        let playerName = "player3"
        let amount = 100
        let expectedErr = Left $ InvalidMove playerName $ InvalidActionForStreet
        canCheck playerName showdownGame `shouldBe` expectedErr

    it "should be able to check when have chips and in position during 3 player game" $ do
      let playerName = "player0"
      validateAction turnGameThreePlyrs playerName Check `shouldBe` Right ()

  describe "canCall" $ do
    it
      "should return InvalidActionForStreet InvalidMoveErr if game stage is PreDeal"
      $ do
        let preDealGame =
              (street .~ PreDeal) . (players .~ playerFixtures2) $
                initialGameState'
        let playerName = "player3"
        let amount = 100
        let expectedErr = Left $ InvalidMove playerName $ InvalidActionForStreet
        canCall playerName preDealGame `shouldBe` expectedErr

    it
      "should return InvalidActionForStreet InvalidMoveErr if game stage is Showdown"
      $ do
        let showdownGame =
              (street .~ Showdown) . (players .~ playerFixtures2) $
                initialGameState'
        let playerName = "player3"
        let amount = 100
        let expectedErr = Left $ InvalidMove playerName $ InvalidActionForStreet
        canCall playerName showdownGame `shouldBe` expectedErr

    it
      "should return CannotCallZeroAmountCheckOrBetInstead InvalidMoveErr if game stage is not Preflop"
      $ do
        let game =
              (street .~ Flop) . (maxBet .~ 0) . (players .~ playerFixtures2) $
                initialGameState'
        let playerName = "player5"
        let expectedErr =
              Left $
                InvalidMove playerName $ CannotCallZeroAmountCheckOrBetInstead
        canCall playerName game `shouldBe` expectedErr

    it "should not return error if call bigBlind during Preflop" $ do
      let game =
            (street .~ PreFlop) . (players .~ playerFixtures2) $
              initialGameState'
      let playerName = "player5"
      canCall playerName game `shouldBe` Left (InvalidMove "player5" CannotCallZeroAmountCheckOrBetInstead)

  describe "canFold" $ do
    it
      "should return InvalidActionForStreet InvalidMoveErr if game stage is PreDeal"
      $ do
        let preDealGame =
              (street .~ PreDeal) . (players .~ playerFixtures2) $
                initialGameState'
        let playerName = "player3"
        let expectedErr = Left $ InvalidMove playerName $ InvalidActionForStreet
        canFold playerName preDealGame `shouldBe` expectedErr

    it
      "should return InvalidActionForStreet InvalidMoveErr if game stage is Showdown"
      $ do
        let showdownGame =
              (street .~ Showdown) . (players .~ playerFixtures2) $
                initialGameState'
        let playerName = "player3"
        let expectedErr = Left $ InvalidMove playerName $ InvalidActionForStreet
        canFold playerName showdownGame `shouldBe` expectedErr

  describe "canShowOrMuckHand" $ do
    it "should return InvalidMoveErr if game stage is not Showdown" $ do
      let preDealGame =
            (street .~ PreDeal) . (players .~ playerFixtures2) $
              initialGameState'
      let playerName = "player3"
      let expectedErr = Left $ InvalidMove playerName $ InvalidActionForStreet
      canShowOrMuckHand playerName preDealGame `shouldBe` expectedErr

    it "should return InvalidMoveErr if hand is not a singlePlayer showdown" $ do
      let showdownGame =
            (street .~ Showdown)
              . (pot .~ 1000)
              . (deck .~ initialDeck)
              . ( winners
                    .~ MultiPlayerShowdown [((Pair, PlayerShowdownHand []), "player4")]
                )
              . ( players
                    .~ [ ((playerStatus .~ SatIn NotFolded) . (actedThisTurn .~ True)) player4,
                         ((playerStatus .~ SatIn NotFolded) . (actedThisTurn .~ True)) player5
                       ]
                )
              $ initialGameState'
      let playerName = "player5"
      let expectedErr =
            Left $
              InvalidMove playerName $
                CannotShowHandOrMuckHand
                  "Can only show or muck cards if winner of single player pot during showdown"
      canShowOrMuckHand playerName showdownGame `shouldBe` expectedErr

    it
      "should return InvalidMoveErr if action was not sent by winner of single player showdown"
      $ do
        let showdownGame =
              (street .~ Showdown)
                . (pot .~ 1000)
                . (deck .~ initialDeck)
                . (winners .~ SinglePlayerShowdown "player4")
                . ( players
                      .~ [ ((playerStatus .~ SatIn NotFolded) . (actedThisTurn .~ True)) player4,
                           ((playerStatus .~ SatIn Folded) . (actedThisTurn .~ True)) player5
                         ]
                  )
                $ initialGameState'
        let playerName = "player5"
        let expectedErr =
              Left $
                InvalidMove playerName $
                  CannotShowHandOrMuckHand "Not winner of hand"
        canShowOrMuckHand playerName showdownGame `shouldBe` expectedErr

    it
      "should return no InvalidMoveErr if action was sent by winner of single player showdown"
      $ do
        let showdownGame =
              (street .~ Showdown)
                . (pot .~ 1000)
                . (deck .~ initialDeck)
                . (winners .~ SinglePlayerShowdown "player4")
                . ( players
                      .~ [ ((playerStatus .~ SatIn NotFolded) . (actedThisTurn .~ True)) player4,
                           ((playerStatus .~ SatIn Folded) . (actedThisTurn .~ True)) player5
                         ]
                  )
                $ initialGameState'
        let playerName = "player4"
        canShowOrMuckHand playerName showdownGame `shouldBe` Right ()

  describe "canTimeout" $ do
    it
      "should return an error for Timeout if no player can act"
      $ do
        let preFlopGame =
              (street .~ PreFlop) . (players .~ playerFixtures2) $
                initialGameState'
        let playerName = "player3"
        let expectedErr =
              Left $
                InvalidMove "player3" NoPlayerCanAct
        validateAction preFlopGame playerName Timeout `shouldBe` expectedErr

    it "should return no error for Timeout when acting in turn" $ do
      let preFlopGame = initialGameState' & (street .~ PreFlop) . (players .~ playerFixtures2) . (currentPosToAct ?~ 1)
      let playerName = "player5"
      validateAction preFlopGame playerName Timeout `shouldBe` Right ()

    it
      "should return InvalidActionForStreet InvalidMoveErr if Timeout action occurs during Showdown"
      $ do
        let showDownGame = initialGameState' & (street .~ Showdown) . (players .~ playerFixtures2)
        let playerName = "player3"
        let expectedErr = Left $ InvalidMove playerName InvalidActionForStreet
        validateAction showDownGame playerName Timeout `shouldBe` expectedErr

    it "should return err for LeaveSeat if game state is not PreDeal" $ do
      let preFlopGame = initialGameState' & (street .~ PreFlop) . (players .~ playerFixtures2)
      let playerName = "player3"
      let expectedErr = InvalidMove "player3" CannotLeaveSeatOutsidePreDeal
      validateAction preFlopGame playerName LeaveSeat'
        `shouldBe` Left expectedErr

    it "should return err for LeaveSeat if player is not sat at Table" $ do
      let preDealGame = initialGameState' & (street .~ PreDeal) . (players .~ playerFixtures2)
      let playerName = "playerX"
      let expectedErr = NotAtTable playerName
      validateAction preDealGame playerName LeaveSeat'
        `shouldBe` Left expectedErr

    it
      "should return no err for leave seat if player is sat at table during PreDeal"
      $ do
        let preDealGame = initialGameState' & (street .~ PreDeal) . (players .~ playerFixtures2)
        let playerName = "player3"
        validateAction preDealGame playerName LeaveSeat' `shouldBe` Right ()

  describe "canSitOut" $ do
    it
      "should allow player to sit out of the game during the PreDeal street if sat in"
      $ do
        let preDealGame =
              (street .~ PreDeal)
                . ( players
                      .~ [ ( (playerStatus .~ SatIn NotFolded)
                               . (actedThisTurn .~ False)
                               . (bet .~ 0)
                               . (committed .~ 0)
                           )
                             player1,
                           ( (playerStatus .~ SatIn NotFolded)
                               . (actedThisTurn .~ False)
                               . (bet .~ 0)
                               . (committed .~ 0)
                           )
                             player2
                         ]
                  )
                $ initialGameState'
        let playerName = "player1"
        validateAction preDealGame playerName SitOut `shouldBe` Right ()

    it "should return error if player is not at table" $ do
      let preDealGame =
            (street .~ PreFlop)
              . ( players
                    .~ [ ( (playerStatus .~ SatIn NotFolded)
                             . (actedThisTurn .~ True)
                             . (bet .~ 50)
                             . (committed .~ 50)
                         )
                           player1,
                         ( (playerStatus .~ SatIn NotFolded)
                             . (actedThisTurn .~ False)
                             . (bet .~ 50)
                             . (committed .~ 50)
                         )
                           player2
                       ]
                )
              $ initialGameState'
      let playerName = "player3"
      let expectedErr = Left $ NotAtTable playerName
      validateAction preDealGame playerName SitOut `shouldBe` expectedErr

    it "should not allow player to sit out of the game if already sat out" $ do
      let preDealGame =
            (street .~ PreDeal)
              . ( players
                    .~ [ ( (playerStatus .~ SatOut)
                             . (actedThisTurn .~ False)
                             . (bet .~ 0)
                             . (committed .~ 0)
                         )
                           player1,
                         ( (playerStatus .~ SatIn NotFolded)
                             . (actedThisTurn .~ False)
                             . (bet .~ 0)
                             . (committed .~ 0)
                         )
                           player2
                       ]
                )
              $ initialGameState'
      let playerName = "player1"
      let expectedErr = Left $ InvalidMove playerName AlreadySatOut
      validateAction preDealGame playerName SitOut `shouldBe` expectedErr

    it "should not allow player to sit out unless street is PreDeal" $ do
      let preDealGame =
            (street .~ PreFlop)
              . ( players
                    .~ [ ( (playerStatus .~ SatIn NotFolded)
                             . (actedThisTurn .~ True)
                             . (bet .~ 50)
                             . (committed .~ 50)
                         )
                           player1,
                         ( (playerStatus .~ SatIn NotFolded)
                             . (actedThisTurn .~ False)
                             . (bet .~ 50)
                             . (committed .~ 50)
                         )
                           player2
                       ]
                )
              $ initialGameState'
      let playerName = "player2"
      let expectedErr = Left $ InvalidMove playerName CannotSitOutOutsidePreDeal
      validateAction preDealGame playerName SitOut `shouldBe` expectedErr

  describe "validateBlindAction" $
    describe "Heads Up Game" $ do
      let game' =
            (street .~ PreDeal)
              . (maxBet .~ 0)
              . (pot .~ 0)
              . (deck .~ initialDeck)
              . (currentPosToAct ?~ 1)
              . (dealer .~ 0)
              . ( players
                    .~ [ ( (actedThisTurn .~ False)
                             . (playerStatus .~ SatIn NotFolded)
                             . (bet .~ 0)
                             . (chips .~ 2000)
                             . (committed .~ 0)
                         )
                           player1,
                         ( (actedThisTurn .~ False)
                             . (playerStatus .~ SatIn NotFolded)
                             . (bet .~ 0)
                             . (committed .~ 0)
                             . (chips .~ 2000)
                         )
                           player2
                       ]
                )
              $ initialGameState'

      it "Player1 should require small blind" $
        validateBlindAction game' (_playerName player1) SmallBlind
          `shouldBe` Right ()

      it "Player2 should require bigBlind" $
        validateBlindAction game' (_playerName player2) BigBlind `shouldBe` Right ()

  describe "canPostBlind" $
    describe "Heads Up Game" $ do
      let game' =
            (street .~ PreDeal)
              . (maxBet .~ 0)
              . (pot .~ 0)
              . (deck .~ initialDeck)
              . (currentPosToAct ?~ 1)
              . (dealer .~ 0)
              . ( players
                    .~ [ ( (actedThisTurn .~ False)
                             . (playerStatus .~ SatIn NotFolded)
                             . (bet .~ 0)
                             . (chips .~ 2000)
                             . (committed .~ 0)
                         )
                           player1,
                         ( (actedThisTurn .~ False)
                             . (playerStatus .~ SatIn NotFolded)
                             . (bet .~ 0)
                             . (committed .~ 0)
                             . (chips .~ 2000)
                         )
                           player2
                       ]
                )
              $ initialGameState'
      it "Player1 should be able to post small blind" $
        canPostBlind game' (_playerName player1) SmallBlind `shouldBe` Right ()

  describe "validateAction" $ do
    describe "postBlinds" $ do
      it "Player0 should be able to post small blind" $ do
        let action' = PostBlind SmallBlind
        let pName = "player0"
        validateAction preDealHeadsUpFixture pName action' `shouldBe` Right ()

      it "Player0 should not be able post big blind" $ do
        let action' = PostBlind BigBlind
        let pName = "player0"
        isLeft (validateAction preDealHeadsUpFixture pName action') `shouldBe` True

      it "Player1 should not be able post big blind when already posted big blind" $ do
        let action' = PostBlind BigBlind
        let pName = "player1"
        isLeft (validateAction preDealHeadsUpFixture pName action') `shouldBe` True

      it "Player1 should not be able post small blind when already posted big blind" $ do
        let action' = PostBlind SmallBlind
        let pName = "player1"
        isLeft (validateAction preDealHeadsUpFixture pName action') `shouldBe` True

      it "Players can't post a blind when they have no chips" $
        hedgehog $ do
          g <- forAll $ genGame [PreDeal] allPStates
          blind' <- forAll $ Gen.element [SmallBlind, BigBlind]
          let g' = g & players . element 0 %~ chips .~ 0
              action' = PostBlind blind'
              pName = "player0"
          isLeft (validateAction g' pName action') === True

    --    it "Players shouldn't be able to post blinds outside PreDeal" $
    --      hedgehog $ do
    --        g <- forAll $ genGame [PreFlop] [SatIn NotFolded, SatOut]
    --        blind' <- forAll $ Gen.element [SmallBlind, BigBlind]
    --        let action' = PostBlind blind'
    --            pName = "player1"
    --        isLeft (validateAction g pName action') === True

    describe "fold" $
      it "should always be able to fold when in turn" $
        hedgehog $ do
          g <- forAll $ genGame [PreFlop, Flop, Turn, River] [SatIn NotFolded]
          let action' = Fold
              pName = "player0"
              inTurn = isRight $ isPlayerActingOutOfTurn g pName
              allIn = (== 0) $ _chips $ head $ _players g
              canFold = isRight $ validateAction g pName action'
          canFold === (inTurn && not allIn)

================================================
FILE: server/test/Poker/BlindSpec.hs
================================================
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Poker.BlindSpec where

import Control.Lens ((.~))
import Data.Text (Text)
import qualified Data.Text as T
import Hedgehog
  ( Property,
    assert,
    forAll,
    property,
    withDiscards,
  )
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Poker.Game.Blinds
  ( blindRequiredByPlayer,
    getRequiredBlinds,
    getSmallBlindPosition,
    haveRequiredBlindsBeenPosted,
    updatePlayersInHand,
  )
import Poker.Game.Utils (getGamePlayerNames, initialDeck)
import Poker.Generators (allPStates, genGame)
import Poker.Poker (initPlayer, initialGameState)
import Poker.Types
  ( Blind (BigBlind, NoBlind, SmallBlind),
    Deck (Deck),
    Game (..),
    Player (..),
    PlayerState (..),
    SatInState (..),
    Street (PreDeal),
    Winners (NoWinners),
    playerStatus,
    players,
  )
import Test.Hspec (describe, it, shouldBe)
import Test.Hspec.Hedgehog
  ( PropertyT,
    diff,
    forAll,
    hedgehog,
    modifyMaxDiscardRatio,
    (/==),
    (===),
  )

initialGameState' :: Game
initialGameState' = initialGameState initialDeck

twoPlayerGame :: Game
twoPlayerGame =
  Game
    { _players =
        [ Player
            { _pockets = Nothing,
              _chips = 1950,
              _bet = 50,
              _playerStatus = SatIn NotFolded,
              _playerName = "player1",
              _committed = 50,
              _actedThisTurn = False,
              _possibleActions = []
            },
          Player
            { _pockets = Nothing,
              _chips = 2000,
              _bet = 0,
              _playerStatus = SatOut,
              _playerName = "player2",
              _committed = 0,
              _actedThisTurn = False,
              _possibleActions = []
            }
        ],
      _maxPlayers = 5,
      _board = [],
      _waitlist = [],
      _deck = Deck [],
      _smallBlind = 25,
      _bigBlind = 50,
      _street = PreDeal,
      _pot = 0,
      _minBuyInChips = 1000,
      _maxBuyInChips = 3000,
      _maxBet = 0,
      _dealer = 0,
      _currentPosToAct = Just 1,
      _winners = NoWinners
    }

twoPlayerGameAllBlindsPosted :: Game
twoPlayerGameAllBlindsPosted =
  Game
    { _players =
        [ Player
            { _pockets = Nothing,
              _chips = 1950,
              _bet = 25,
              _playerStatus = SatIn NotFolded,
              _playerName = "player1",
              _committed = 25,
              _actedThisTurn = True,
              _possibleActions = []
            },
          Player
            { _pockets = Nothing,
              _chips = 2000,
              _bet = 50,
              _playerStatus = SatIn NotFolded,
              _playerName = "player2",
              _committed = 50,
              _actedThisTurn = True,
              _possibleActions = []
            }
        ],
      _maxPlayers = 5,
      _board = [],
      _waitlist = [],
      _deck = Deck [],
      _smallBlind = 25,
      _bigBlind = 50,
      _street = PreDeal,
      _pot = 0,
      _winners = NoWinners,
      _maxBet = 0,
      _dealer = 0,
      _minBuyInChips = 1000,
      _maxBuyInChips = 3000,
      _currentPosToAct = Just 1
    }

threePlayerGame :: Game
threePlayerGame =
  Game
    { _players =
        [ Player
            { _pockets = Nothing,
              _chips = 1950,
              _bet = 0,
              _playerStatus = SatOut,
              _playerName = "player1",
              _committed = 0,
              _actedThisTurn = False,
              _possibleActions = []
            },
          Player
            { _pockets = Nothing,
              _chips = 2000,
              _bet = 0,
              _playerStatus = SatOut,
              _playerName = "player2",
              _committed = 0,
              _actedThisTurn = False,
              _possibleActions = []
            },
          Player
            { _pockets = Nothing,
              _chips = 2000,
              _bet = 0,
              _playerStatus = SatOut,
              _playerName = "player3",
              _committed = 0,
              _actedThisTurn = False,
              _possibleActions = []
            }
        ],
      _maxPlayers = 5,
      _board = [],
      _waitlist = [],
      _deck = Deck [],
      _smallBlind = 25,
      _bigBlind = 50,
      _street = PreDeal,
      _pot = 0,
      _winners = NoWinners,
      _maxBet = 0,
      _dealer = 0,
      _minBuyInChips = 1000,
      _maxBuyInChips = 3000,
      _currentPosToAct = Just 1
    }

threePlayerGameAllBlindsPosted :: Game
threePlayerGameAllBlindsPosted =
  Game
    { _players =
        [ Player
            { _pockets = Nothing,
              _chips = 1950,
              _bet = 0,
              _playerStatus = SatOut,
              _playerName = "player1",
              _committed = 0,
              _actedThisTurn = False,
              _possibleActions = []
            },
          Player
            { _pockets = Nothing,
              _chips = 2000,
              _bet = 25,
              _playerStatus = SatIn NotFolded,
              _playerName = "player2",
              _committed = 25,
              _actedThisTurn = False,
              _possibleActions = []
            },
          Player
            { _pockets = Nothing,
              _chips = 2000,
              _bet = 50,
              _playerStatus = SatIn NotFolded,
              _playerName = "player3",
              _committed = 50,
              _actedThisTurn = False,
              _possibleActions = []
            }
        ],
      _maxPlayers = 5,
      _board = [],
      _waitlist = [],
      _deck = Deck [],
      _smallBlind = 25,
      _bigBlind = 50,
      _street = PreDeal,
      _pot = 0,
      _minBuyInChips = 1000,
      _maxBuyInChips = 3000,
      _winners = NoWinners,
      _maxBet = 0,
      _dealer = 0,
      _currentPosToAct = Just 1
    }

twoPlayerNames :: [Text]
twoPlayerNames = getGamePlayerNames twoPlayerGame

twoPlayers :: [Player]
twoPlayers = _players twoPlayerGame

threePlayerNames :: [Text]
threePlayerNames = getGamePlayerNames threePlayerGame

threePlayers :: [Player]
threePlayers = _players threePlayerGame

prop_requiredBlinds_always_valid_arrangement_for_2_plyrs :: Property
prop_requiredBlinds_always_valid_arrangement_for_2_plyrs = withDiscards 225 . property $ do
  g <- forAll $ Gen.filter twoPlayers (genGame [PreDeal] allPStates)
  let legalBlindArrangements = [[SmallBlind, BigBlind], [SmallBlindind, SmallBlind]]
      requiredBlinds = getRequiredBlinds g
  assert (requiredBlinds `elem` legalBlindArrangements)
  where
    twoPlayers = (== 2) . length . _players

prop_requiredBlinds_always_valid_arrangement_for_3_plyrs :: Property
prop_requiredBlinds_always_valid_arrangement_for_3_plyrs = withDiscards 225 . property $ do
  g <- forAll $ Gen.filter threePlayer (genGame [PreDeal] allPStates)
  let legalBlindArrangements = [[SmallBlind, BigBlind, NoBlind], [BigBlind,SmallBlindind, SmallBlind], SmallBlindind, SmallBlind, BigBlind]]
      requiredBlinds = getRequiredBlinds g
  assert (requiredBlinds `elem` legalBlindArrangements)
  where
    threePlayer = (== 3) . length . _players

spec = do
  describe "blind required by player" $
    it "should return correct blind" $
      blindRequiredByPlayer twoPlayerGame "player2" `shouldBe` BigBlind

  describe "getSmallBlindPosition" $ do
    it "small blind position should be correct for a two player game" $ do
      let dealerPos = 0
      getSmallBlindPosition twoPlayerNames dealerPos `shouldBe` (0 :: Int)

    it "small blind position should be correct for a three player game" $ do
      let dealerPos = 2
      getSmallBlindPosition threePlayerNames dealerPos `shouldBe` (0 :: Int)

  describe "getRequiredBlinds" $ do
    it "Should return valid required blinds for two player game" $
      hedgehog $ do
        let isTwoPlayers = (== 2) . length . _players
        g <- forAll $ Gen.filter isTwoPlayers (genGame [PreDeal] allPStates)
        let legalBlindArrangements = [[SmallBlind, BigBlind], [SmallBlindind, SmallBlind]]
            requiredBlinds = getRequiredBlinds g
        --
        (requiredBlinds `elem` legalBlindArrangements) === True

    it "Should return valid required blinds for three player game" $
      hedgehog $ do
        let isThreePlayers = (== 3) . length . _players
        g <- forAll $ Gen.filter isThreePlayers (genGame [PreDeal] allPStates)
        let legalBlindArrangements = [[SmallBlind, BigBlind, NoBlind], [BigBlind,SmallBlindind, SmallBlind], SmallBlindind, SmallBlind, BigBlind]]
            requiredBlinds = getRequiredBlinds g
        (requiredBlinds `elem` legalBlindArrangements) === True

  describe "blinds" $ do
    describe "getSmallBlindPosition" $ do
      it "returns correct small blind position in three player game" $ do
        let dealerPos = 0
        getSmallBlindPosition ["Player1", "Player2", "Player3"] dealerPos
          `shouldBe` 1

      it "returns correct small blind position in two player game" $ do
        let dealerPos = 0
        getSmallBlindPosition ["Player1", "Player2"] dealerPos `shouldBe` 0

    describe "blindRequiredByPlayer" $ do
      it "returns SmallBlind if player position is dealer + 1 for three players" $ do
        let testPlayers =
              (playerStatus .~ SatIn NotFolded)
                <$> (initPlayer <$> ["Player1", "Player2", "Player3"] <*> [100])
        let game = players .~ testPlayers $ initialGameState'
        blindRequiredByPlayer game "Player2" `shouldBe` SmallBlind

      it "returns BigBlind if player position is dealer + 2 for three players" $ do
        let testPlayers =
              (playerStatus .~ SatIn NotFolded)
                <$> (initPlayer <$> ["Player1", "Player2", "Player3"] <*> [100])
        let game = players .~ testPlayers $ initialGameState'
        blindRequiredByPlayer game "Player3" `shouldBe` BigBlind

      it
        "returns NoBlind if player position is dealer for three players and playerStatus is SatIn NotFolded"
        $ do
          let testPlayers =
                (playerStatus .~ SatIn NotFolded)
                  <$> (initPlayer <$> ["Player1", "Player2", "Player3"] <*> [100])
          let game = players .~ testPlayers $ initialGameState'
          blindRequiredByPlayer game "Player1" `shouldBe` NoBlind

      it
        "returns BigBlind if player position is dealer for three players and playerStatus is SatOut"
        $ do
          let testPlayers =
                (playerStatus .~ SatOut)
                  <$> (initPlayer <$> ["Player1", "Player2", "Player3"] <*> [100])
          let game = players .~ testPlayers $ initialGameState'
          blindRequiredByPlayer game "Player1" `shouldBe` NoBlind

      it "returns SmallBlind if player position is dealer for two players" $ do
        let testPlayers =
              (playerStatus .~ SatIn NotFolded)
                <$> (initPlayer <$> ["Player1", "Player2"] <*> [100])
        let game = players .~ testPlayers $ initialGameState'
        blindRequiredByPlayer game "Player1" `shouldBe` SmallBlind

      it "returns BigBlind if player position is dealer + 1 for two players" $ do
        let testPlayers = initPlayer <$> ["Player1", "Player2"] <*> [100]
        let game = players .~ testPlayers $ initialGameState'
        blindRequiredByPlayer game "Player2" `shouldBe` BigBlind

  describe "haveRequiredBlindsBeenPosted" $ do
    it
      "should return False when not all players have posted blinds in 2 player game"
      $ haveRequiredBlindsBeenPosted twoPlayerGame `shouldBe` False

    it "should return True when all players have posted blinds in 2 player game" $
      haveRequiredBlindsBeenPosted twoPlayerGameAllBlindsPosted `shouldBe` True

    it
      "should return False when not all players have posted blinds in 3 player game"
      $ haveRequiredBlindsBeenPosted threePlayerGame `shouldBe` False

    it
      "should  return True when all players have posted blinds in 3 player game"
      $ haveRequiredBlindsBeenPosted threePlayerGameAllBlindsPosted
        `shouldBe` True

  describe "updatePlayersInHand" $ do
    it
      "should set players that are not in blind position to SatIn NotFolded for three players"
      $ do
        let newGame = updatePlayersInHand threePlayerGameAllBlindsPosted
        let playerStates = (\Player {..} -> _playerStatus) <$> _players newGame
        playerStates `shouldBe` [SatIn NotFolded, SatIn NotFolded, SatIn NotFolded]

    it
      "should return correct player states for two players when all blinds posted"
      $ do
        let newGame = updatePlayersInHand twoPlayerGameAllBlindsPosted
        let playerStates = (\Player {..} -> _playerStatus) <$> _players newGame
        playerStates `shouldBe` [SatIn NotFolded, SatIn NotFolded]

    it
      "should return correct player states for two players when not all blinds posted"
      $ do
        let newGame = updatePlayersInHand twoPlayerGame
        let playerStates = (\Player {..} -> _playerStatus) <$> _players newGame
        playerStates `shouldBe` [SatIn NotFolded, SatOut]


================================================
FILE: server/test/Poker/GameSpec.hs
================================================
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Poker.GameSpec where

import Control.Lens (element, (%~), (&), (.~), (?~), (^.))
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (fromMaybe, isJust, isNothing)
import Data.Text (Text)
import qualified Data.Text as T
import Hedgehog
  ( Property,
    assert,
    forAll,
    property,
    withDiscards,
    (===),
  )
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Poker.Game.Game
  ( allButOneAllIn,
    allButOneFolded,
    awaitingPlayerAction,
    dealToPlayers,
    doesPlayerHaveToAct,
    everyoneAllIn,
    getHandRankings,
    getNextHand,
    haveAllPlayersActed,
    nextPosToAct,
    progressToFlop,
    progressToPreFlop,
    progressToRiver,
    progressToShowdown,
    progressToTurn,
  )
import Poker.Game.Utils (getActivePlayers, initialDeck)
import Poker.Generators
  ( allPStates,
    allPStreets,
    genGame,
    genPlayer',
    genPlayers,
  )
import Poker.Poker (initialGameState)
import Poker.Types
  ( Card (Card, rank, suit),
    Deck (Deck),
    Game (..),
    Player (..),
    PlayerState (..),
    PocketCards (PocketCards),
    Rank (Four, King, Three),
    SatInState (..),
    Street (Flop, PreDeal, PreFlop, River, Showdown, Turn),
    Suit (Clubs, Diamonds, Hearts, Spades),
    Winners (NoWinners),
    actedThisTurn,
    bet,
    chips,
    committed,
    currentPosToAct,
    dealer,
    deck,
    maxBet,
    playerStatus,
    players,
    pot,
    smallBlind,
    street,
  )
import Test.Hspec (describe, it, shouldBe)
import Test.Hspec.Hedgehog
  ( PropertyT,
    diff,
    forAll,
    hedgehog,
    modifyMaxDiscardRatio,
    (/==),
    (===),
  )

initialGameState' :: Game
initialGameState' = initialGameState initialDeck

player1 :: Player
player1 =
  Player
    { _pockets =
        Just $
          PocketCards
            Card {rank = Three, suit = Diamonds}
            Card {rank = Four, suit = Spades},
      _chips = 2000,
      _bet = 50,
      _playerStatus = SatIn NotFolded,
      _playerName = "player1",
      _committed = 50,
      _actedThisTurn = True,
      _possibleActions = []
    }

player2 :: Player
player2 =
  Player
    { _pockets =
        Just $
          PocketCards
            Card {rank = Three, suit = Clubs}
            Card {rank = Four, suit = Hearts},
      _chips = 2000,
      _bet = 0,
      _playerStatus = SatIn NotFolded,
      _playerName = "player2",
      _committed = 50,
      _actedThisTurn = False,
      _possibleActions = []
    }

player3 :: Player
player3 =
  Player
    { _pockets = Nothing,
      _chips = 2000,
      _bet = 0,
      _playerStatus = SatIn NotFolded,
      _playerName = "player3",
      _committed = 50,
      _actedThisTurn = False,
      _possibleActions = []
    }

player4 :: Player
player4 =
  Player
    { _pockets = Nothing,
      _chips = 2000,
      _bet = 0,
      _playerStatus = SatOut,
      _playerName = "player4",
      _committed = 0,
      _actedThisTurn = False,
      _possibleActions = []
    }

player5 :: Player
player5 =
  Player
    { _pockets =
        Just $
          PocketCards
            Card {rank = King, suit = Diamonds}
            Card {rank = Four, suit = Spades},
      _chips = 2000,
      _bet = 50,
      _playerStatus = SatIn NotFolded,
      _playerName = "player1",
      _committed = 50,
      _actedThisTurn = True,
      _possibleActions = []
    }

player6 :: Player
player6 =
  Player
    { _pockets = Nothing,
      _chips = 2000,
      _bet = 0,
      _playerStatus = SatOut,
      _playerName = "player6",
      _committed = 0,
      _actedThisTurn = False,
      _possibleActions = []
    }

initPlayers :: [Player]
initPlayers = [player1, player2, player3]

turnGameThreePlyrs :: Game
turnGameThreePlyrs =
  Game
    { _dealer = 2,
      _currentPosToAct = Just 0,
      _smallBlind = 25,
      _bigBlind = 50,
      _minBuyInChips = 1500,
      _maxBuyInChips = 3000,
      _pot = 550,
      _maxBet = 0,
      _street = Turn,
      _winners = NoWinners,
      _board = [],
      _maxPlayers = 6,
      _waitlist = [],
      _deck = Deck [],
      _players =
        [ Player
            { _pockets = Nothing,
              _chips = 2197,
              _bet = 0,
              _playerStatus = SatIn NotFolded,
              _playerName = "player0",
              _committed = 50,
              _actedThisTurn = False,
              _possibleActions = []
            },
          Player
            { _pockets = Nothing,
              _chips = 1847,
              _bet = 0,
              _playerStatus = SatIn NotFolded,
              _playerName = "player1",
              _committed = 250,
              _actedThisTurn = False,
              _possibleActions = []
            },
          Player
            { _pockets = Nothing,
              _chips = 2072,
              _bet = 0,
              _playerStatus = SatIn NotFolded,
              _playerName = "player2",
              _committed = 250,
              _actedThisTurn = False,
              _possibleActions = []
            }
        ]
    }

spec = do
  describe "dealToPlayers" $
    it "should deal correct number of cards" $ do
      let (_, newPlayers) = dealToPlayers initialDeck [player1, player3]
      all
        ( \Player {..} ->
            if _playerStatus == SatIn NotFolded
              then isJust _pockets
              else isNothing _pockets
        )
        newPlayers
        `shouldBe` True

  describe "haveAllPlayersActed" $ do
    it
      "should return True when all players have acted during PreDeal for Three Players"
      $ do
        let game =
              (street .~ PreDeal) . (maxBet .~ 0)
                . ( players
                      .~ [ ( (playerStatus .~ SatIn NotFolded) . (actedThisTurn .~ False) . (bet .~ 0)
                               . (committed .~ 0)
                           )
                             player1,
                           ( (playerStatus .~ SatIn NotFolded) . (actedThisTurn .~ True) . (bet .~ 0)
                               . (committed .~ 25)
                           )
                             player2,
                           ( (playerStatus .~ SatIn NotFolded) . (actedThisTurn .~ True) . (bet .~ 0)
                               . (committed .~ 50)
                           )
                             player6
                         ]
                  )
                $ initialGameState'
        haveAllPlayersActed game `shouldBe` True

    it
      "should return False when not all players acted during PreDeal for Three Players"
      $ do
        let unfinishedBlindsGame =
              (street .~ PreDeal) . (players .~ [player1, player4, player6]) $
                initialGameState'
        haveAllPlayersActed unfinishedBlindsGame `shouldBe` False

    it
      "should return True when all players have acted during preFlop for Two Players"
      $ do
        let game =
              (street .~ PreFlop) . (maxBet .~ 0)
                . ( players
                      .~ [ ((playerStatus .~ SatIn NotFolded) . (actedThisTurn .~ True) . (bet .~ 0))
                             player1,
                           ((playerStatus .~ SatIn NotFolded) . (actedThisTurn .~ True) . (bet .~ 0))
                             player2
                         ]
                  )
                $ initialGameState'
        haveAllPlayersActed game `shouldBe` True

    it
      "should return False when not all players acted during PreFlop for Two Players"
      $ do
        let unfinishedBlindsGame =
              (street .~ PreDeal) . (players .~ [player1, player4]) $
                initialGameState'
        haveAllPlayersActed unfinishedBlindsGame `shouldBe` False

  describe "allButOneFolded" $ do
    it "should return True when all but one player " $ do
      let game =
            (street .~ PreFlop)
              . (players .~ [(playerStatus .~ SatIn Folded) player1, player2])
              $ initialGameState'
      allButOneFolded game `shouldBe` True

    it "should return False when not all players acted" $ do
      let unfinishedBlindsGame =
            (street .~ PreFlop) . (players .~ [player1, player3]) $
              initialGameState'
      allButOneFolded unfinishedBlindsGame `shouldBe` False

    it "should always return False for PreDeal (blinds) stage" $ do
      let unfinishedBlindsGame =
            (street .~ PreDeal)
              . (players .~ [(playerStatus .~ SatIn Folded) player1, player2])
              $ initialGameState'
      allButOneFolded unfinishedBlindsGame `shouldBe` False

  describe "progressToPreFlop" $ do
    let preDealGame =
          (street .~ PreDeal) . (maxBet .~ 50) . (pot .~ 75)
            . (deck .~ initialDeck)
            . ( players
                  .~ [ ((chips .~ 1000) . (committed .~ 25) . (bet .~ 25)) player5,
                       ((chips .~ 1000) . (committed .~ 50) . (bet .~ 50)) player2
                     ]
              )
            $ initialGameState'

    let preFlopGame = progressToPreFlop preDealGame

    it "should update street to PreFlop" $ preFlopGame ^. street `shouldBe` PreFlop

    it "should not reset any player bet" $ do
      let playerBets = (^. bet) <$> _players preFlopGame
      playerBets `shouldBe` [25, 50]

    it "Dealer position acts first during Preflop game stage when Heads Up (2 plyrs)" $ do
      let game =
            (street .~ PreDeal) . (currentPosToAct ?~ 0)
              . (players .~ [player1, player1])
              . (dealer .~ 0)
              $ initialGameState'
      _currentPosToAct preFlopGame `shouldBe` Just (_dealer game)

  describe "progressToFlop" $ do
    let preFlopGame =
          (street .~ Flop) . (maxBet .~ 1000) . (pot .~ 1000)
            . (deck .~ initialDeck)
            . (players .~ [(chips .~ 1000) player5, (chips .~ 1000) player2])
            $ initialGameState'
    let flopGame = progressToFlop preFlopGame

    it "should update street to Turn" $ flopGame ^. street `shouldBe` Flop

    it "should reset maxBet" $ flopGame ^. maxBet `shouldBe` 0

    it "should reset all player bets" $ do
      let playerBets = (^. bet) <$> _players flopGame
      playerBets `shouldBe` [0, 0]

  describe "progressToTurn" $ do
    let flopGame =
          (street .~ Flop) . (maxBet .~ 1000) . (pot .~ 1000)
            . (deck .~ initialDeck)
            . (players .~ [(chips .~ 1000) player5, (chips .~ 1000) player2])
            $ initialGameState'
    let turnGame = progressToTurn flopGame

    it "should update street to Turn" $ turnGame ^. street `shouldBe` Turn

    it "should reset maxBet" $ turnGame ^. maxBet `shouldBe` 0

    it "should reset all player bets" $ do
      let playerBets = (^. bet) <$> _players turnGame
      playerBets `shouldBe` [0, 0]

  describe "progressToRiver" $ do
    let turnGame =
          (street .~ Turn) . (maxBet .~ 1000) . (pot .~ 1000)
            . (deck .~ initialDeck)
            . (players .~ [(chips .~ 1000) player5, (chips .~ 1000) player2])
            $ initialGameState'
    let riverGame = progressToRiver turnGame

    it "should update street to River" $ riverGame ^. street `shouldBe` River

    it "should reset maxBet" $ riverGame ^. maxBet `shouldBe` 0

    it "should reset all player bets" $ do
      let turnGame =
            (street .~ Turn) . (maxBet .~ 1000) . (pot .~ 1000)
              . (deck .~ initialDeck)
              . (players .~ [(chips .~ 1000) player5, (chips .~ 1000) player2])
              $ initialGameState'
      let riverGame = progressToRiver turnGame
      let playerBets = (^. bet) <$> _players riverGame
      playerBets `shouldBe` [0, 0]

  describe "progressToShowdown" $ do
    let riverGame =
          (street .~ River) . (pot .~ 1000) . (deck .~ initialDeck)
            . (players .~ [(chips .~ 1000) player5, (chips .~ 1000) player2])
            $ initialGameState'
    let showdownGame = progressToShowdown riverGame

    it "should update street to Turn" $ showdownGame ^. street `shouldBe` Showdown

    it "should award pot chips to winner of hand" $ do
      let playerChipCounts = (^. chips) <$> _players showdownGame
      playerChipCounts `shouldBe` [2000, 1000]

    it "should split pot if more than one player wins given pot" $ do
      let riverGame =
            (street .~ River) . (pot .~ 1000) . (deck .~ initialDeck)
              . (players .~ [(chips .~ 1000) player1, (chips .~ 1000) player2])
              $ initialGameState'
      let showdownGame = progressToShowdown riverGame
      let playerChipCounts =
            (\Player {..} -> _chips) <$> _players showdownGame
      playerChipCounts `shouldBe` [1500, 1500]

  describe "getNextHand" $ do
    let showdownGame =
          (street .~ Showdown) . (maxBet .~ 1000) . (pot .~ 1000)
            . (deck .~ initialDeck)
            . (dealer .~ 1)
            . (players .~ [(chips .~ 1000) player5, (chips .~ 1000) player2])
            $ initialGameState'
    let preDealGame = getNextHand showdownGame $ Deck []

    it "should update street to PreDeal" $
      preDealGame ^. street
        `shouldBe` PreDeal

    it "should reset maxBet" $ preDealGame ^. maxBet `shouldBe` 0

    it "should reset all player bets" $ do
      let playerBets = (\Player {..} -> _bet) <$> _players preDealGame
      playerBets `shouldBe` [0, 0]

    it "should increment dealer position" $ preDealGame ^. dealer `shouldBe` 0

  describe "allButOneAllIn" $ do
    it "should return False for two player game if no one all in" $ do
      let preFlopGame' =
            (street .~ PreFlop) . (pot .~ 1000) . (deck .~ initialDeck)
              . ( players
                    .~ [ ((playerStatus .~ SatIn NotFolded) . (actedThisTurn .~ False)) player1,
                         ((playerStatus .~ SatIn NotFolded) . (actedThisTurn .~ True)) player3
                       ]
                )
              $ initialGameState'
      allButOneAllIn preFlopGame' `shouldBe` False

    it "should return True for two player game if one player is all in and other isn't" $ do
      let preFlopGame' =
            (street .~ PreFlop) . (currentPosToAct ?~ 0) . (pot .~ 10) . (deck .~ initialDeck)
              . ( players
                    .~ [ ((playerStatus .~ SatIn NotFolded) . (chips .~ 0) . (bet .~ 0) . (actedThisTurn .~ False)) player1,
                         ((playerStatus .~ SatIn NotFolded) . (chips .~ 1) . (bet .~ 0) . (actedThisTurn .~ False)) player3
                       ]
                )
              $ initialGameState'
      allButOneAllIn preFlopGame' `shouldBe` True

    it
      "should return True for two player game if a player has called the other player all in"
      $ do
        let preFlopGame =
              (street .~ PreFlop) . (maxBet .~ 1950) . (pot .~ 4000)
                . (deck .~ initialDeck)
                . ( players
                      .~ [ ( (actedThisTurn .~ True) . (playerStatus .~ SatIn NotFolded) . (bet .~ 1950)
                               . (chips .~ 0)
                               . (committed .~ 2000)
                           )
                             player1,
                           ( (playerStatus .~ SatIn NotFolded) . (actedThisTurn .~ True) . (bet .~ 1950)
                               . (committed .~ 2000)
                               . (chips .~ 3000)
                           )
                             player3
                         ]
                  )
                $ initialGameState'
        allButOneAllIn preFlopGame `shouldBe` True

    it
      "should return False for two player game if a player bet all in and the other has folded"
      $ do
        let preFlopGame =
              (street .~ PreFlop) . (maxBet .~ 1950) . (pot .~ 4000)
                . (deck .~ initialDeck)
                . ( players
                      .~ [ ( (actedThisTurn .~ True) . (playerStatus .~ SatIn NotFolded) . (bet .~ 1950)
                               . (chips .~ 0)
                               . (committed .~ 2000)
                           )
                             player1,
                           ( (playerStatus .~ SatIn Folded) . (actedThisTurn .~ True)
                               . (bet .~ 1950)
                               . (committed .~ 2000)
                               . (chips .~ 3000)
                           )
                             player3
                         ]
                  )
                $ initialGameState'
        allButOneAllIn preFlopGame `shouldBe` False

    it
      "should return False for three player game if only one short stacked player all in"
      $ do
        let preFlopGame =
              (street .~ PreFlop) . (maxBet .~ 1950) . (pot .~ 1000)
                . (deck .~ initialDeck)
                . ( players
                      .~ [ ( (actedThisTurn .~ True) . (playerStatus .~ SatIn NotFolded) . (bet .~ 1950)
                               . (chips .~ 0)
                               . (committed .~ 2000)
                           )
                             player1,
                           ( (playerStatus .~ SatIn NotFolded) . (actedThisTurn .~ True) . (bet .~ 1950)
                               . (committed .~ 2000)
                               . (chips .~ 3000)
                           )
                             player3,
                           ( (playerStatus .~ SatIn NotFolded) . (actedThisTurn .~ True) . (bet .~ 1950)
                               . (committed .~ 2000)
                               . (chips .~ 3000)
                           )
                             player3
                         ]
                  )
                $ initialGameState'
        allButOneAllIn preFlopGame `shouldBe` False

    it "should return True for four player game if only one player not all in" $ do
      let flopGame =
            (street .~ Flop) . (maxBet .~ 2000) . (pot .~ 10000)
              . (deck .~ initialDeck)
              . ( players
                    .~ [ ( (actedThisTurn .~ True) . (playerStatus .~ SatIn NotFolded) . (bet .~ 0)
                             . (chips .~ 0)
                             . (committed .~ 2000)
                         )
                           player1,
                         ( (actedThisTurn .~ True) . (playerStatus .~ SatIn NotFolded) . (bet .~ 2000)
                             . (committed .~ 4000)
                             . (chips .~ 0)
                         )
                           player3,
                         ( (playerStatus .~ SatIn NotFolded) . (actedThisTurn .~ True) . (bet .~ 2000)
                             . (committed .~ 4000)
                             . (chips .~ 0)
                         )
                           player3,
                         ( (playerStatus .~ SatIn NotFolded) . (actedThisTurn .~ False) . (bet .~ 0)
                             . (committed .~ 2000)
                             . (chips .~ 800)
                         )
                           player3
                       ]
                )
              $ initialGameState'
      allButOneAllIn flopGame `shouldBe` True

  describe "everyoneAllIn" $
    it "should return True for three player game if everyone is all in" $ do
      let flopGame =
            (street .~ Flop) . (maxBet .~ 2000) . (pot .~ 10000)
              . (deck .~ initialDeck)
              . ( players
                    .~ [ ( (actedThisTurn .~ True) . (playerStatus .~ SatIn NotFolded) . (bet .~ 0)
                             . (chips .~ 0)
                             . (committed .~ 2000)
                         )
                           player1,
                         ( (actedThisTurn .~ True) . (playerStatus .~ SatIn NotFolded) . (bet .~ 2000)
                             . (committed .~ 4000)
                             . (chips .~ 0)
                         )
                           player3,
                         ( (playerStatus .~ SatIn NotFolded) . (actedThisTurn .~ True) . (bet .~ 2000)
                             . (committed .~ 4000)
                             . (chips .~ 0)
                         )
                           player3
                       ]
                )
              $ initialGameState'
      everyoneAllIn flopGame `shouldBe` True

  --describe "getHandRankings" $
  --  it "Number of hand rankings should equal number of active players" $
  --    hedgehog $ do
  --      let requiredActives = 1
  --          Deck deck = initialDeck
  --      plyrCount <- forAll $ Gen.int $ Range.linear 2 9
  --      (ps, cs) <- forAll $ genPlayers Showdown requiredActives allPStates plyrCount deck
  --      length (getHandRankings ps cs) === length (getActivePlayers ps)

  describe "doesPlayerHaveToAct" $ do
    it "should be False when posToAct is not on player" $
      hedgehog $ do
        g <- forAll $ genGame [Flop] [SatIn NotFolded]
        let g' = g & currentPosToAct ?~ 1
        doesPlayerHaveToAct "player0" g' === False

    it "should be False when player has no chips" $
      hedgehog $ do
        g <- forAll $ genGame [Flop] [SatIn NotFolded]
        let g' = g & players . element 0 %~ chips .~ 0
        doesPlayerHaveToAct "player0" g' === False

    it "should be False when not enough players (<2) during predeal to start a game" $
      hedgehog $ do
        g <- forAll (genGame [PreDeal] allPStates)
        (p, _) <- forAll $ genPlayer' PreDeal allPStates 0 []
        let g' = g & players .~ [p]
        doesPlayerHaveToAct "player0" g' === False

    it "should return True for an active player in position" $ do
      let game =
            (street .~ Flop) . (dealer .~ 0) . (currentPosToAct ?~ 1)
              . (players .~ [(chips .~ 1000) player5, (chips .~ 1000) player2])
              $ initialGameState'
      doesPlayerHaveToAct (_playerName player2) game `shouldBe` True
      doesPlayerHaveToAct (_playerName player5) game `shouldBe` False

      doesPlayerHaveToAct "player0" turnGameThreePlyrs `shouldBe` True

    it "should return False for non-active players" $ do
      let game =
            (street .~ Flop) . (dealer .~ 0)
              . ( players
                    .~ [ (chips .~ 1000) player5,
                         (playerStatus .~ SatIn Folded) player4,
                         (playerStatus .~ SatOut) player3,
                         (chips .~ 1000) player2
                       ]
                )
              $ initialGameState'
      doesPlayerHaveToAct (_playerName player3) game `shouldBe` False
      doesPlayerHaveToAct (_playerName player4) game `shouldBe` False

    describe "Heads Up Game" $
      describe "PreDeal" $ do
        describe "When 0 players sat in" $ do
          let game' =
                (street .~ PreDeal) . (maxBet .~ 0) . (pot .~ 0)
                  . (deck .~ initialDeck)
                  . (currentPosToAct .~ Nothing)
                  . (dealer .~ 0)
                  . ( players
                        .~ [ ( (actedThisTurn .~ False) . (playerStatus .~ SatOut)
                                 . (bet .~ 0)
                                 . (chips .~ 2000)
                                 . (committed .~ 0)
                                 . (bet .~ 0)
                             )
                               player1,
                             ( (actedThisTurn .~ False) . (playerStatus .~ SatOut)
                                 . (bet .~ 0)
                                 . (committed .~ 0)
                                 . (bet .~ 0)
                                 . (chips .~ 2000)
                             )
                               player2
                           ]
                    )
                  $ initialGameState'

          it "No player should have to act first" $ do
            doesPlayerHaveToAct (_playerName player1) game' `shouldBe` False
            doesPlayerHaveToAct (_playerName player2) game' `shouldBe` False

        describe "When 1 player is sat in" $ do
          let game' =
                (street .~ PreDeal)
                  . ( players
                        .~ [ ( (actedThisTurn .~ False) . (playerStatus .~ SatOut)
                                 . (bet .~ 0)
                                 . (chips .~ 2000)
                                 . (committed .~ 0)
                             )
                               player1,
                             ( (actedThisTurn .~ False) . (playerStatus .~ SatIn NotFolded) . (bet .~ 0)
                                 . (committed .~ 0)
                                 . (chips .~ 2000)
                             )
                               player2
                           ]
                    )
                  $ initialGameState'

          it "No player should have to act first" $ do
            doesPlayerHaveToAct (_playerName player1) game' `shouldBe` False
            doesPlayerHaveToAct (_playerName player2) game' `shouldBe` False

        describe
          "When 2 players are both sat in but no one has posted a blind yet"
          $ do
            let game' =
                  (street .~ PreDeal) . (maxBet .~ 0) . (pot .~ 0)
                    . (deck .~ initialDeck)
                    . (currentPosToAct ?~ 1)
                    . (dealer .~ 0)
                    . ( players
                          .~ [ ( (actedThisTurn .~ False) . (playerStatus .~ SatIn NotFolded) . (bet .~ 0)
                                   . (chips .~ 2000)
                                   . (committed .~ 0)
                               )
                                 player1,
                               ( (actedThisTurn .~ False) . (playerStatus .~ SatIn NotFolded) . (bet .~ 0)
                                   . (committed .~ 0)
                                   . (chips .~ 2000)
                               )
                                 player2
                             ]
                      )
                    $ initialGameState'
            it "Player1 should not have to act" $
              doesPlayerHaveToAct (_playerName player1) game'
                `shouldBe` False

            it "Player2 should not have to act" $
              doesPlayerHaveToAct (_playerName player2) game'
                `shouldBe` False

        describe "When one player has already posted blinds" $ do
          let game' =
                (street .~ PreDeal) . (maxBet .~ 25) . (pot .~ 25)
                  . (deck .~ initialDeck)
                  . (currentPosToAct ?~ 1)
                  . (dealer .~ 0)
                  . ( players
                        .~ [ ( (actedThisTurn .~ True) . (playerStatus .~ SatIn NotFolded) . (bet .~ 0)
                                 . (chips .~ 2000)
                                 . (committed .~ 25)
                             )
                               player1,
                             ( (actedThisTurn .~ False) . (playerStatus .~ SatIn NotFolded) . (bet .~ 0)
                                 . (committed .~ 0)
                                 . (chips .~ 1950)
                             )
                               player2
                           ]
                    )
                  $ initialGameState'

          it "Player1 should not have to act" $
            doesPlayerHaveToAct (_playerName player1) game'
              `shouldBe` False

          it "Player2 should have to act" $
            doesPlayerHaveToAct (_playerName player2) game'
              `shouldBe` True

        describe "PreFlop" $ do
          describe "First Turn" $ do
            let game' =
                  (street .~ PreFlop) . (maxBet .~ 50) . (deck .~ initialDeck)
                    . (smallBlind .~ 25)
                    . (smallBlind .~ 50)
                    . (pot .~ 100)
                    . (currentPosToAct ?~ 1)
                    . (dealer .~ 1)
                    . ( players
                          .~ [ ( (actedThisTurn .~ False) . (playerStatus .~ SatIn NotFolded)
                                   . (bet .~ 50)
                                   . (committed .~ 50)
                                   . (chips .~ 1950)
                               )
                                 player1,
                               ( (actedThisTurn .~ False) . (playerStatus .~ SatIn NotFolded)
                                   . (bet .~ 50)
                                   . (chips .~ 1975)
                                   . (committed .~ 50)
                               )
                                 player2
                             ]
                      )
                    $ initialGameState'
            it "Player1 should not have to act" $
              doesPlayerHaveToAct (_playerName player1) game'
                `shouldBe` False
            it "Player2 should have to act" $
              doesPlayerHaveToAct (_playerName player2) game'
                `shouldBe` True

          describe "Second Turn" $ do
            let game' =
                  (street .~ PreFlop) . (maxBet .~ 50) . (deck .~ initialDeck)
                    . (smallBlind .~ 25)
                    . (smallBlind .~ 50)
                    . (pot .~ 100)
                    . (currentPosToAct ?~ 1)
                    . (dealer .~ 1)
                    . ( players
                          .~ [ ( (actedThisTurn .~ True) . (playerStatus .~ SatIn NotFolded)
                                   . (bet .~ 50)
                                   . (committed .~ 50)
                                   . (chips .~ 1950)
                               )
                                 player1,
                               ( (actedThisTurn .~ False) . (playerStatus .~ SatIn NotFolded)
                                   . (bet .~ 50)
                                   . (chips .~ 1975)
                                   . (committed .~ 50)
                               )
                                 player2
                             ]
                      )
                    $ initialGameState'

            it "Player1 should not have to act" $
              doesPlayerHaveToAct (_playerName player1) game'
                `shouldBe` False

            it "Player2 should have to act" $
              doesPlayerHaveToAct (_playerName player2) game'
                `shouldBe` True

          describe "Third Turn" $ do
            let game' =
                  (street .~ PreFlop) . (maxBet .~ 50) . (pot .~ 0)
                    . (deck .~ initialDeck)
                    . (currentPosToAct ?~ 0)
                    . (dealer .~ 1)
                    . ( players
                          .~ [ ( (playerStatus .~ SatIn NotFolded) . (bet .~ 0) . (committed .~ 50)
                                   . (chips .~ 1950)
                               )
                                 player1,
                               ( (actedThisTurn .~ True) . (playerStatus .~ SatIn NotFolded)
                                   . (bet .~ 25)
                                   . (chips .~ 1950)
                                   . (committed .~ 50)
                                   . (actedThisTurn .~ False)
                               )
                                 player2
                             ]
                      )
                    $ initialGameState'
            it "Player1 should have to act" $
              doesPlayerHaveToAct (_playerName player1) game'
                `shouldBe` True
            it "Player2 should not have to act" $
              doesPlayerHaveToAct (_playerName player2) game'
                `shouldBe` False

        describe "Flop" $ do
          describe "First turn" $ do
            let game' =
                  (street .~ Flop) . (maxBet .~ 0) . (pot .~ 100)
                    . (deck .~ initialDeck)
                    . (currentPosToAct ?~ 1)
                    . (dealer .~ 0)
                    . ( players
                          .~ [ ( (actedThisTurn .~ False) . (playerStatus .~ SatIn NotFolded)
                                   . (bet .~ 0)
                                   . (chips .~ 2000)
                                   . (committed .~ 50)
                               )
                                 player1,
                               ( (actedThisTurn .~ False) . (playerStatus .~ SatIn NotFolded)
                                   . (bet .~ 0)
                                   . (committed .~ 50)
                                   . (chips .~ 2000)
                               )
                                 player2
                             ]
                      )
                    $ initialGameState'

            it "Player1 should not have to act" $
              doesPlayerHaveToAct (_playerName player1) game'
                `shouldBe` False

            it "Player2 should have to act" $
              doesPlayerHaveToAct (_playerName player2) game'
                `shouldBe` True

          describe "Second turn" $ do
            let game' =
                  (street .~ Flop) . (maxBet .~ 0) . (pot .~ 100)
                    . (deck .~ initialDeck)
                    . (currentPosToAct ?~ 0)
                    . (dealer .~ 0)
                    . ( players
                          .~ [ ( (actedThisTurn .~ False) . (playerStatus .~ SatIn NotFolded)
                                   . (bet .~ 0)
                                   . (chips .~ 2000)
                                   . (committed .~ 50)
                               )
                                 player1,
                               ( (actedThisTurn .~ True) . (playerStatus .~ SatIn NotFolded) . (bet .~ 0)
                                   . (committed .~ 50)
                                   . (chips .~ 2000)
                               )
                                 player2
                             ]
                      )
                    $ initialGameState'

            it "Player1 should have to act" $
              doesPlayerHaveToAct (_playerName player1) game'
                `shouldBe` True

            it "Player2 should not have to act" $
              doesPlayerHaveToAct (_playerName player2) game'
                `shouldBe` False

  describe "nextPosToAct" $ do
    let player1 =
          Player
            { _pockets = Nothing,
              _chips = 2000,
              _bet = 0,
              _playerStatus = SatIn NotFolded,
              _playerName = "player1",
              _committed = 100,
              _actedThisTurn = True,
              _possibleActions = []
            }

        player2 =
          Player
            { _pockets = Nothing,
              _chips = 2000,
              _bet = 0,
              _playerStatus = SatIn Folded,
              _playerName = "player2",
              _committed = 50,
              _actedThisTurn = False,
              _possibleActions = []
            }

        player3 =
          Player
            { _pockets = Nothing,
              _chips = 2000,
              _bet = 0,
              _playerStatus = SatIn NotFolded,
              _playerName = "player3",
              _committed = 50,
              _actedThisTurn = False,
              _possibleActions = []
            }

        player4 =
          Player
            { _pockets = Nothing,
              _chips = 2000,
              _bet = 0,
              _playerStatus = SatIn NotFolded,
              _playerName = "player3",
              _committed = 0,
              _actedThisTurn = False,
              _possibleActions = []
            }

        player5 =
          Player
            { _pockets = Nothing,
              _chips = 4000,
              _bet = 4000,
              _playerStatus = SatIn NotFolded,
              _playerName = "player5",
              _committed = 4000,
              _actedThisTurn = True,
              _possibleActions = []
            }

    --it "nextPosToAct is always less than player count" $
    --  hedgehog $ do
    --    g <- forAll $ genGame allPStreets allPStates
    --    let pCount = length $ _players g
    --        nextPos = fromMaybe 0 (nextPosToAct g)
    --    assert $ nextPos < pCount

    --it "When everyone is all in then there should be no next player to act" $
    --  hedgehog $ do
    --    g <- forAll $ Gen.filter everyoneAllIn (genGame allPStreets allPStates)
    --    nextPosToAct g === Nothing

    it "When awaiting player action nextPosToAct should never be Nothing" $
      hedgehog $ do
        g <- forAll $ Gen.filter awaitingPlayerAction (genGame [PreFlop, Flop, Turn, River] [SatIn NotFolded, SatIn Folded])
        isNothing (nextPosToAct g) === False

    describe "Heads Up" $
      it "should modulo increment position for two players who are both SatIn NotFolded" $ do
        let game =
              (street .~ PreFlop) . (currentPosToAct ?~ 0)
                . (players .~ [player1, player3])
                $ initialGameState'
        nextPosToAct game `shouldBe` Just 1
        let game2 =
              (street .~ PreFlop) . (currentPosToAct ?~ 1)
                . (players .~ [player1, player3])
                $ initialGameState'
        nextPosToAct game2 `shouldBe` Just 0

    describe "Three Players" $ do
      let threePGamePreFlop =
            Game
              { _dealer = 2,
                _currentPosToAct = Just 0,
                _smallBlind = 25,
                _bigBlind = 50,
                _minBuyInChips = 1500,
                _maxBuyInChips = 3000,
                _pot = 100,
                _maxBet = 50,
                _street = PreFlop,
                _winners = NoWinners,
                _board = [],
                _maxPlayers = 6,
                _waitlist = [],
                _deck = Deck [],
                _players =
                  [ Player
                      { _pockets = Nothing,
                        _chips = 2300,
                        _bet = 50,
                        _playerStatus = SatIn NotFolded,
                        _playerName = "player0",
                        _committed = 50,
                        _actedThisTurn = True,
                        _possibleActions = []
                      },
                    Player
                      { _pockets = Nothing,
                        _chips = 1700,
                        _bet = 50,
                        _playerStatus = SatIn NotFolded,
                        _playerName = "player1",
                        _committed = 50,
                        _actedThisTurn = True,
                        _possibleActions = []
                      },
                    Player
                      { _pockets = Nothing,
                        _chips = 2122,
                        _bet = 0,
                        _playerStatus = SatIn Folded,
                        _playerName = "player2",
                        _committed = 0,
                        _actedThisTurn = True,
                        _possibleActions = []
                      }
                  ]
              }

      it "Next position at end of PreDeal (PreFlop) should should skip folded player's position" $
        nextPosToAct threePGamePreFlop `shouldBe` Just 1

      it "Next position at end of PreDeal (PreFlop) should be left of big blind's (dealer's) position" $ do
        let game2 =
              (street .~ PreFlop) . (currentPosToAct ?~ 2)
                . (players .~ [player1, player1, player1])
                $ initialGameState'
        nextPosToAct game2 `shouldBe` Just 1

      it "Next position at end of Flop (Turn) should be small blind's position" $ do
        let game2 =
              (street .~ Flop) . (currentPosToAct ?~ 0)
                . (players .~ [player1, player1, player1])
                $ initialGameState'
        nextPosToAct game2 `shouldBe` Just 1

      it "should modulo increment position when one player has folded" $ do
        let game2 =
              (street .~ PreFlop) . (currentPosToAct ?~ 2)
                . (players .~ [player1, player2, player3])
                $ initialGameState'
        nextPosToAct game2 `shouldBe` Just 0

    describe "Four Players" $
      it "should modulo increment position for four players" $ do
        let game =
              (street .~ PreFlop) . (currentPosToAct ?~ 2)
                . (players .~ [player1, player4, player3, player2])
                $ initialGameState'
        nextPosToAct game `shouldBe` Just 0
        let game2 =
              (street .~ PreFlop) . (currentPosToAct ?~ 2)
                . ( players
                      .~ [ player1,
                           player4,
                           player3,
                           (playerStatus .~ SatIn NotFolded) player2,
                           (playerStatus .~ SatIn NotFolded) player2
                         ]
                  )
                $ initialGameState'
        nextPosToAct game2 `shouldBe` Just 3
        let game3 =
              (street .~ PreFlop) . (currentPosToAct ?~ 2)
                . (players .~ [player2, player4, player3, player2])
                $ initialGameState'
        nextPosToAct game3 `shouldBe` Just 1


================================================
FILE: server/test/Poker/Generators.hs
================================================
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Poker.Generators where

import Control.Lens
  ( Field2 (_2),
    FunctorWithIndex (imap),
    (%~),
    (.~),
    (^.),
  )
import Control.Monad (Monad (return), replicateM)
import Control.Monad.State (Monad (return), replicateM)
import Data.Either ()
import qualified Data.List as List
import Data.Maybe (Maybe (..))
import Data.Proxy ()
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text as Text
import Data.Traversable (mapAccumR)
import Data.Tuple (fst, swap)
import qualified Data.Vector as V
import Debug.Trace ()
import GHC.Enum (Enum (fromEnum))
import Hedgehog (Gen)
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Poker.Game.Game (getWinners, nextIxPlayerToAct)
import Poker.Game.Utils
  ( getActivePlayers,
    getPlayersSatIn,
    initialDeck,
  )
import Poker.Types
  ( Card (suit),
    Deck (..),
    Game (..),
    Player (..),
    PlayerName,
    PlayerState (..),
    PocketCards (..),
    SatInState (..),
    Street (..),
    Suit (Diamonds, Spades),
    Winners (NoWinners),
    bet,
    playerName,
    unDeck,
  )
import Prelude

allPStates :: [PlayerState]
allPStates = [SatOut, SatIn Folded, SatIn NotFolded]

allPStreets :: [Street]
allPStreets = [PreDeal ..]

numBoardCards :: Street -> Int
numBoardCards =
  \case
    PreDeal -> 0
    PreFlop -> 0
    Flop -> 3
    Turn -> 4
    River -> 5
    Showdown -> 5

genShuffledCards :: Int -> Gen [Card]
genShuffledCards n = do
  cs <- Gen.shuffle $ unDeck initialDeck
  return $ take n cs

genShuffledDeck :: Gen Deck
genShuffledDeck = do
  cs <- Gen.shuffle $ unDeck initialDeck
  return $ Deck cs

genSuit :: Gen Suit
genSuit = Gen.enum Diamonds Spades

genSameSuitCards :: Int -> Gen [Card]
genSameSuitCards n = do
  suit' <- genSuit
  cs <- Gen.shuffle $ filter ((== suit') . suit) (unDeck initialDeck)
  return $ take n cs

genDealPockets :: [Card] -> Gen (Maybe PocketCards, [Card])
genDealPockets cs = do
  let ([c1, c2], remainingCs) = splitAt 2 cs
  return (Just $ PocketCards c1 c2, remainingCs)

genNoPockets :: [Card] -> Gen (Maybe PocketCards, [Card])
genNoPockets cs = return (Nothing, cs)

genPlayers :: Street -> Int -> [PlayerState] -> Int -> [Card] -> Gen ([Player], [Card])
genPlayers street' requiredInPlayers possibleStates playerCount cs = do
  ps <- replicateM playerCount $ do
    pState <- Gen.element possibleStates
    genPlayer street' pState "player" Nothing
  if activesCount ps < requiredInPlayers || street' `elem` actionStages && satInCount ps < 2
    then Gen.discard
    else return $ swap $ dealPlayersGen ps cs
  where
    actionStages = [PreFlop, Flop, Turn, River]
    activesCount ps = length $ getActivePlayers ps
    satInCount ps = length $ getPlayersSatIn ps

dealPlayersGen :: [Player] -> [Card] -> ([Card], [Player])
dealPlayersGen ps cs =
  _2 %~ nameByPos $
    mapAccumR
      ( \cs p ->
          let (maybeDealtP, remainingCs') = dealPlayer cs p
           in (remainingCs', maybeDealtP)
      )
      cs
      ps
  where
    newName pos = playerName .~ "player" <> T.pack (show pos)
    nameByPos ps = imap newName ps
    dealPlayer cs plyr@Player {..}
      | _playerStatus == SatOut = (plyr, cs)
      | otherwise = (,) Player {_pockets = Just $ PocketCards c1 c2, ..} remainingCs'
      where
        ([c1, c2], remainingCs') = splitAt 2 cs

genPlayer' :: Street -> [PlayerState] -> Int -> [Card] -> Gen (Player, [Card])
genPlayer' street' possibleStates position cs = do
  pState <- Gen.element possibleStates
  let shouldDeal = pState /= SatOut || null cs
  (pocketCs, remainingCs) <- if shouldDeal then genDealPockets cs else genNoPockets cs
  p <- genPlayer street' pState pName pocketCs
  return (p, remainingCs)
  where
    pName = "player" <> T.pack (show position)

-- if given Just cards then will deal player (as long as not sat out) and return the remaining cards
--
-- minChips is calculated to reflect fact that a player can't fold if was all in (no action possible when chips 0)
-- a player who has state set to Folded and has 0 chips is not a valid player state
genPlayer :: Street -> PlayerState -> PlayerName -> Maybe PocketCards -> Gen Player
genPlayer street' _playerStatus _playerName _pockets = do
  _chips <- Gen.int $ Range.linear minChips 10000
  _committed <- if _playerStatus == SatOut then Gen.constant 0 else Gen.int $ Range.linear 0 10000
  _bet <- if street' == PreDeal then Gen.constant 0 else Gen.int $ Range.linear 0 _committed
  _actedThisTurn <- if _playerStatus == SatOut then Gen.constant False else Gen.bool
  return Player {..}
  where
    minChips = if _playerStatus == SatIn Folded then 1 else 0
    _possibleActions = []

genGame :: [Street] -> [PlayerState] -> Gen Game
genGame possibleStreets pStates = do
  _street <- Gen.element possibleStreets
  let d@(Deck cs) = initialDeck
  let boardCount = numBoardCards _street
      (boardCards, remainingCs) = splitAt boardCount cs
  _smallBlind <- Gen.int $ Range.linear 1 100
  _maxPlayers <- Gen.int $ Range.linear 2 9
  playerCount <- Gen.int $ Range.linear 2 _maxPlayers
  let requiredInPlyrs = if _street == Showdown then 2 else 0
  (_players, remainingCs') <- genPlayers _street requiredInPlyrs pStates playerCount remainingCs
  let _waitlist = []
      _bigBlind = _smallBlind * 2
      _maxBuyInChips = _bigBlind * 200
      _minBuyInChips = _bigBlind * 100
      (_board, remainingCs'') = splitAt (numBoardCards _street) remainingCs'
      _deck = Deck remainingCs''
      betsThisRound = (^. bet) <$> _players
      _maxBet = maximum betsThisRound
      betSum = sum betsThisRound
      playerCount = length _players
      _winners = if _street == Showdown then getWinners Game {..} else NoWinners
  _pot <- Gen.int $ Range.linear betSum (betSum * fromEnum _street)
  _dealer <- Gen.int $ Range.linear 0 (playerCount - 1)
  _currentPosToAct' <- Gen.int $ Range.linear 0 (playerCount - 1)
  let g'' = Game {..}
      _currentPosToAct = fst <$> nextIxPlayerToAct g'' (Just _dealer)
  return Game {..}


================================================
FILE: server/test/Poker/HandSpec.hs
================================================
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Poker.HandSpec where

import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (isJust)
import Data.Text (Text)
import qualified Data.Text as T
import Hedgehog (Property, forAll, property, (===))
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Poker.Game.Hands (maybeFlush, value)
import Poker.Generators (genSameSuitCards, genShuffledCards)
import Test.Hspec (describe, it)
import Test.Hspec.Hedgehog
  ( PropertyT,
    diff,
    forAll,
    hedgehog,
    modifyMaxDiscardRatio,
    (/==),
    (===),
  )

spec = do
  describe "value" $ do
    it "Number of cards before and after valuation is involutive" $
      hedgehog $ do
        sevenCards <- forAll (genShuffledCards 7)
        let (_, cs) = value sevenCards
        length cs === 5

  it "7 suited cards always a flush" $
    hedgehog $ do
      cs <- forAll $ genSameSuitCards 7
      isJust (maybeFlush cs) === True


================================================
FILE: server/test/Poker/UtilsSpec.hs
================================================
{-# LANGUAGE OverloadedStrings #-}

module Poker.UtilsSpec where

import Control.Lens ((.~))
import Data.List ()
import Data.List.Lens ()
import Data.Text (Text)
import qualified Data.Text as T
import Hedgehog (forAll, (===))
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Poker.ActionValidation ()
import Poker.Game.Utils (initialDeck, modInc)
import Poker.Poker (initialGameState)
import Poker.Types
  ( Game,
    Player (..),
    PlayerState (..),
    SatInState (..),
    Street (PreFlop),
    players,
    street,
  )
import Test.Hspec (describe, it, shouldBe)
import Test.Hspec.Hedgehog
  ( PropertyT,
    diff,
    forAll,
    hedgehog,
    modifyMaxDiscardRatio,
    (/==),
    (===),
  )

initialGameState' :: Game
initialGameState' = initialGameState initialDeck

player1 :: Player
player1 =
  Player
    { _pockets = Nothing,
      _chips = 2000,
      _bet = 0,
      _playerStatus = SatIn NotFolded,
      _playerName = "player1",
      _committed = 100,
      _actedThisTurn = True,
      _possibleActions = []
    }

player2 :: Player
player2 =
  Player
    { _pockets = Nothing,
      _chips = 2000,
      _bet = 0,
      _playerStatus = SatIn Folded,
      _playerName = "player2",
      _committed = 50,
      _actedThisTurn = False,
      _possibleActions = []
    }

player3 :: Player
player3 =
  Player
    { _pockets = Nothing,
      _chips = 2000,
      _bet = 0,
      _playerStatus = SatIn NotFolded,
      _playerName = "player3",
      _committed = 50,
      _actedThisTurn = False,
      _possibleActions = []
    }

player4 :: Player
player4 =
  Player
    { _pockets = Nothing,
      _chips = 2000,
      _bet = 0,
      _playerStatus = SatIn NotFolded,
      _playerName = "player3",
      _committed = 0,
      _actedThisTurn = False,
      _possibleActions = []
    }

player5 :: Player
player5 =
  Player
    { _pockets = Nothing,
      _chips = 4000,
      _bet = 4000,
      _playerStatus = SatIn NotFolded,
      _playerName = "player5",
      _committed = 4000,
      _actedThisTurn = True,
      _possibleActions = []
    }

player6 :: Player
player6 =
  Player
    { _pockets = Nothing,
      _chips = 2000,
      _bet = 200,
      _playerStatus = SatIn NotFolded,
      _playerName = "player6",
      _committed = 250,
      _actedThisTurn = True,
      _possibleActions = []
    }

bettingFinishedGame :: Game
bettingFinishedGame =
  ((players .~ [player1, player2]) . (street .~ PreFlop)) initialGameState'

bettingNotFinishedGame :: Game
bettingNotFinishedGame =
  ((players .~ [player1, player2, player3, player4]) . (street .~ PreFlop))
    initialGameState'

spec = do
  describe "ModInc" $ do
    it "should increment in modulo fashion" $ do
      modInc 1 0 2 `shouldBe` 1
      modInc 1 1 1 `shouldBe` 0
      modInc 1 6 7 `shouldBe` 7

    it "result should always be greater than zero" $ do
      hedgehog $ do
        i <- forAll $ Gen.int $ Range.linear 0 9
        (modInc 1 i 9 >= 0) === True


================================================
FILE: server/test/PokerSpec.hs
================================================
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

module PokerSpec where

import Data.Text (Text)
import qualified Data.Text as T
import Hedgehog (Property, forAll, property, withDiscards, (===))
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Poker.Game.Game (haveAllPlayersActed)
import Poker.Game.Utils (getActivePlayers)
import Poker.Generators (allPStates, genGame)
import Poker.Poker (canProgressGame)
import Poker.Types
import Test.Hspec (SpecWith, describe, it)
import Test.Hspec.Hedgehog (forAll, hedgehog, (===))

player1 :: Player
player1 =
  Player
    { _pockets =
        Just $
          PocketCards
            Card {rank = Three, suit = Diamonds}
            Card {rank = Four, suit = Spades},
      _chips = 2000,
      _bet = 50,
      _playerStatus = SatIn NotFolded,
      _playerName = "player1",
      _committed = 50,
      _actedThisTurn = True,
      _possibleActions = []
    }

player2 :: Player
player2 =
  Player
    { _pockets =
        Just $
          PocketCards
            Card {rank = Three, suit = Clubs}
            Card {rank = Four, suit = Hearts},
      _chips = 0,
      _bet = 0,
      _playerStatus = SatIn NotFolded,
      _playerName = "player2",
      _committed = 50,
      _actedThisTurn = False,
      _possibleActions = []
    }

player3 :: Player
player3 =
  Player
    { _pockets = Nothing,
      _chips = 2000,
      _bet = 0,
      _playerStatus = SatIn NotFolded,
      _playerName = "player3",
      _committed = 50,
      _actedThisTurn = False,
      _possibleActions = []
    }

player4 :: Player
player4 =
  Player
    { _pockets = Nothing,
      _chips = 2000,
      _bet = 0,
      _playerStatus = SatOut,
      _playerName = "player4",
      _committed = 0,
      _actedThisTurn = False,
      _possibleActions = []
    }

player5 :: Player
player5 =
  Player
    { _pockets =
        Just $
          PocketCards
            Card {rank = King, suit = Diamonds}
            Card {rank = Four, suit = Spades},
      _chips = 2000,
      _bet = 50,
      _playerStatus = SatIn NotFolded,
      _playerName = "player1",
      _committed = 50,
      _actedThisTurn = True,
      _possibleActions = []
    }

initPlayers :: [Player]
initPlayers = [player1, player2, player3]

spec :: SpecWith ()
spec = describe "Poker" $ do
  return ()

================================================
FILE: server/test/Spec.hs
================================================
{-# OPTIONS_GHC -F -pgmF hspec-discover #-}