├── .dockerignore ├── .github └── workflows │ └── runtime.yml ├── .gitignore ├── API.markdown ├── Dockerfile ├── LICENSE ├── README.md ├── TODO ├── amber.yaml ├── app ├── devel-server.hs ├── devel.hs └── main.hs ├── config ├── db │ ├── aws.asc │ ├── aws.example │ ├── client-session-key.aes.asc │ ├── facebook.yaml.example │ ├── google-email.yaml.example │ ├── postgresql.yml.asc │ └── postgresql.yml.example ├── favicon.ico ├── models ├── robots.txt ├── routes └── settings.yml ├── messages ├── en.msg ├── fr.msg ├── he.msg ├── ja.msg ├── ru.msg ├── se.msg └── ua.msg ├── package.yaml ├── run.sh ├── src ├── Application.hs ├── Foundation.hs ├── Handler │ ├── Admin.hs │ ├── Bling.hs │ ├── Email.hs │ ├── Faq.hs │ ├── Job.hs │ ├── News.hs │ ├── Package.hs │ ├── Poll.hs │ ├── Privacy.hs │ ├── Profile.hs │ ├── Root.hs │ ├── Skills.hs │ ├── Team.hs │ ├── Topic.hs │ └── User.hs ├── Import.hs ├── Model.hs ├── Model │ └── Types.hs ├── Settings.hs ├── Settings │ ├── Development.hs │ └── StaticFiles.hs ├── StaticFiles.hs └── api-test.hs ├── stack.yaml ├── stack.yaml.lock ├── static ├── background.png ├── badge.png ├── bling │ └── monads-in-disguise.png ├── browserid.png ├── buttons.png ├── facebook.gif ├── google.gif ├── hslogo_16.png ├── images │ ├── m1.png │ ├── m2.png │ ├── m3.png │ ├── m4.png │ ├── m5.png │ ├── ui-bg_diagonals-thick_65_a6a6a6_40x40.png │ ├── ui-bg_diagonals-thick_75_f3d8d8_40x40.png │ ├── ui-bg_dots-small_65_a6a6a6_2x2.png │ ├── ui-bg_flat_0_333333_40x100.png │ ├── ui-bg_flat_0_aaaaaa_40x100.png │ ├── ui-bg_flat_100_506982_40x100.png │ ├── ui-bg_flat_100_e5eef9_40x100.png │ ├── ui-bg_flat_100_fafafa_40x100.png │ ├── ui-bg_flat_10_333333_40x100.png │ ├── ui-bg_flat_15_2a2d38_40x100.png │ ├── ui-bg_flat_50_e5eef9_40x100.png │ ├── ui-bg_flat_65_506982_40x100.png │ ├── ui-bg_flat_75_506982_40x100.png │ ├── ui-bg_flat_75_ffffff_40x100.png │ ├── ui-bg_glass_55_fbf8ee_1x400.png │ ├── ui-bg_glass_55_fbf9ee_1x400.png │ ├── ui-bg_glass_65_ffffff_1x400.png │ ├── ui-bg_glass_75_dadada_1x400.png │ ├── ui-bg_glass_75_e6e6e6_1x400.png │ ├── ui-bg_glass_95_fef1ec_1x400.png │ ├── ui-bg_glow-ball_60_506982_600x600.png │ ├── ui-bg_highlight-soft_75_cccccc_1x100.png │ ├── ui-icons_004276_256x240.png │ ├── ui-icons_222222_256x240.png │ ├── ui-icons_2a2d38_256x240.png │ ├── ui-icons_2e83ff_256x240.png │ ├── ui-icons_454545_256x240.png │ ├── ui-icons_4b5057_256x240.png │ ├── ui-icons_888888_256x240.png │ ├── ui-icons_cc0000_256x240.png │ ├── ui-icons_cd0a0a_256x240.png │ ├── ui-icons_dbedff_256x240.png │ ├── ui-icons_fafafa_256x240.png │ └── ui-icons_ffffff_256x240.png ├── img │ ├── glyphicons-halflings-white.png │ └── glyphicons-halflings.png ├── jquery-cookie.js ├── jquery-ui.css ├── logo.png ├── markerclusterer.js ├── openid-icon-small.gif ├── openid.gif ├── reset.css └── yahoo.gif └── templates ├── admin-controls.cassius ├── admin-controls.hamlet ├── admin-users.cassius ├── admin-users.hamlet ├── admin-users.julius ├── analytics.julius ├── bling.cassius ├── bling.hamlet ├── default-layout-wrapper.hamlet ├── default-layout.cassius ├── default-layout.hamlet ├── default-layout.julius ├── faq.cassius ├── faq.hamlet ├── flag.cassius ├── flag.hamlet ├── homepage.cassius ├── homepage.hamlet ├── homepage.julius ├── job.cassius ├── job.hamlet ├── jobs.cassius ├── jobs.hamlet ├── login-status.cassius ├── login-status.hamlet ├── login.hamlet ├── messages.cassius ├── messages.hamlet ├── navbar-section.hamlet ├── news-admin.cassius ├── news-item.hamlet ├── news.cassius ├── news.hamlet ├── normalize.lucius ├── poll.hamlet ├── poll.lucius ├── polls.hamlet ├── profile.cassius ├── profile.hamlet ├── profile.julius ├── skill.hamlet ├── skills.cassius ├── skills.hamlet ├── team-form.hamlet ├── team.cassius ├── team.hamlet ├── teams-form.hamlet ├── teams.cassius ├── teams.hamlet ├── topic.cassius ├── topic.hamlet ├── topics.cassius ├── topics.hamlet ├── user.cassius ├── user.hamlet ├── user.julius ├── users.cassius ├── users.hamlet └── users.julius /.dockerignore: -------------------------------------------------------------------------------- 1 | .stack-work 2 | .stack-root 3 | static/tmp 4 | -------------------------------------------------------------------------------- /.github/workflows/runtime.yml: -------------------------------------------------------------------------------- 1 | name: Runtime image 2 | 3 | on: 4 | push: 5 | branches: [master] 6 | pull_request: 7 | 8 | jobs: 9 | push: 10 | runs-on: ubuntu-latest 11 | steps: 12 | - uses: actions/checkout@v2 13 | 14 | - name: Log into Github registry 15 | run: echo "${{ secrets.GITHUB_TOKEN }}" | docker login docker.pkg.github.com -u ${{ github.actor }} --password-stdin 16 | 17 | - name: Build image 18 | run: docker build . --tag image 19 | 20 | - name: Push to Docker Hub 21 | run: | 22 | echo "${{ secrets.DOCKER_HUB_TOKEN }}" | docker login --username snoyberg --password-stdin 23 | IMAGE_ID=snoyberg/haskellers 24 | docker tag image $IMAGE_ID 25 | docker push $IMAGE_ID 26 | IMAGE_ID=$IMAGE_ID:$GITHUB_SHA 27 | docker tag image $IMAGE_ID 28 | docker push $IMAGE_ID 29 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.swp 2 | *.hi 3 | *.o 4 | client-session-key.aes 5 | devel-server 6 | dist 7 | static/tmp 8 | /docker/app/ 9 | /kube/haskellers-postgresql-secret.yaml 10 | /.stack-work/ 11 | config/db/aws 12 | config/db/google-email.yaml 13 | config/db/facebook.yaml 14 | config/db/postgresql.yml 15 | yesod-devel 16 | *~ 17 | haskellers.cabal 18 | .envrc 19 | -------------------------------------------------------------------------------- /API.markdown: -------------------------------------------------------------------------------- 1 | This site runs on a RESTful API. Content is available as JSON. In order to access this, you **must** set an HTTP request header of "Accept: application/json". The following resource patterns are available: 2 | 3 | ## http://www.haskellers.com/users/ 4 | 5 | FIXME: This API is in flux right now, my appologies 6 | 7 | This returns a list of all publicly-viewable user accounts. The response is a JSON map with one attribute: users. users is a JSON list, each element an array with three elements: id is the numerical ID of the account, name is the user's full name and url is the user's Haskeller URL (the next resource pattern). 8 | 9 | ## http://www.haskellers.com/user/*id* 10 | 11 | This contains detailed information on a specific user. It returns a map with the following elements (note: more will be added over time): 12 | 13 | * id: numerical ID 14 | * name: user's full name 15 | * website (optional): the user's specified website 16 | * haskell-since (optional): first year user used Haskell 17 | * description (optional): the user's self description 18 | * skills: a JSON list of all skills the user claims 19 | 20 | ## http://www.haskellers.com/user/ 21 | 22 | This is for looking up a Haskell account by identifier. This is useful if you have an OpenID-enabled site and you would like to get information on a user. You must provide the user identifier as a query string parameter named "ident". If no account is associated with that identifier, this resource will return a 404. Otherwise, it will return a JSON map with two elements: id and url. 23 | 24 | ## http://www.haskellers.com/skills/ 25 | 26 | This returns a list of all skills available on Haskellers. It returns a map with one key: skills. The value is a list of maps with the fields: 27 | 28 | * id: The nuemrical ID of the skill 29 | * name: The name of the skill 30 | * url: The resource for this skill (see next entry). 31 | 32 | ## http://www.haskellers.com/skills/*id*/ 33 | 34 | Returns a list of users with a given skill. It returns a map with one key: users. The value is a list of maps with the fields: 35 | 36 | * id: The user's numerical ID 37 | * name: The user's full name 38 | * url: The resource for this user (see second entry in this file). 39 | 40 | # Sample session 41 | 42 | > curl -H "Accept: application/json" http://www.haskellers.com/ 43 | 44 | {"users":[{"id":"5","name":"Michael Snoyman","url":"http://www.haskellers.com/user/5/"}]} 45 | 46 | > curl -H "Accept: application/json" http://www.haskellers.com/user/5/ 47 | 48 | {"id":"5","name":"Michael Snoyman","website":"http://www.snoyman.com/","experience":"3","description":"This is a test description.\r\n\r\nvery very very very very very very very very very very very very very very very very very very very very long line\r\n\r\nThis is ","skills":["Web development","Parsec"]} 49 | 50 | > curl -H "Accept: application/json" http://www.haskellers.com/user/?ident=http://snoyberg.wordpress.com/ 51 | 52 | {"id":"5","url":"http://www.haskellers.com/user/5/"} 53 | -------------------------------------------------------------------------------- /Dockerfile: -------------------------------------------------------------------------------- 1 | FROM snoyberg/haskellers-build-image:e17739d1c2c043aae11924fee66c9ee4304ad37d as build-app 2 | 3 | RUN mkdir -p /artifacts/bin 4 | COPY . /src 5 | RUN stack install --stack-yaml /src/stack.yaml --local-bin-path /artifacts/bin 6 | 7 | FROM snoyberg/haskellers-build-image:e17739d1c2c043aae11924fee66c9ee4304ad37d 8 | RUN mkdir -p /app 9 | 10 | COPY --from=build-app /artifacts/bin/haskellers /usr/local/bin 11 | COPY --from=build-app /src/static /app/static 12 | COPY --from=build-app /src/config /app/config 13 | 14 | WORKDIR /app 15 | 16 | COPY ./run.sh /app/run.sh 17 | 18 | ADD https://github.com/fpco/pid1-rs/releases/download/v0.1.0/pid1-x86_64-unknown-linux-musl /usr/bin/pid1 19 | RUN chmod +x /usr/bin/pid1 20 | 21 | ADD https://github.com/fpco/amber/releases/download/v0.1.5/amber-x86_64-unknown-linux-musl /usr/bin/amber 22 | RUN chmod +x /usr/bin/amber 23 | 24 | COPY amber.yaml /app/amber.yaml 25 | 26 | ENTRYPOINT [ "pid1" ] 27 | 28 | CMD ["/app/run.sh"] 29 | 30 | ENV PORT 3000 31 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The following license covers this documentation, and the source code, except 2 | where otherwise indicated. 3 | 4 | Copyright 2012, Michael Snoyman. All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, this 10 | list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above copyright notice, 13 | this list of conditions and the following disclaimer in the documentation 14 | and/or other materials provided with the distribution. 15 | 16 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR 17 | IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 18 | MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO 19 | EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, 20 | INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 21 | NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, 22 | OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 23 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE 24 | OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF 25 | ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 26 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![Build Status](https://travis-ci.org/snoyberg/haskellers.svg?branch=master)](https://travis-ci.org/snoyberg/haskellers) 2 | 3 | #Haskellers 4 | Full source code for the haskellers.com website. Use as a base for your own Haskell/Yesod applications or as a sample application to help with learning Haskell/Yesod 5 | 6 | ### System Requirements 7 | You must have Haskell, Yesod and Postgresql installed. 8 | 9 | Instructions for installing Haskell and Yesod are available at http://www.yesodweb.com/page/quickstart 10 | 11 | You will also need to install libicu-dev. This can be installed on debian based machines with: 12 | 13 | ``` 14 | apt-get install libicu-dev 15 | ``` 16 | 17 | ### Installation 18 | 1. Download the source code to an appropriate folder. Just run: 19 | ``` 20 | git clone https://github.com/snoyberg/haskellers.git` 21 | ``` 22 | Alternatively download the zip archive at https://github.com/snoyberg/haskellers/archive/master.zip and extract to a suitable folder. 23 | 24 | 2. cd to the haskellers directory created above. 25 | 26 | 3. Download and install local copies of all the libraries needed by haskellers.com. using [the Stack tool](https://github.com/commercialhaskell/stack/): 27 | ``` 28 | stack install yesod-bin cabal-install --install-ghc && stack build 29 | ``` 30 | 4. create a new postgresql database for the haskellers data. Just run: 31 | 32 | ``` 33 | sudo su - postgres 34 | psql template1 35 | CREATE USER WITH PASSWORD ''; 36 | CREATE DATABASE ; 37 | GRANT ALL PRIVILEGES ON DATABASE TO ; 38 | \q 39 | ``` 40 | 5. Copy `config/db/postgresql.yml.example` to `config/db/postgresql.yml`, 41 | and edit the latter to reflect the choices you made in step 4. 42 | 43 | 6. Copy `config/db/google-email.yaml.example` to `config/db/google-email.yaml` 44 | and `config/db/facebook.yaml.example` to `config/db/facebook.yaml` 45 | 46 | 7. Copy `config/db/aws.example` to `config/db/aws`, and in the latter 47 | replace `SOME-ACCESS-KEY` and `SOME-SECRET-KEY` with random, 48 | unguessable strings. 49 | 50 | 8. Start the haskellers application by running `stack exec -- yesod devel`. 51 | -------------------------------------------------------------------------------- /TODO: -------------------------------------------------------------------------------- 1 | Fans (kudos?) 2 | Search by location. 3 | Project pages. 4 | -------------------------------------------------------------------------------- /amber.yaml: -------------------------------------------------------------------------------- 1 | file_format_version: 1 2 | public_key: 536015f7fb221ea96d24b30705135d4bb8e70920f9767336eadb59700290bc06 3 | secrets: 4 | - name: HASKELLERS_AWS 5 | sha256: 0b7b357dfdd26c14e8b47909c18a9a9e2a5bf2c74434d0edf7c5a36c1707f5fd 6 | cipher: 425395500a57737fcaf86cb80c7a23366e16bb5d76b8c4244aa4de8cfc4d05192c132fa1a0e85f67175cfcccd2d3b8224c86ca15c8629522d81d4065c91f5763a785b2197fc5548922770d864e2eb8518b7ab5631ee91e35b1215941ba51a9043effe492d38e4f79989827b106580eb45bd80817e26897201bb9dee1d1 7 | - name: HASKELLERS_CLIENT_SESSION_BASE64 8 | sha256: 90cb34a7a57fefaac91f3bf490ec17f3883836c75392b232a3e947978c4f3ade 9 | cipher: 266fe322656adfefb0ed2ec9e50c3edcc2baebc4b907f2eab1dd69c126bc5b59aaf28c05292698b30b9f9376e9e9feabfc23ebccf25daf394edcddc3fce73cdfcfe9cd7f30d694da534bc4d2765500bfb7d485add9bd6eb3d877fc920d765505dfc82e2a11669123476e339b53c9c4068cd928cfdef4ae677dce0c4321d10bfc200afa4df69ec133b46e7e8a4104fd6ab8c62cbfdc219d5ed9a895f790d447061f1bd9d40a533666b34313b197bbe1e6 10 | - name: HASKELLERS_FACEBOOK 11 | sha256: 12e194c2da8187365fcc0191eeec1b65bfa924ed6792c796d25695bf842696db 12 | cipher: 2a763d480c2fff76a9b9c5ad143e9a26dbbf935cf9d2de0a96a19aac2baf4c1d4b0c91fdf2967d7fb6f87257f96d22cca8f010c41f353637eb521f09f8727f2731ef4fbf2d8d91737099f3ac988de37f1f979229d27119fe22e5575b46a445f5cb64e2d0b8c76a09ad2306a881b86881c543e9a450867f5cb4a40723d2a5 13 | - name: HASKELLERS_GOOGLE 14 | sha256: e86c6737fae6848336f1dc6d6fbbb61088b17a7aa06de17dd04d66b2f0ce3881 15 | cipher: 52a9f547bea0fa95817daa1801519e13ea3b0148b61f5a765672958a91fcde08f9a9ef07ab69907451b4ec9ddc839a4428ef9e94f243520009507c2bea49fac21c81ba59cb261795af780aad8a40238771947e7504a6af6d139410681660e5964cf719ef67ed0918f5e3bfe438bfcccd587235d3aa145197e10f996ea1c5e868f501684e2203810b6f8411d613424288a6ea38906121961eadc9ecf3e1d7ba1b1e5672b161d32ef55e294b3b455e9b 16 | - name: HASKELLERS_POSTGRES 17 | sha256: 8de96d45b53f2035414d26de500b986d36ee0cfb96ea9680d251955488ac372f 18 | cipher: 892fd78b57d394431eb472107d2023a4b6e221940c7051128e5afd312038801b02725906760f04db4f0482b77b1d7951f71b6418800def8ccead365dfcebe7b021169c9ba1a79272c3926c2f9d6305c8a5531ee4bd2f9d3dc4a6fee832e106e664aea39c08087427e1f0260a0a3d7c7411b3fe46e522f922a28ba109f155584bf5792bf83da3938297f1e1af796b93333a69760b383ebd42d948f06564eee37677beb82040c426f3cbe7d250fa131b233b93352f9b1ecce2911fa0bd742b361291ca48f16188d466bcab4eb37e69fc91cf79fafd6ee8dfe38d900077930179251103b456ceb002cfd0ec9c55c2bf48cc5772d0ab8677c1a50d950537f53a0f630b5e9bdd9e00274fc8d71c92df28d8c0a135cf4c470fdf1fb1f751076dc0548be3dbbc339abcbbb55e6785edcf8001bb562b69e23eab99904c7c2057d786f64d5a260e27dc11ca7685b7ba4a7e8f4736fedee395e52fcbfe1f18087c009bee2dbe913cc9d12a168c8932824c3ad8b911d41b47cc5c313d81134c8b202cad8b96555d3e7b916eaa072d0d7723b8fccc48a7cddf8ec2a0385f7e5dd7b1f0bbe8bf3796e6eb8dcaa814eedecfdd2c56b2eadc3ff8bf8b036c03b8f53a4ad84387bde8e8e60e4cbea7b75654fa819ee30c04b1cdb801cd87be3e11b69240384d9509185ea769b5474386dfe5e47df25177b3e1148d14b99b9b6ad0f502a0d0f5192cbb399ac0637208a41c2aaa93c2032eadc437b55eb0547bfb728cae51aed4f4f22b 19 | -------------------------------------------------------------------------------- /app/devel-server.hs: -------------------------------------------------------------------------------- 1 | import Yesod (develServer) 2 | 3 | main :: IO () 4 | main = develServer 3000 "Controller" "withHaskellers" 5 | -------------------------------------------------------------------------------- /app/devel.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE PackageImports #-} 2 | import "haskellers" Application (getApplicationDev) 3 | import Network.Wai.Handler.Warp 4 | (runSettings, defaultSettings, setPort) 5 | import Control.Concurrent (forkIO) 6 | import System.Directory (doesFileExist, removeFile) 7 | import System.Exit (exitSuccess) 8 | import Control.Concurrent (threadDelay) 9 | 10 | main :: IO () 11 | main = do 12 | putStrLn "Starting devel application" 13 | (port, app) <- getApplicationDev 14 | forkIO $ runSettings (setPort port defaultSettings) app 15 | loop 16 | 17 | loop :: IO () 18 | loop = do 19 | threadDelay 100000 20 | e <- doesFileExist "dist/devel-terminate" 21 | if e then terminateDevel else loop 22 | 23 | terminateDevel :: IO () 24 | terminateDevel = exitSuccess 25 | -------------------------------------------------------------------------------- /app/main.hs: -------------------------------------------------------------------------------- 1 | import Prelude (IO) 2 | import Yesod.Default.Config (fromArgs) 3 | import Yesod.Default.Main (defaultMain) 4 | import Settings (parseExtra) 5 | import Application (makeApplication) 6 | 7 | main :: IO () 8 | main = defaultMain (fromArgs parseExtra) makeApplication 9 | -------------------------------------------------------------------------------- /config/db/aws.asc: -------------------------------------------------------------------------------- 1 | -----BEGIN PGP MESSAGE----- 2 | Version: GnuPG v1 3 | 4 | hQEMA8F5fR3BIOnuAQf9GpXY0WEutuj6zBeB5yNxXysfQepNtE00J/4b3VoQzCAI 5 | 0w5jEBLRAVt/3/pYQAnUv0/nN1nCebDu2C0oRRQXjry28Yiw/XA+dpJZAvbW3aJu 6 | AObQAXOkqwoZDWHsLlQcXZnNXFHsv1ScL5cmksADRWDlTv/gHWSZANNS/Z4ul0TJ 7 | JvOQ08RDQm2Y9mFhm8yMfKOUshNLFkuVyn2S/OBzQvTG15LnrDBoT8pYkUg5bW9L 8 | VYNjOcMmbocBe7XxFMcoVk5ZwGMCmNY2spWpTnMIApgaS5rN3Vk6tC3/z0NAmlJV 9 | BmKIXBaSFol+zZWdHh/ygO/SEzc7FtD2WJvQxXfrXdKMASGI4rjH4qoioSpT6d3V 10 | ZszA7jIjdhcaiMaTvqTI6bb7biLa5yQ1dIyM6E15yv4qeckkpS1Ztc/gV8KAaLVD 11 | B/HR9ao9jyxqrG2XNtrsO23VxakBlhfKVuhqilfp+dChOUIb39T3yesCc3GvTgVQ 12 | IP/MbqOP9K+XLa7+n6N+Qi2sd173kxWV1THGCag= 13 | =xg3/ 14 | -----END PGP MESSAGE----- 15 | -------------------------------------------------------------------------------- /config/db/aws.example: -------------------------------------------------------------------------------- 1 | access: SOME-ACCESS-KEY 2 | secret: SOME-SECRET-KEY 3 | -------------------------------------------------------------------------------- /config/db/client-session-key.aes.asc: -------------------------------------------------------------------------------- 1 | -----BEGIN PGP MESSAGE----- 2 | Version: GnuPG v1 3 | 4 | hQEMA8F5fR3BIOnuAQf9Ftpr0/agKIMMdI+6wnvPVogbj37KCMWD/z4BStWFPk6f 5 | XesltZRNvEsyTfAXYhaf5jwB/90XAoI8T4iubAKWJAhP6l6fT3T5ADa+0PmpsZAV 6 | ZNZD7uRigd7L1X83aqjSXUlwKRegLu3+xa+cP9NMu38PEosFXTHZiq8nhLML3kvU 7 | GQHr2K87jHHtnwjMY8v1rsLDS9sw1oanHoY449m9ze1kcXRMY0dbz4gNs1NV4GvQ 8 | GDPnbvGvUQ9PK+GeXVSuKWZN6M4HRZPBM6D7AoLqXyI/N0RCdnr73+bbTFPD78wP 9 | a8M37FukyRofX7dhpxS7prf+Nhr5euu/MnEadpn8XNK0ARnUrU10ixghGk2YUHCK 10 | vtDhawEjDt3lGJsoyMFn3u7vvXt8P94bWHxSIE7oTZMmr45XgzJUsAc2BSkvJ9D9 11 | VLImB723k0dYXPFdkhqZJ09uHmJaN4+hsJNCS7mTqxhTONjzaS1S1jqoS+yYy7NS 12 | VtkhXtKf+7e7dpUsLehzvVyc23IBA3W2ImbCN7bOXQLhJVpnPCb84MzoPF7NDduv 13 | C3/5Ji7yL4RZ0DGut5Uu/rqYo8Ev 14 | =kRY5 15 | -----END PGP MESSAGE----- 16 | -------------------------------------------------------------------------------- /config/db/facebook.yaml.example: -------------------------------------------------------------------------------- 1 | name: App.com 2 | id: "12345" 3 | secret: "12345deadbeef" 4 | -------------------------------------------------------------------------------- /config/db/google-email.yaml.example: -------------------------------------------------------------------------------- 1 | client-id: FAKE 2 | client-secret: FAKE 3 | -------------------------------------------------------------------------------- /config/db/postgresql.yml.asc: -------------------------------------------------------------------------------- 1 | -----BEGIN PGP MESSAGE----- 2 | Version: GnuPG v1 3 | 4 | hQEMA8F5fR3BIOnuAQf/SZOkuAIigFMo14yu2JlkhMqYfdzl/7CfeoBb6gtE1DTh 5 | lHn0HnUXudTahG0CVMmmW5RocLGV34v5lyv2aRdWitpiYNgMiHPZfAbbgGYEniiU 6 | YBhub1TsU2kkJ6dLkvOCo5x6JBhGGmDp2NsYm/FhhJclj6UjIr9ZbTweKs1mzmI5 7 | ruSMVXP0BOUVb3C6bOGkd9OUBf1qNMVjp07qg9KhKY3obyd7eR/cecvnzJDVer5t 8 | MEmRU4j/dGS+pzWDaIdgkpfYDS2wopuIbkNfOJOkp5VFMQWv+KK1StX+g3+ypG9d 9 | 4slyBq2ifDwO46gKs/zwHycMgqOfmEwKH/ycmuenSNLAigFLKNgwa50JjxEFl65e 10 | H4ht1eRTiJkUEdMZ/4Cpx21EA4Ftd2UVkYh2fuSNAosF4DtZPekrNHFdGDYz9VKa 11 | aWU/55eSU1N6AtJKkWi2LChbx/+nlceLB0x+EBkwfs8gpUodKds9bvVJ8lIjP0DY 12 | zYj2DPKog/BqPP5YqK/BsTT5IOkW4WckFOOQH9ms2oJ4jnPPfV9/YToYIsnfalRl 13 | pNuL3sY1WXCCDJ1nYck2+CjdoWQvjtkO1W+rm4tMdbK0D+4+NKwTCheCsl6cckM5 14 | Pk9U6kvW/IOMfKeB473mfz1Ye3K3M0B0kcY1X6WECuKCA/eYc6SW7hXTiguLyAQ+ 15 | 0pZ64uhlCGM5gDt0Y/lPSLkxX10Zxc5fPMoef0Ks5uQw0C19fTFDMDs0KHwPSmGP 16 | yOWRMTr5NU1v9fs6y1XGreiM8oSogFiELA1rXg== 17 | =X20A 18 | -----END PGP MESSAGE----- 19 | -------------------------------------------------------------------------------- /config/db/postgresql.yml.example: -------------------------------------------------------------------------------- 1 | Default: &defaults 2 | user: postgres 3 | password: your_password 4 | host: localhost 5 | port: 5432 6 | database: haskellers 7 | poolsize: 10 8 | 9 | Development: 10 | <<: *defaults 11 | 12 | Testing: 13 | database: _haskellers_test 14 | <<: *defaults 15 | 16 | Staging: 17 | database: haskellers_staging 18 | poolsize: 100 19 | <<: *defaults 20 | 21 | Production: 22 | database: haskellers_production 23 | poolsize: 100 24 | <<: *defaults 25 | -------------------------------------------------------------------------------- /config/favicon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/commercialhaskell/haskellers/4b8fca2a7e1cfdbe4233be114208587fc58b160e/config/favicon.ico -------------------------------------------------------------------------------- /config/models: -------------------------------------------------------------------------------- 1 | User 2 | fullName Text 3 | website Text Maybe 4 | email Text Maybe 5 | verifiedEmail Bool default=false 6 | verkey Text Maybe 7 | haskellSince Int Maybe 8 | desc Textarea Maybe 9 | visible Bool default=true 10 | real Bool default=false 11 | realPic Bool default=false 12 | admin Bool default=false 13 | employment Employment Maybe 14 | blocked Bool default=false 15 | emailPublic Bool default=false 16 | location Text Maybe 17 | longitude Double Maybe 18 | latitude Double Maybe 19 | googlePlus Text Maybe 20 | deriving Show Typeable 21 | Username 22 | user UserId 23 | username Text 24 | UniqueUsernameUser user 25 | UniqueUsername username 26 | deriving Show 27 | Ident 28 | ident Text 29 | user UserId 30 | UniqueIdent ident 31 | Skill 32 | name Text 33 | UserSkill 34 | user UserId 35 | skill SkillId 36 | UniqueUserSkill user skill 37 | Package 38 | user UserId 39 | name Text 40 | UniquePackage user name 41 | Message 42 | closed Bool 43 | when UTCTime 44 | from UserId Maybe 45 | regarding UserId Maybe 46 | text Textarea 47 | News 48 | when UTCTime 49 | title Text 50 | content Html 51 | Job 52 | postedBy UserId 53 | postedAt UTCTime 54 | title Text 55 | location Text 56 | fillingBy Day 57 | fullTime Bool 58 | partTime Bool 59 | desc Textarea 60 | descHtml Html Maybe 61 | open Bool default=true 62 | ScreenName 63 | user UserId 64 | service Service 65 | name Text 66 | Team 67 | name Text 68 | desc Html 69 | UniqueTeam name 70 | TeamUser 71 | team TeamId 72 | user UserId 73 | status TeamUserStatus 74 | UniqueTeamUser team user 75 | TeamNews 76 | team TeamId 77 | when UTCTime 78 | title Text 79 | content Html 80 | url Text 81 | TeamPackage 82 | team TeamId 83 | name Text 84 | hackage Bool 85 | desc Text Maybe 86 | homepage Text Maybe 87 | Topic 88 | team TeamId 89 | created UTCTime 90 | type TopicType 91 | status TopicStatus 92 | creator UserId Maybe 93 | title Text 94 | TopicMessage 95 | topic TopicId 96 | created UTCTime 97 | creator UserId Maybe 98 | content Html 99 | Poll 100 | question Text 101 | created UTCTime 102 | closed Bool default=false 103 | PollOption 104 | poll PollId 105 | answer Text 106 | priority Int 107 | PollAnswer 108 | poll PollId 109 | option PollOptionId 110 | user UserId 111 | real Bool 112 | answered UTCTime default=now() 113 | UniquePollAnswer poll user 114 | -------------------------------------------------------------------------------- /config/robots.txt: -------------------------------------------------------------------------------- 1 | User-agent: * 2 | -------------------------------------------------------------------------------- /config/routes: -------------------------------------------------------------------------------- 1 | /static StaticR Static getStatic 2 | /auth AuthR Auth getAuth 3 | 4 | /favicon.ico FaviconR GET 5 | /robots.txt RobotsR GET 6 | 7 | / RootR GET 8 | /users UsersR GET 9 | /locations LocationsR GET 10 | /page/faq FaqR GET 11 | 12 | /profile ProfileR GET POST 13 | /profile/delete DeleteAccountR POST 14 | /profile/skills SkillsR POST 15 | /profile/ident/#IdentId/delete DeleteIdentR POST 16 | /profile/request-real RequestRealR POST 17 | /profile/request-realpic RequestRealPicR POST 18 | /profile/request-unblock RequestUnblockR POST 19 | /profile/request-skill RequestSkillR POST 20 | /profile/username SetUsernameR POST 21 | /profile/clear-username ClearUsernameR POST 22 | /profile/screen-names ScreenNamesR POST 23 | /profile/screen-names/#ScreenNameId/delete DeleteScreenNameR POST 24 | 25 | /skills AllSkillsR GET POST 26 | /skills/#SkillId SkillR GET 27 | 28 | /packages PackagesR POST 29 | /package/#PackageId/delete DeletePackageR POST 30 | 31 | /user/#Text UserR GET 32 | /user/#UserId/admin AdminR POST 33 | /user/#UserId/unadmin UnadminR POST 34 | 35 | /user/#UserId/real RealR POST 36 | /user/#UserId/unreal UnrealR POST 37 | 38 | /user/#UserId/realpic RealPicR POST 39 | /user/#UserId/unrealpic UnrealPicR POST 40 | 41 | /user/#UserId/block BlockR POST 42 | /user/#UserId/unblock UnblockR POST 43 | 44 | /user/#UserId/flag FlagR GET POST 45 | 46 | /user/#UserId/add-identifier AdminAddIdentifierR POST 47 | 48 | /user ByIdentR GET 49 | 50 | /profile/reset-email ResetEmailR POST 51 | /profile/send-verify SendVerifyR POST 52 | /profile/verify/#Text VerifyEmailR GET 53 | 54 | /admin AdminUsersR GET 55 | /admin/messages MessagesR GET 56 | /admin/messages-feed MessagesFeedR GET 57 | /admin/messages-feed/#MessageId MessagesFeedLinkR GET 58 | /admin/messages/#MessageId/close CloseMessageR POST 59 | 60 | /news NewsR GET POST 61 | /news/#NewsId NewsItemR GET 62 | 63 | /debug DebugR GET 64 | 65 | /jobs JobsR GET POST 66 | /jobs/#JobId JobR GET 67 | /jobs/#JobId/close CloseJobR POST 68 | 69 | /feed/news NewsFeedR GET 70 | /feed/jobs JobsFeedR GET 71 | /feed/team/#TeamId TeamFeedR GET 72 | /feed/user/#UserId UserFeedR GET 73 | /feed/team-item/#TeamNewsId TeamNewsR GET 74 | 75 | /teams TeamsR GET POST 76 | /teams/#TeamId TeamR GET POST 77 | /teams/#TeamId/leave LeaveTeamR POST 78 | /teams/#TeamId/watch WatchTeamR POST 79 | /teams/#TeamId/join JoinTeamR POST 80 | /teams/#TeamId/approve/#UserId ApproveTeamR POST 81 | /teams/#TeamId/admin/#UserId TeamAdminR POST 82 | /teams/#TeamId/unadmin/#UserId TeamUnadminR POST 83 | /teams/#TeamId/packages TeamPackagesR POST 84 | /teams/#TeamId/packages/#TeamPackageId/delete DeleteTeamPackageR POST 85 | 86 | /teams/#TeamId/topics TopicsR GET POST 87 | /topics/#TopicId TopicR GET POST 88 | /topics/#TopicId/message TopicMessageR POST 89 | 90 | /bling BlingR GET 91 | 92 | /lang LangR POST 93 | 94 | /poll PollsR GET POST 95 | /poll/#PollId PollR GET POST 96 | /poll/#PollId/close PollCloseR POST 97 | 98 | /build-version BuildVersionR GitRev appGitRev 99 | 100 | /privacy PrivacyR GET 101 | -------------------------------------------------------------------------------- /config/settings.yml: -------------------------------------------------------------------------------- 1 | Default: &defaults 2 | host: "*4" # any IPv4 host 3 | port: 3000 4 | copyright: Insert copyright statement here 5 | allowAuthDummy: False 6 | #analytics: UA-YOURCODE 7 | 8 | Development: 9 | <<: *defaults 10 | 11 | Testing: 12 | <<: *defaults 13 | 14 | Staging: 15 | <<: *defaults 16 | 17 | Production: 18 | <<: *defaults 19 | # We want to be sure, auth Dummy is not enabled on production. 20 | allowAuthDummy: False 21 | -------------------------------------------------------------------------------- /messages/en.msg: -------------------------------------------------------------------------------- 1 | # default-layout 2 | TagLine: The meeting place for professional Haskell programmers 3 | Overview: Overview 4 | Groups: Groups 5 | FindAHaskeller: Find a Haskeller 6 | FindAJob: Find a Job 7 | Bling: Bling 8 | FAQ: FAQ 9 | NewsArchive: News Archive 10 | BrowseSkills: Browse Skills 11 | YourProfile: Your Profile 12 | Logout: Logout 13 | Login: Login 14 | WelcomeUser name@Text: Welcome #{name} 15 | IAmAHaskeller: I'm a Haskeller! 16 | LoginWith: Login with 17 | 18 | #teams 19 | ExistingGroups: Existing Special Interest Groups 20 | AddGroupLong: Add new special interest group 21 | AddGroupShort: Add Group 22 | 23 | #polls 24 | Polls: Polls 25 | NoPolls: No polls have been created. 26 | PollAsked time@UTCTime: Asked on #{prettyTime time} 27 | -------------------------------------------------------------------------------- /messages/fr.msg: -------------------------------------------------------------------------------- 1 | # default-layout 2 | TagLine: Le lieu de la rencontre pour programmeurs Haskell professionnels 3 | Overview: Aperçu 4 | Groups: Groupes 5 | FindAHaskeller: Trouver un Haskeller 6 | FindAJob: Trouver un emploi 7 | Bling: Bling 8 | FAQ: FAQ 9 | NewsArchive: Toutes les nouvelles 10 | BrowseSkills: Parcourir compétences 11 | YourProfile: Votre profil 12 | Logout: Déconnexion 13 | Login: Connexion 14 | WelcomeUser name@Text: Bienvenue, #{name} 15 | IAmAHaskeller: Je suis un Haskeller ! 16 | LoginWith: Connexion avec 17 | 18 | #teams 19 | ExistingGroups: Les groupes d'intérêts spéciaux existants 20 | AddGroupLong: Ajouter un nouvelle groupe d'intérêt spécial 21 | AddGroupShort: Ajouter un groupe 22 | 23 | #polls 24 | Polls: Sondages 25 | NoPolls: Aucune sondage n'a été effectué. 26 | PollAsked time@UTCTime: Demandé à #{prettyTime time} 27 | -------------------------------------------------------------------------------- /messages/he.msg: -------------------------------------------------------------------------------- 1 | Groups: קבוצות 2 | WelcomeUser name: ברוך הבא #{name} 3 | -------------------------------------------------------------------------------- /messages/ja.msg: -------------------------------------------------------------------------------- 1 | # default-layout 2 | TagLine: Haskellプロ・プログラマーの出会いの場 3 | Overview: 概要 4 | Groups: グループ 5 | FindAHaskeller: 「Haskeller」を探す 6 | FindAJob: 求人情報 7 | Bling: 商品 8 | FAQ: FAQ 9 | NewsArchive: ニューズ・アーカイブ 10 | BrowseSkills: スキルの一覧 11 | YourProfile: プロファイル 12 | Logout: ログアウト 13 | Login: ログイン 14 | WelcomeUser name@Text: #{name}、ようこそ 15 | IAmAHaskeller: 私は「Haskeller」です！ 16 | LoginWith: サービスでログイン 17 | 18 | #teams 19 | ExistingGroups: グループの一覧 20 | AddGroupLong: 新規グループを作る 21 | AddGroupShort: 新規グループ 22 | -------------------------------------------------------------------------------- /messages/ru.msg: -------------------------------------------------------------------------------- 1 | # default-layout 2 | TagLine: Место встречи профессиональных Хаскель–программистов 3 | Overview: Обзор 4 | Groups: Группы 5 | FindAHaskeller: Найти Хаскелера 6 | FindAJob: Найти работу 7 | Bling: Мишура 8 | FAQ: ЧаВо 9 | NewsArchive: Архив новостей 10 | BrowseSkills: Просмотреть навыки 11 | YourProfile: Ваш профиль 12 | Logout: Выйти 13 | Login: Войти 14 | WelcomeUser name@Text: Добро пожаловать, #{name} 15 | IAmAHaskeller: Я Хаскелер! 16 | LoginWith: Войти с помощью 17 | 18 | #teams 19 | ExistingGroups: Существующие группы по интересам 20 | AddGroupLong: Добавить новую группу по интересам 21 | AddGroupShort: Добавить группу 22 | 23 | #polls 24 | Polls: Опросы 25 | NoPolls: Ни одного опроса не было создано. 26 | PollAsked time@UTCTime: Опрос от #{prettyTime time} 27 | -------------------------------------------------------------------------------- /messages/se.msg: -------------------------------------------------------------------------------- 1 | # default-layout 2 | TagLine: Mötesplatsen för professionella haskellprogrammerare 3 | Overview: Översikt 4 | Groups: Grupper 5 | FindAHaskeller: Hitta en Haskeller 6 | FindAJob: Hitta ett jobb 7 | Bling: Bling 8 | FAQ: FAQ 9 | NewsArchive: Nyhetsarkiv 10 | BrowseSkills: Bläddra bland färdigheter 11 | YourProfile: Din profil 12 | Logout: Logga ut 13 | Login: Logga in 14 | WelcomeUser name@Text: Välkommen #{name} 15 | IAmAHaskeller: Jag är en Haskeller! 16 | LoginWith: Logga in med 17 | 18 | #teams 19 | ExistingGroups: Existerande intressegrupper 20 | AddGroupLong: Lägg till ny intressegrupp 21 | AddGroupShort: Lägg till grupp 22 | 23 | #polls 24 | Polls: Omröstning 25 | NoPolls: Inga omröstningar har skapats 26 | PollAsked time@UTCTime: Frågat den #{prettyTime time} 27 | -------------------------------------------------------------------------------- /messages/ua.msg: -------------------------------------------------------------------------------- 1 | # default-layout 2 | TagLine: Місце зустрічі професійних Haskell-программістів 3 | Overview: Огляд 4 | Groups: Группи 5 | FindAHaskeller: Знайти Haskeller'а 6 | FindAJob: Знайти роботу 7 | Bling: Мішура 8 | FAQ: ЧЗП (Часто Запитувані Питання) 9 | NewsArchive: Архів новин 10 | BrowseSkills: Продивитися навички 11 | YourProfile: Ваш профіль 12 | Logout: Вийти 13 | Login: Увійти 14 | WelcomeUser name@Text: Ласкаво просимо, #{name} 15 | IAmAHaskeller: Я Haskeller! 16 | LoginWith: Увійти за допомогою 17 | 18 | #teams 19 | ExistingGroups: Існуючі групи по інтересах 20 | AddGroupLong: Додати нову групу по інтересах 21 | AddGroupShort: Додати групу 22 | 23 | #polls 24 | Polls: Голосування 25 | NoPolls: Жодного опитування не було створено. 26 | PollAsked time@UTCTime: Опитування від #{prettyTime time} 27 | -------------------------------------------------------------------------------- /package.yaml: -------------------------------------------------------------------------------- 1 | name: haskellers 2 | author: Michael Snoyman 3 | maintainer: Michael Snoyman 4 | license: BSD3 5 | homepage: https://www.haskellers.com/ 6 | github: snoyberg/haskellers 7 | 8 | flags: 9 | library-only: 10 | description: Build for use with "yesod devel" 11 | manual: false 12 | default: false 13 | dev: 14 | description: Turn on development settings, like auto-reload templates. 15 | manual: false 16 | default: false 17 | 18 | default-extensions: 19 | - TemplateHaskell 20 | - QuasiQuotes 21 | - OverloadedStrings 22 | - NoImplicitPrelude 23 | - CPP 24 | - MultiParamTypeClasses 25 | - TypeFamilies 26 | - GADTs 27 | - GeneralizedNewtypeDeriving 28 | - FlexibleContexts 29 | - EmptyDataDecls 30 | - NoMonomorphismRestriction 31 | - ViewPatterns 32 | 33 | dependencies: 34 | - base 35 | - yesod 36 | - yesod-core 37 | - yesod-auth 38 | - yesod-auth-fb 39 | - yesod-auth-oauth2 40 | - yesod-fb 41 | - yesod-static 42 | - yesod-form 43 | - yesod-form-richtext 44 | - yesod-newsfeed 45 | - yesod-test 46 | - clientsession 47 | - bytestring 48 | - text 49 | - persistent 50 | - persistent-postgresql 51 | - template-haskell 52 | - shakespeare 53 | - hjsmin 54 | - monad-control 55 | - wai-extra 56 | - yaml 57 | - http-conduit 58 | - directory 59 | - warp 60 | - blaze-html 61 | - data-default 62 | - time 63 | - transformers 64 | - containers 65 | - old-locale 66 | - stm 67 | - fb 68 | - http-types 69 | - blaze-builder 70 | - text-icu 71 | - random-shuffle 72 | - random 73 | - pureMD5 74 | - utf8-string 75 | - cryptocipher 76 | - base64-bytestring 77 | - mime-mail 78 | - mime-mail-ses 79 | - resourcet 80 | - monad-logger 81 | - aeson 82 | - cipher-aes 83 | - yesod-gitrev 84 | - unordered-containers 85 | - unliftio 86 | 87 | library: 88 | source-dirs: src 89 | when: 90 | - condition: (flag(dev)) || (flag(library-only)) 91 | then: 92 | ghc-options: 93 | - -Wall 94 | - -O0 95 | cpp-options: -DDEVELOPMENT 96 | else: 97 | ghc-options: 98 | - -Wall 99 | - -O2 100 | 101 | executables: 102 | haskellers: 103 | main: main.hs 104 | source-dirs: app 105 | ghc-options: 106 | - -threaded 107 | - -O2 108 | dependencies: 109 | - haskellers 110 | when: 111 | - condition: flag(library-only) 112 | buildable: false 113 | -------------------------------------------------------------------------------- /run.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | set -euo pipefail 4 | 5 | BASE_DIR="./config/db" 6 | 7 | amber write-file --key HASKELLERS_AWS --dest "$BASE_DIR/aws" 8 | amber write-file --key HASKELLERS_FACEBOOK --dest "$BASE_DIR/facebook.yaml" 9 | amber write-file --key HASKELLERS_GOOGLE --dest "$BASE_DIR/google-email.yaml" 10 | amber write-file --key HASKELLERS_POSTGRES --dest "$BASE_DIR/postgresql.yml" 11 | amber write-file --key HASKELLERS_CLIENT_SESSION_BASE64 --dest "$BASE_DIR/client-session-key.base64" 12 | 13 | base64 -d "$BASE_DIR/client-session-key.base64" > "$BASE_DIR/client-session-key.aes" 14 | 15 | /usr/local/bin/haskellers production 16 | -------------------------------------------------------------------------------- /src/Application.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fno-warn-orphans #-} 2 | module Application 3 | ( makeApplication 4 | , getApplicationDev 5 | , makeFoundation 6 | ) where 7 | 8 | import Import 9 | import Settings 10 | import Yesod.Auth 11 | import Yesod.Default.Config 12 | import Yesod.Default.Main 13 | import Yesod.Default.Handlers 14 | import Network.Wai.Middleware.RequestLogger (logStdout, logStdoutDev) 15 | import qualified Database.Persist 16 | import Network.HTTP.Conduit (newManager, tlsManagerSettings) 17 | import Data.IORef 18 | import Control.Monad 19 | import Control.Concurrent 20 | import Database.Persist.Sql 21 | import Data.Maybe 22 | import qualified Data.Set as Set 23 | import Control.Monad.Logger (runNoLoggingT) 24 | import Control.Monad.Trans.Resource (runResourceT) 25 | import System.Environment (lookupEnv) 26 | import System.Timeout 27 | import Network.Mail.Mime.SES 28 | import Data.Text.Encoding (encodeUtf8) 29 | import qualified Data.ByteString.Char8 as S8 30 | import qualified Data.Map as Map 31 | import Control.Exception (throwIO) 32 | import Data.Yaml (decodeFileEither) 33 | import Yesod.GitRev 34 | 35 | -- Import all relevant handler modules here. 36 | -- Don't forget to add new modules to your cabal file! 37 | import Handler.Root 38 | import Handler.Profile 39 | import Handler.User 40 | import Handler.Admin 41 | import Handler.Email 42 | import Handler.Skills 43 | import Handler.Package 44 | import Handler.Faq 45 | import Handler.Privacy 46 | import Handler.News 47 | import Handler.Job 48 | import Handler.Team 49 | import Handler.Topic 50 | import Handler.Bling 51 | import Handler.Poll 52 | 53 | -- This line actually creates our YesodSite instance. It is the second half 54 | -- of the call to mkYesodData which occurs in Foundation.hs. Please see 55 | -- the comments there for more details. 56 | mkYesodDispatch "App" resourcesApp 57 | 58 | -- This function allocates resources (such as a database connection pool), 59 | -- performs initialization and creates a WAI application. This is also the 60 | -- place to put your migrate statements to have automatic database 61 | -- migrations handled by Yesod. 62 | makeApplication :: AppConfig DefaultEnv Extra -> IO Application 63 | makeApplication conf = do 64 | foundation <- makeFoundation conf 65 | app <- toWaiApp foundation 66 | return $ logWare app 67 | where 68 | logWare = if development then logStdoutDev 69 | else logStdout 70 | 71 | makeFoundation :: AppConfig DefaultEnv Extra -> IO App 72 | makeFoundation conf = do 73 | manager <- newManager tlsManagerSettings 74 | s <- staticSite 75 | dbconf <- withYamlEnvironment "config/db/postgresql.yml" (appEnv conf) 76 | Database.Persist.loadConfig >>= 77 | Database.Persist.applyEnv 78 | p <- Database.Persist.createPoolConfig (dbconf :: Settings.PersistConfig) 79 | --runNoLoggingT $ Database.Persist.runPool dbconf (runMigration migrateAll) p 80 | 81 | hprofs <- newIORef ([], 0) 82 | pprofs <- newIORef [] 83 | if production 84 | then do 85 | _ <- forkIO $ forever $ do 86 | _ <- forkIO $ do 87 | _ <- timeout (1000 * 1000 * 60 * 2) $ fillProfs p hprofs pprofs 88 | return () 89 | threadDelay (1000 * 1000 * 60 * 10) 90 | return () 91 | else fillProfs p hprofs pprofs 92 | 93 | maccess <- lookupEnv "AWS_ACCESS_KEY" 94 | msecret <- lookupEnv "AWS_SECRET_KEY" 95 | (access, secret) <- 96 | case (,) <$> maccess <*> msecret of 97 | Just pair -> return pair 98 | Nothing -> do 99 | m <- decodeFileEither "config/db/aws" >>= either throwIO return 100 | case (,) <$> Map.lookup "access" m <*> Map.lookup ("secret" :: Text) m of 101 | Just pair -> return pair 102 | Nothing -> error $ "Invalid config/db/aws: " ++ show m 103 | 104 | googleEmailCreds <- do 105 | m <- decodeFileEither "config/db/google-email.yaml" >>= either throwIO return 106 | case (,) <$> Map.lookup "client-id" m <*> Map.lookup ("client-secret" :: Text) m of 107 | Just pair -> return pair 108 | Nothing -> error $ "Invalid config/db/google-email.yaml: " ++ show m 109 | 110 | facebookCreds <- do 111 | m <- decodeFileEither "config/db/facebook.yaml" >>= either throwIO return 112 | case (,,) 113 | <$> Map.lookup ("name" :: Text) m 114 | <*> Map.lookup "id" m 115 | <*> Map.lookup "secret" m of 116 | Just x -> return x 117 | Nothing -> error $ "Invalid config/db/facebook.yaml: " ++ show m 118 | 119 | return $ App 120 | { settings = conf 121 | , getStatic = s 122 | , connPool = p 123 | , httpManager = manager 124 | , persistConfig = dbconf 125 | , homepageProfiles = hprofs 126 | , publicProfiles = pprofs 127 | , sesCreds = \email -> SES 128 | { sesFrom = "webmaster@haskellers.com" 129 | , sesTo = [encodeUtf8 email] 130 | , sesAccessKey = S8.pack access 131 | , sesSecretKey = S8.pack secret 132 | , sesRegion = usEast1 133 | , sesSessionToken = Nothing 134 | } 135 | , appGoogleEmailCreds = googleEmailCreds 136 | , appFacebookCreds = facebookCreds 137 | , appGitRev = $gitRev 138 | } 139 | 140 | -- for yesod devel 141 | getApplicationDev :: IO (Int, Application) 142 | getApplicationDev = 143 | defaultDevelApp loader makeApplication 144 | where 145 | loader = Yesod.Default.Config.loadConfig (configSettings Development) 146 | { csParseExtra = parseExtra 147 | } 148 | 149 | getHomepageProfs :: ConnectionPool -> IO [Profile] 150 | getHomepageProfs pool = runNoLoggingT $ runResourceT $ flip runSqlPool pool $ do 151 | users <- 152 | selectList [ UserVerifiedEmail ==. True 153 | , UserVisible ==. True 154 | , UserReal ==. True 155 | , UserBlocked ==. False 156 | -- FIXME , UserRealPicEq True 157 | ] [] 158 | fmap catMaybes $ mapM userToProfile users 159 | 160 | getPublicProfs :: ConnectionPool -> IO [Profile] 161 | getPublicProfs pool = runNoLoggingT $ runResourceT $ flip runSqlPool pool $ do 162 | users <- 163 | selectList [ UserVerifiedEmail ==. True 164 | , UserVisible ==. True 165 | , UserBlocked ==. False 166 | ] 167 | [ Desc UserReal 168 | , Asc UserHaskellSince 169 | , Asc UserFullName 170 | ] 171 | fmap catMaybes $ mapM userToProfile users 172 | 173 | fillProfs :: ConnectionPool -> IORef ([Profile], Int) -> IORef [Profile] -> IO () 174 | fillProfs pool hprofs pprofs = do 175 | hprofs' <- getHomepageProfs pool 176 | pprofs' <- getPublicProfs pool 177 | writeIORef hprofs (hprofs', length hprofs') 178 | writeIORef pprofs pprofs' 179 | 180 | userToProfile :: (MonadLogger m, MonadResource m) => Entity User -> SqlPersistT m (Maybe Profile) 181 | userToProfile (Entity uid u) = 182 | case userEmail u of 183 | Nothing -> return Nothing 184 | Just e -> do 185 | mun <- fmap (fmap entityVal) $ getBy $ UniqueUsernameUser uid 186 | return $ Just Profile 187 | { profileUserId = uid 188 | , profileName = userFullName u 189 | , profileEmail = e 190 | , profileUser = u 191 | , profileSkills = Set.fromList [] -- FIXME 192 | , profileUsername = mun 193 | , profileLocation = Location <$> userLongitude u <*> userLatitude u 194 | } 195 | -------------------------------------------------------------------------------- /src/Handler/Admin.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE QuasiQuotes, OverloadedStrings, TemplateHaskell #-} 2 | {-# LANGUAGE CPP #-} 3 | module Handler.Admin 4 | ( postAdminR 5 | , postUnadminR 6 | , postRealR 7 | , postUnrealR 8 | , postRealPicR 9 | , postUnrealPicR 10 | , postBlockR 11 | , postUnblockR 12 | , getMessagesR 13 | , getMessagesFeedR 14 | , getMessagesFeedLinkR 15 | , postCloseMessageR 16 | , getAdminUsersR 17 | , postAdminAddIdentifierR 18 | , requireAdmin 19 | ) where 20 | 21 | import Import 22 | import Control.Monad (unless) 23 | import Handler.User (adminControls) -- FIXME includes style too many times 24 | import Handler.Root (gravatar) 25 | import Yesod.Form.Jquery (urlJqueryJs) 26 | import Yesod.Feed 27 | import Data.Time (getCurrentTime) 28 | 29 | requireAdmin :: Handler () 30 | requireAdmin = do 31 | Entity _ admin <- requireAuth 32 | unless (userAdmin admin) $ permissionDenied "You are not an admin" 33 | 34 | adminHelper :: EntityField User Bool -> Bool -> Html -> UserId -> Handler () 35 | adminHelper constr bool msg uid = do 36 | requireAdmin 37 | u <- runDB $ get404 uid 38 | runDB $ update uid [constr =. bool] 39 | setMessage msg 40 | redirect $ userR ((uid, u), Nothing) 41 | 42 | postAdminR :: UserId -> Handler () 43 | postAdminR = adminHelper UserAdmin True "User is now an admin" 44 | 45 | postUnadminR :: UserId -> Handler () 46 | postUnadminR = adminHelper UserAdmin False "User is no longer an admin" 47 | 48 | postRealR :: UserId -> Handler () 49 | postRealR = adminHelper UserReal True "User now has verified user status" 50 | 51 | postUnrealR :: UserId -> Handler () 52 | postUnrealR = adminHelper UserReal False "User no longer has verified user status" 53 | 54 | postRealPicR :: UserId -> Handler () 55 | postRealPicR = adminHelper UserRealPic True "User now has real picture status" 56 | 57 | postUnrealPicR :: UserId -> Handler () 58 | postUnrealPicR = adminHelper UserRealPic False "User no longer has real picture status" 59 | 60 | postBlockR :: UserId -> Handler () 61 | postBlockR = adminHelper UserBlocked True "User has been blocked" 62 | 63 | postUnblockR :: UserId -> Handler () 64 | postUnblockR = adminHelper UserBlocked False "User has been unblocked" 65 | 66 | getMessagesR :: Handler Html 67 | getMessagesR = do 68 | requireAdmin 69 | messages <- runDB $ selectList [MessageClosed ==. False] [Asc MessageWhen] >>= mapM (\(Entity mid m) -> do 70 | let go uid = do 71 | u <- get404 uid 72 | return $ Just (uid, u) 73 | from <- maybe (return Nothing) go $ messageFrom m 74 | regarding <- maybe (return Nothing) go $ messageRegarding m 75 | return ((mid, m), (from, regarding)) 76 | ) 77 | defaultLayout $ do 78 | setTitle "Admin Messages" 79 | $(widgetFile "messages") 80 | 81 | getMessagesFeedR :: Handler TypedContent 82 | getMessagesFeedR = do 83 | messages <- runDB $ selectList [MessageClosed ==. False] [Desc MessageWhen, LimitTo 10] 84 | updated <- 85 | case messages of 86 | [] -> liftIO getCurrentTime 87 | Entity _ m:_ -> return $ messageWhen m 88 | 89 | newsFeed Feed 90 | { feedTitle = "Haskellers admin messages" 91 | , feedLinkSelf = MessagesFeedR 92 | , feedLinkHome = RootR 93 | , feedAuthor = "Michael Snoyman" 94 | , feedDescription = "Admin messages for Haskellers.com" 95 | , feedLanguage = "en" 96 | , feedUpdated = updated 97 | , feedEntries = map toEntry messages 98 | , feedLogo = Nothing 99 | } 100 | where 101 | toEntry (Entity mid m) = FeedEntry 102 | { feedEntryLink = MessagesFeedLinkR mid 103 | , feedEntryUpdated = messageWhen m 104 | , feedEntryTitle = "Some message" 105 | , feedEntryContent = "Some message" 106 | , feedEntryEnclosure = Nothing 107 | } 108 | 109 | getMessagesFeedLinkR :: MessageId -> Handler () 110 | getMessagesFeedLinkR _ = redirect MessagesR 111 | 112 | postCloseMessageR :: MessageId -> Handler () 113 | postCloseMessageR mid = do 114 | requireAdmin 115 | runDB $ update mid [MessageClosed =. True] 116 | setMessage "Message has been closed" 117 | redirect MessagesR 118 | 119 | getAdminUsersR :: Handler Html 120 | getAdminUsersR = do 121 | requireAdmin 122 | users <- runDB $ selectList [UserVerifiedEmail ==. True] [Asc UserFullName] 123 | y <- getYesod 124 | defaultLayout $ do 125 | setTitle "Admin list of users" 126 | addScriptEither $ urlJqueryJs y 127 | $(widgetFile "admin-users") 128 | 129 | postAdminAddIdentifierR :: UserId -> Handler () 130 | postAdminAddIdentifierR uid = do 131 | requireAdmin 132 | u <- runDB $ get404 uid 133 | mident <- lookupPostParam "identifier" 134 | case mident of 135 | Nothing -> setMessage "No identifier provided" 136 | Just ident -> do 137 | res <- runDB $ insertBy Ident 138 | { identIdent = ident 139 | , identUser = uid 140 | } 141 | case res of 142 | Left _ -> setMessage "Duplicate key already exists" 143 | Right _ -> setMessage "Identifier added successfully" 144 | redirect $ userR ((uid, u), Nothing) 145 | -------------------------------------------------------------------------------- /src/Handler/Bling.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-} 2 | module Handler.Bling 3 | ( getBlingR 4 | ) where 5 | 6 | import Import 7 | 8 | getBlingR :: Handler Html 9 | getBlingR = defaultLayout $ do 10 | setTitle "Haskell Bling" 11 | $(widgetFile "bling") 12 | -------------------------------------------------------------------------------- /src/Handler/Email.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, OverloadedStrings, QuasiQuotes #-} 2 | {-# LANGUAGE CPP #-} 3 | module Handler.Email 4 | ( postResetEmailR 5 | , postSendVerifyR 6 | , getVerifyEmailR 7 | ) where 8 | 9 | import Import 10 | import Control.Monad (when) 11 | import Network.Mail.Mime 12 | import Network.Mail.Mime.SES 13 | import System.Random (newStdGen) 14 | import Data.Maybe (isJust) 15 | import qualified Data.ByteString.Lazy.UTF8 as LU 16 | import Data.Text (pack, unpack) 17 | import Text.Blaze.Html.Renderer.Utf8 (renderHtml) 18 | import Yesod.Auth (requireAuthId) 19 | 20 | postResetEmailR :: Handler () 21 | postResetEmailR = do 22 | uid <- requireAuthId 23 | runDB $ update uid 24 | [ UserVerifiedEmail =. False 25 | , UserEmail =. Nothing 26 | , UserVerkey =. Nothing 27 | ] 28 | setMessage "Email address reset. Please verify a new address." 29 | redirect ProfileR 30 | 31 | getVerifyEmailR :: Text -> Handler () 32 | getVerifyEmailR verkey = do 33 | Entity uid u <- requireAuth 34 | if Just verkey == userVerkey u && isJust (userEmail u) 35 | then do 36 | runDB $ update uid 37 | [ UserVerifiedEmail =. True 38 | , UserVerkey =. Nothing 39 | ] 40 | setMessage "Your email address has been verified." 41 | else setMessage "Invalid verification key" 42 | redirect ProfileR 43 | 44 | postSendVerifyR :: Handler () 45 | postSendVerifyR = do 46 | Entity uid u <- requireAuth 47 | when (userVerifiedEmail u) $ do 48 | setMessage "You already have a verified email address." 49 | redirect ProfileR 50 | res <- runInputPost $ iopt emailField "email" 51 | case res of 52 | Just email -> do 53 | stdgen <- liftIO newStdGen 54 | let verkey = pack $ fst $ randomString 10 stdgen 55 | runDB $ update uid [ UserEmail =. Just email 56 | , UserVerkey =. Just verkey 57 | ] 58 | render <- getUrlRender 59 | let url = render $ VerifyEmailR verkey 60 | h <- getYesod 61 | let ses = sesCreds h email 62 | renderSendMailSES (httpManager h) ses Mail 63 | { mailHeaders = 64 | [ ("Subject", "Verify your email address") 65 | ] 66 | , mailFrom = Address Nothing "webmaster@haskellers.com" 67 | , mailTo = [Address Nothing email] 68 | , mailCc = [] 69 | , mailBcc = [] 70 | , mailParts = return 71 | [ Part "text/plain" None Nothing [] $ LU.fromString $ unlines 72 | [ "Please go to the URL below to verify your email address." 73 | , "" 74 | , unpack url 75 | ] 76 | , Part "text/html" None Nothing [] $ renderHtml [shamlet|\ 77 | Haskellers 78 |

Please go to the URL below to verify your email address. 79 |

80 | #{url} 81 | |] 82 | ] 83 | } 84 | setMessage "A confirmation link has been sent." 85 | Nothing -> setMessage "You entered an invalid email address." 86 | redirect ProfileR 87 | -------------------------------------------------------------------------------- /src/Handler/Faq.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-} 2 | module Handler.Faq 3 | ( getFaqR 4 | ) where 5 | 6 | import Import 7 | 8 | data Faq = Faq 9 | { hash :: String 10 | , question :: String 11 | , answer :: Html 12 | } 13 | 14 | faqs :: [Faq] 15 | faqs = 16 | [ Faq "purpose" "What's the purpose of this site?" [shamlet|\ 17 |

Haskell has a vibrant, talented community of very capable programmers. This site aims to be the meeting point for these developers. By centralizing, we hope to make it easier for employers to find people to fill positions, and thus give Haskell a lower entrance cost into industry. 18 | |] 19 | , Faq "just-professionals" "I'm just a Haskell hobbyist. Does that mean this site isn't for me?" [shamlet|\ 20 |

While the main purpose of the site is for professionals and industry, there's no reason hobbyists shouldn't join in as well. The secondary mission of this site is to provide social networking. As the site is still young, it's not clear what features will be implemented, but this site will be a great resource for any Haskell programmer. 21 | |] 22 | , Faq "openid" "How do I create an account? What's OpenID?" [shamlet|\ 23 |

Instead of creating a brand new username/password on Haskellers, you can simply log in with OpenID. Most people out there already have an OpenID: Google, Yahoo!, AOL, Wordpress and many others provide them. If you have a Google or Yahoo! account, just click on the appropriate logo and you will be asked to log in automatically. We also support Facebook logins. 24 |

Don't worry, we only use this information to authenticate you. We do not request any personal information from your OpenID provider, nor do we ever see your password. The only information Haskellers gets is what you provide us explicitly. 25 | |] 26 | , Faq "report" "What does reporting a user do, and when should I use it?" [shamlet|\ 27 |

Reporting a user sends a message to the site administrators that a user has been reported. It will also tell us who did the reporting if you are logged in. This is a simple way for you to let us know that there is something inappropriate on a user page. Examples of inappropriate content are: 28 |