subtree(users/wpcarro): docking briefcase at '24f5a642'
git-subtree-dir: users/wpcarro git-subtree-mainline:464bbcb15c
git-subtree-split:24f5a642af
Change-Id: I6105b3762b79126b3488359c95978cadb3efa789
This commit is contained in:
commit
019f8fd211
766 changed files with 175420 additions and 0 deletions
8
users/wpcarro/.envrc
Normal file
8
users/wpcarro/.envrc
Normal file
|
@ -0,0 +1,8 @@
|
|||
export BRIEFCASE="$(realpath .)"
|
||||
# I'm ensuring that $NIX_PATH is mostly empty, so that I only depend on
|
||||
# <briefcase> for now.
|
||||
# For more information on the NIX_PATH anti-pattern, see here:
|
||||
# https://nix.dev/tutorials/towards-reproducibility-pinning-nixpkgs.html#pinning-nixpkgs
|
||||
export NIX_PATH="briefcase=$BRIEFCASE";
|
||||
export DESKTOP="zeno.lon.corp.google.com";
|
||||
export LAPTOP="seneca";
|
31
users/wpcarro/.gitignore
vendored
Normal file
31
users/wpcarro/.gitignore
vendored
Normal file
|
@ -0,0 +1,31 @@
|
|||
.vim
|
||||
./configs/secrets
|
||||
**/*/.emacs.d/quelpa/**/*
|
||||
**/*/.emacs.d/elpa/**/*
|
||||
**/*/.emacs.d/emojis
|
||||
**/*/.emacs.d/auto-save-list/**/*
|
||||
**/*/.emacs.d/eshell/
|
||||
**/*/.emacs.d/var/**/*
|
||||
**/*/.emacs.d/.cache/**/*
|
||||
**/*/.emacs.d/request
|
||||
**/*/.emacs.d/network-security.data
|
||||
**/*/.emacs.d/smex-items
|
||||
**/*/.gnupg/random_seed
|
||||
.netrwhist
|
||||
Vundle.vim
|
||||
**/*/.emacs.d/custom.el
|
||||
**/*/.emacs.d/projectile-bookmarks.eld
|
||||
**/*/.emacs.d/bookmarks
|
||||
**/*/transient/history.el
|
||||
*.hi
|
||||
*.o
|
||||
__pycache__
|
||||
*.class
|
||||
node_modules/
|
||||
/configs/.config/fish/config.fish
|
||||
/configs/.config/fish/fish_variables
|
||||
/website/blog/public/
|
||||
/emacs/.emacs.d/tramp
|
||||
.gitsecret/keys/random_seed
|
||||
!*.secret
|
||||
secrets.json
|
BIN
users/wpcarro/.gitsecret/keys/pubring.kbx
Normal file
BIN
users/wpcarro/.gitsecret/keys/pubring.kbx
Normal file
Binary file not shown.
BIN
users/wpcarro/.gitsecret/keys/pubring.kbx~
Normal file
BIN
users/wpcarro/.gitsecret/keys/pubring.kbx~
Normal file
Binary file not shown.
BIN
users/wpcarro/.gitsecret/keys/trustdb.gpg
Normal file
BIN
users/wpcarro/.gitsecret/keys/trustdb.gpg
Normal file
Binary file not shown.
1
users/wpcarro/.gitsecret/paths/mapping.cfg
Normal file
1
users/wpcarro/.gitsecret/paths/mapping.cfg
Normal file
|
@ -0,0 +1 @@
|
|||
secrets.json:7d596a3ed16403040d89dd7e033a2af58e7aaabb6f246f44751b80a1863a2949
|
2
users/wpcarro/.skip-subtree
Normal file
2
users/wpcarro/.skip-subtree
Normal file
|
@ -0,0 +1,2 @@
|
|||
Do not recurse from top-level readTree, while this is being refactored
|
||||
we have a nested tree.
|
9
users/wpcarro/Makefile
Normal file
9
users/wpcarro/Makefile
Normal file
|
@ -0,0 +1,9 @@
|
|||
install:
|
||||
source "${BRIEFCASE}/configs/install"
|
||||
|
||||
uninstall:
|
||||
source "${BRIEFCASE}/configs/uninstall"
|
||||
|
||||
list-broken-links:
|
||||
find "${HOME}" -maxdepth 1 -xtype l && \
|
||||
find "${HOME}/.config" -maxdepth 1 -xtype l
|
70
users/wpcarro/README.md
Normal file
70
users/wpcarro/README.md
Normal file
|
@ -0,0 +1,70 @@
|
|||
# briefcase
|
||||
|
||||
[![Build status](https://badge.buildkite.com/aa0d413bfeedcafd8719f977eadd40e04d0b5334fc7f58e8ee.svg)](https://buildkite.com/wpcarros-infrastructure/post-receive)
|
||||
|
||||
Welcome to my monorepo: briefcase.
|
||||
|
||||
Herein you will find a variety of libraries, packages, and documents. Some of
|
||||
this work in finished and other work is incomplete or just a sketch for a
|
||||
future project.
|
||||
|
||||
Where applicable, I try to include `README.md` files in some of the
|
||||
subdirectories to help orient both myself and any onlookers.
|
||||
|
||||
## Languages
|
||||
|
||||
To give you a general idea of the source code inside of this monorepo, here is
|
||||
the latest output from `tokei --hidden --sort code .`:
|
||||
|
||||
```text
|
||||
-------------------------------------------------------------------------------
|
||||
Language Files Lines Code Comments Blanks
|
||||
-------------------------------------------------------------------------------
|
||||
Emacs Lisp 81 22267 13847 5661 2759
|
||||
Python 177 10575 7930 885 1760
|
||||
Elm 34 5345 4277 219 849
|
||||
Haskell 50 4263 3111 428 724
|
||||
Nix 66 1581 1379 66 136
|
||||
TypeScript 19 1345 1067 90 188
|
||||
Go 17 1256 926 173 157
|
||||
Vim Script 2 766 470 87 209
|
||||
Elixir 13 358 301 8 49
|
||||
JavaScript 9 77 73 0 4
|
||||
Lisp 3 83 43 23 17
|
||||
Shell 3 55 30 11 14
|
||||
Clojure 2 10 8 0 2
|
||||
C 1 6 5 0 1
|
||||
Rust 1 5 3 1 1
|
||||
-------------------------------------------------------------------------------
|
||||
Total 478 47992 33470 7652 6870
|
||||
-------------------------------------------------------------------------------
|
||||
```
|
||||
|
||||
## Sign posts
|
||||
|
||||
Below I have outlined a few projects that you might find interesting. I am
|
||||
using `//` to indicate the root of my monorepo, the directory in which this
|
||||
`README.md` resides.
|
||||
|
||||
- `//boilerplate`: scaffolding for projects. Boilerplate's goal is to
|
||||
reduce the startup costs of a project.
|
||||
- `//configs`: my dotfiles (e.g. `config.fish`, `init.vim`).
|
||||
- `//emacs`: Emacs is both my preferred text editor and my window manager; with
|
||||
tens of thousands of lines of Emacs Lisp, you can safely assume that this
|
||||
directory hosts a lot of libraries and packages.
|
||||
- `//monzo_ynab`: `systemd` timer unit that imports my Monzo (i.e. a U.K.-based
|
||||
online bank) transactions into the personal finance tool YNAB (i.e.
|
||||
youneedabudget.com).
|
||||
- `//nixos`: my declarative configuration for my NixOS machines. If you are
|
||||
unfamiliar with Nix, I recommend reading about the NixOS project.
|
||||
- `//tools`: some scripts and projects that simplify my life.
|
||||
- `//website`: everything required to build my website, wpcarro.dev.
|
||||
|
||||
## Notes to self
|
||||
|
||||
Here are a few reminders when setting up a new machine:
|
||||
|
||||
- Ensure `~/.password-store` exists.
|
||||
- Run `export_gpg` from a computer with my gpg credentials. Run `import_gpg`
|
||||
from the new machine.
|
||||
- Ensure the new machine can access my Github.
|
2
users/wpcarro/assessments/brilliant/.ghci
Normal file
2
users/wpcarro/assessments/brilliant/.ghci
Normal file
|
@ -0,0 +1,2 @@
|
|||
:set prompt "> "
|
||||
:set -Wall
|
41
users/wpcarro/assessments/brilliant/App.hs
Normal file
41
users/wpcarro/assessments/brilliant/App.hs
Normal file
|
@ -0,0 +1,41 @@
|
|||
--------------------------------------------------------------------------------
|
||||
module App where
|
||||
--------------------------------------------------------------------------------
|
||||
import Keyboard (Keyboard(..))
|
||||
import Transforms (Transform(..))
|
||||
import Utils ((|>))
|
||||
|
||||
import qualified Data.Char as Char
|
||||
import qualified Utils
|
||||
import qualified Data.List.Split as Split
|
||||
import qualified Keyboard
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
transform :: Keyboard -> Transform -> Keyboard
|
||||
|
||||
transform (Keyboard xs) xform =
|
||||
case xform of
|
||||
HorizontalFlip ->
|
||||
xs
|
||||
|> fmap reverse
|
||||
|> Keyboard
|
||||
|
||||
VerticalFlip ->
|
||||
xs
|
||||
|> reverse
|
||||
|> Keyboard
|
||||
|
||||
Shift n ->
|
||||
xs
|
||||
|> concat
|
||||
|> Utils.rotate n
|
||||
|> Split.chunksOf 10
|
||||
|> Keyboard
|
||||
|
||||
retypePassage :: String -> Keyboard -> Maybe String
|
||||
retypePassage passage newKeyboard =
|
||||
passage
|
||||
|> fmap Char.toUpper
|
||||
|> traverse (\c -> HM.lookup c Keyboard.charToCoord)
|
||||
>>= traverse (Keyboard.coordToChar newKeyboard)
|
58
users/wpcarro/assessments/brilliant/Keyboard.hs
Normal file
58
users/wpcarro/assessments/brilliant/Keyboard.hs
Normal file
|
@ -0,0 +1,58 @@
|
|||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
--------------------------------------------------------------------------------
|
||||
module Keyboard where
|
||||
--------------------------------------------------------------------------------
|
||||
import Utils
|
||||
import Data.Coerce
|
||||
import Data.Hashable (Hashable)
|
||||
import GHC.Generics (Generic)
|
||||
|
||||
import qualified Data.List as List
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
newtype Keyboard = Keyboard [[Char]]
|
||||
deriving (Eq)
|
||||
|
||||
instance Show Keyboard where
|
||||
show (Keyboard xxs) =
|
||||
xxs |> fmap printRow |> List.intercalate "\n"
|
||||
where
|
||||
printRow :: [Char] -> String
|
||||
printRow xs =
|
||||
xs |> fmap (\x -> '[':x:']':"") |> List.intercalate ""
|
||||
|
||||
data Coord = Coord
|
||||
{ row :: Int
|
||||
, col :: Int
|
||||
} deriving (Eq, Show, Generic)
|
||||
|
||||
instance Hashable Coord
|
||||
|
||||
-- | List of characters to their QWERTY coordinatees.
|
||||
coords :: [(Char, Coord)]
|
||||
coords =
|
||||
qwerty
|
||||
|> coerce
|
||||
|> fmap (zip [0..])
|
||||
|> zip [0..]
|
||||
|> fmap (\(row, xs) -> xs |> fmap (\(col, char) -> (char, Coord row col)))
|
||||
|> mconcat
|
||||
|
||||
-- | Mapping of characters to their coordinates on a QWERTY keyboard with the
|
||||
-- top-left corner as 0,0.
|
||||
charToCoord :: HM.HashMap Char Coord
|
||||
charToCoord = HM.fromList coords
|
||||
|
||||
coordToChar :: Keyboard -> Coord -> Maybe Char
|
||||
coordToChar (Keyboard xxs) Coord{..} =
|
||||
Just $ xxs !! row !! col
|
||||
|
||||
qwerty :: Keyboard
|
||||
qwerty = Keyboard [ ['1','2','3','4','5','6','7','8','9','0']
|
||||
, ['Q','W','E','R','T','Y','U','I','O','P']
|
||||
, ['A','S','D','F','G','H','J','K','L',';']
|
||||
, ['Z','X','C','V','B','N','M',',','.','/']
|
||||
]
|
43
users/wpcarro/assessments/brilliant/Main.hs
Normal file
43
users/wpcarro/assessments/brilliant/Main.hs
Normal file
|
@ -0,0 +1,43 @@
|
|||
{-# LANGUAGE RecordWildCards #-}
|
||||
--------------------------------------------------------------------------------
|
||||
module Main where
|
||||
--------------------------------------------------------------------------------
|
||||
import Options.Applicative
|
||||
import Data.Semigroup ((<>))
|
||||
|
||||
import qualified Transforms
|
||||
import qualified Keyboard
|
||||
import qualified App
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
data CommandArgs = CommandArgs
|
||||
{ transforms :: String
|
||||
, passage :: String
|
||||
} deriving (Eq, Show)
|
||||
|
||||
parseArgs :: Parser CommandArgs
|
||||
parseArgs =
|
||||
CommandArgs <$> strOption
|
||||
( long "transforms"
|
||||
<> short 't'
|
||||
<> help "String of transforms where (e.g. \"HHVS12VHVHS3\")" )
|
||||
<*> strOption
|
||||
( long "passage"
|
||||
<> short 'p'
|
||||
<> help "Input text to re-type" )
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
CommandArgs{..} <- execParser opts
|
||||
case Transforms.fromString transforms of
|
||||
Nothing -> putStrLn "You must provide valid input (e.g. \"HHVS12VHVHS3\")"
|
||||
Just xs -> do
|
||||
let keyboard = foldl App.transform Keyboard.qwerty (Transforms.optimize xs)
|
||||
putStrLn $ "Typing: \"" ++ passage ++ "\"\nOn this keyboard:\n" ++ show keyboard
|
||||
case App.retypePassage passage keyboard of
|
||||
Nothing -> putStrLn $ "Looks like at least one of the characters in your input passage doesn't fit on our QWERTY keyboard: \n" ++ show Keyboard.qwerty
|
||||
Just result -> putStrLn $ "Result: " ++ result
|
||||
where
|
||||
opts = info (parseArgs <**> helper)
|
||||
( fullDesc
|
||||
<> progDesc "Transform a QWERTY keyboard using a string of commands")
|
82
users/wpcarro/assessments/brilliant/README.md
Normal file
82
users/wpcarro/assessments/brilliant/README.md
Normal file
|
@ -0,0 +1,82 @@
|
|||
# Transform QWERTY
|
||||
|
||||
Apply a series of transforms to a QWERTY keyboard then use the new keyboard to
|
||||
re-type a passage of text.
|
||||
|
||||
## Environment
|
||||
|
||||
You will need [Nix][nix] to build this program on your machine. The good news is
|
||||
that you won't need any Haskell-specific dependencies like `ghc`, `cabal`, or
|
||||
`stack`: just Nix.
|
||||
|
||||
Once you have Nix installed, to build the program, run the following from this
|
||||
project's top-level directory:
|
||||
|
||||
```shell
|
||||
$ nix-build
|
||||
```
|
||||
|
||||
This should output an executable named `transform-keyboard` within a `result`
|
||||
directory:
|
||||
|
||||
```shell
|
||||
$ tree result
|
||||
result
|
||||
└── transform-keyboard
|
||||
```
|
||||
|
||||
### Testing
|
||||
|
||||
To run the test suite, run the following from the project's top-level directory:
|
||||
|
||||
```shell
|
||||
$ nix-shell
|
||||
$ runhaskell Spec.hs
|
||||
```
|
||||
|
||||
[nix]: https://nixos.org/download.html
|
||||
|
||||
## Usage
|
||||
|
||||
Here are some `--help` and usage examples:
|
||||
|
||||
```shell
|
||||
$ ./result/transform-keyboard --help
|
||||
Usage: transform-keyboard (-t|--transforms ARG) (-p|--passage ARG)
|
||||
Transform a QWERTY keyboard using a string of commands
|
||||
|
||||
Available options:
|
||||
-t,--transforms ARG String of transforms where (e.g. "HHVS12VHVHS3")
|
||||
-p,--passage ARG Input text to re-type
|
||||
-h,--help Show this help text
|
||||
```
|
||||
|
||||
Now a working example:
|
||||
|
||||
```shell
|
||||
$ ./result/transform-keyboard --transforms=HHVS12VHVHS3 --passage='Hello,Brilliant.'
|
||||
Typing: "Hello,Brilliant."
|
||||
On this keyboard:
|
||||
[H][J][K][L][;][Q][W][E][R][T]
|
||||
[Y][U][I][O][P][1][2][3][4][5]
|
||||
[6][7][8][9][0][Z][X][C][V][B]
|
||||
[N][M][,][.][/][A][S][D][F][G]
|
||||
Result: ZIVV4D/O3VV36APF
|
||||
```
|
||||
|
||||
...and an example with an erroneous input (i.e. `!`):
|
||||
|
||||
```shell
|
||||
$ ./result/transform-keyboard --transforms=HHVS12VHVHS3 --passage='Hello,Brilliant!'
|
||||
Typing: "Hello,Brilliant!"
|
||||
On this keyboard:
|
||||
[H][J][K][L][;][Q][W][E][R][T]
|
||||
[Y][U][I][O][P][1][2][3][4][5]
|
||||
[6][7][8][9][0][Z][X][C][V][B]
|
||||
[N][M][,][.][/][A][S][D][F][G]
|
||||
Looks like at least one of the characters in your input passage doesn't fit on our QWERTY keyboard:
|
||||
[1][2][3][4][5][6][7][8][9][0]
|
||||
[Q][W][E][R][T][Y][U][I][O][P]
|
||||
[A][S][D][F][G][H][J][K][L][;]
|
||||
[Z][X][C][V][B][N][M][,][.][/]
|
||||
```
|
103
users/wpcarro/assessments/brilliant/Spec.hs
Normal file
103
users/wpcarro/assessments/brilliant/Spec.hs
Normal file
|
@ -0,0 +1,103 @@
|
|||
--------------------------------------------------------------------------------
|
||||
module Spec where
|
||||
--------------------------------------------------------------------------------
|
||||
import Test.Hspec
|
||||
import Test.QuickCheck
|
||||
import Keyboard (Keyboard(..))
|
||||
import Transforms (Transform(..))
|
||||
import Data.Coerce
|
||||
import Utils
|
||||
|
||||
import qualified App
|
||||
import qualified Keyboard
|
||||
import qualified Transforms
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
main :: IO ()
|
||||
main = hspec $ do
|
||||
describe "Keyboard.print" $ do
|
||||
it "pretty-prints the keyboard" $ do
|
||||
show Keyboard.qwerty == "[1][2][3][4][5][6][7][8][9][0]\n[Q][W][E][R][T][Y][U][I][O][P]\n[A][S][D][F][G][H][J][K][L][;]\n[Z][X][C][V][B][N][M][,][.][/]"
|
||||
|
||||
describe "Transforms.fromString" $ do
|
||||
it "successfully parses a string of commands" $ do
|
||||
Transforms.fromString "HHVS-12VHVHS3" ==
|
||||
Just [ HorizontalFlip
|
||||
, HorizontalFlip
|
||||
, VerticalFlip
|
||||
, Shift (-12)
|
||||
, VerticalFlip
|
||||
, HorizontalFlip
|
||||
, VerticalFlip
|
||||
, HorizontalFlip
|
||||
, Shift 3
|
||||
]
|
||||
|
||||
it "returns Nothing when the input is invalid" $ do
|
||||
Transforms.fromString "potato" == Nothing
|
||||
|
||||
it "return Nothing when the input is valid except for the end" $ do
|
||||
Transforms.fromString "HVS10potato" == Nothing
|
||||
|
||||
describe "App.transform" $ do
|
||||
it "flips any keyboard horizontally" $ do
|
||||
property $ \first second third fourth ->
|
||||
App.transform (Keyboard [first, second, third, fourth]) HorizontalFlip == do
|
||||
Keyboard [ reverse first
|
||||
, reverse second
|
||||
, reverse third
|
||||
, reverse fourth
|
||||
]
|
||||
|
||||
it "flips any keyboard vertically" $ do
|
||||
property $ \first second third fourth ->
|
||||
App.transform (Keyboard [first, second, third, fourth]) VerticalFlip == do
|
||||
Keyboard $ reverse [first, second, third, fourth]
|
||||
|
||||
it "shifts any keyboard" $ do
|
||||
property $ \first second third fourth n ->
|
||||
App.transform (Keyboard [first, second, third, fourth]) (Shift n)
|
||||
|> (coerce :: Keyboard -> [[Char]])
|
||||
|> concat ==
|
||||
[first, second, third, fourth]
|
||||
|> concat
|
||||
|> Utils.rotate n
|
||||
|
||||
it "flips a QWERTY keyboard horizontally" $ do
|
||||
App.transform Keyboard.qwerty HorizontalFlip == do
|
||||
Keyboard [ ['0','9','8','7','6','5','4','3','2','1']
|
||||
, ['P','O','I','U','Y','T','R','E','W','Q']
|
||||
, [';','L','K','J','H','G','F','D','S','A']
|
||||
, ['/','.',',','M','N','B','V','C','X','Z']
|
||||
]
|
||||
|
||||
it "flips a keyboard vertically" $ do
|
||||
App.transform Keyboard.qwerty VerticalFlip == do
|
||||
Keyboard [ ['Z','X','C','V','B','N','M',',','.','/']
|
||||
, ['A','S','D','F','G','H','J','K','L',';']
|
||||
, ['Q','W','E','R','T','Y','U','I','O','P']
|
||||
, ['1','2','3','4','5','6','7','8','9','0']
|
||||
]
|
||||
|
||||
it "shifts a keyboard left N times" $ do
|
||||
App.transform Keyboard.qwerty (Shift 2) == do
|
||||
Keyboard [ ['3','4','5','6','7','8','9','0','Q','W']
|
||||
, ['E','R','T','Y','U','I','O','P','A','S']
|
||||
, ['D','F','G','H','J','K','L',';','Z','X']
|
||||
, ['C','V','B','N','M',',','.','/','1','2']
|
||||
]
|
||||
|
||||
it "shifts right negative amounts" $ do
|
||||
App.transform Keyboard.qwerty (Shift (-3)) == do
|
||||
Keyboard [ [',','.','/','1','2','3','4','5','6','7']
|
||||
, ['8','9','0','Q','W','E','R','T','Y','U']
|
||||
, ['I','O','P','A','S','D','F','G','H','J']
|
||||
, ['K','L',';','Z','X','C','V','B','N','M']
|
||||
]
|
||||
|
||||
describe "Transforms.optimize" $ do
|
||||
it "removes superfluous horizontal transformations" $ do
|
||||
Transforms.optimize [HorizontalFlip, HorizontalFlip] == []
|
||||
|
||||
it "removes superfluous vertical transformations" $ do
|
||||
Transforms.optimize [VerticalFlip, VerticalFlip] == []
|
52
users/wpcarro/assessments/brilliant/Transforms.hs
Normal file
52
users/wpcarro/assessments/brilliant/Transforms.hs
Normal file
|
@ -0,0 +1,52 @@
|
|||
--------------------------------------------------------------------------------
|
||||
module Transforms where
|
||||
--------------------------------------------------------------------------------
|
||||
import Control.Applicative ((<|>))
|
||||
import Text.ParserCombinators.ReadP
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
data Transform = VerticalFlip
|
||||
| HorizontalFlip
|
||||
| Shift Int
|
||||
deriving (Eq, Show)
|
||||
|
||||
digit :: ReadP Char
|
||||
digit =
|
||||
satisfy (\c -> c >= '0' && c <= '9')
|
||||
|
||||
command :: ReadP Transform
|
||||
command = vertical
|
||||
<|> horizontal
|
||||
<|> shift
|
||||
where
|
||||
vertical =
|
||||
char 'V' >> pure VerticalFlip
|
||||
|
||||
horizontal =
|
||||
char 'H' >> pure HorizontalFlip
|
||||
|
||||
shift = do
|
||||
_ <- char 'S'
|
||||
negative <- option Nothing $ fmap Just (satisfy (== '-'))
|
||||
n <- read <$> many1 digit
|
||||
case negative of
|
||||
Nothing -> pure $ Shift n
|
||||
Just _ -> pure $ Shift (-1 * n)
|
||||
|
||||
-- | Attempt to remove redundant transformations.
|
||||
-- | Here are some rules that I'd like to support but may not have time for:
|
||||
-- | - All even-numbered flips (w/o intermittent shifts) can become zero
|
||||
-- | - All odd-numbered flips (w/o intermittent shifts) can become 1
|
||||
-- | - All shifts can be be reduce to the absolute value of shifts
|
||||
optimize :: [Transform] -> [Transform]
|
||||
optimize [] = []
|
||||
optimize [x] = [x]
|
||||
optimize (VerticalFlip:VerticalFlip:xs) = optimize xs
|
||||
optimize (HorizontalFlip:HorizontalFlip:xs) = optimize xs
|
||||
optimize xs = xs
|
||||
|
||||
fromString :: String -> Maybe [Transform]
|
||||
fromString x =
|
||||
case readP_to_S (manyTill command eof) x of
|
||||
[(res, "")] -> Just res
|
||||
_ -> Nothing
|
13
users/wpcarro/assessments/brilliant/Utils.hs
Normal file
13
users/wpcarro/assessments/brilliant/Utils.hs
Normal file
|
@ -0,0 +1,13 @@
|
|||
--------------------------------------------------------------------------------
|
||||
module Utils where
|
||||
--------------------------------------------------------------------------------
|
||||
import Data.Function ((&))
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
(|>) :: a -> (a -> b) -> b
|
||||
(|>) = (&)
|
||||
|
||||
-- | Rotate `xs` as a cycle `n` times.
|
||||
rotate :: Int -> [a] -> [a]
|
||||
rotate n xs = take size . drop (n `mod` size) . cycle $ xs
|
||||
where size = length xs
|
16
users/wpcarro/assessments/brilliant/default.nix
Normal file
16
users/wpcarro/assessments/brilliant/default.nix
Normal file
|
@ -0,0 +1,16 @@
|
|||
let
|
||||
briefcase = import <briefcase> {};
|
||||
in briefcase.buildHaskell.program {
|
||||
name = "transform-keyboard";
|
||||
srcs = builtins.path {
|
||||
path = ./.;
|
||||
name = "transform-keyboard-src";
|
||||
};
|
||||
deps = hpkgs: with hpkgs; [
|
||||
optparse-applicative
|
||||
unordered-containers
|
||||
split
|
||||
rio
|
||||
];
|
||||
ghcExtensions = [];
|
||||
}
|
16
users/wpcarro/assessments/brilliant/shell.nix
Normal file
16
users/wpcarro/assessments/brilliant/shell.nix
Normal file
|
@ -0,0 +1,16 @@
|
|||
let
|
||||
pkgs = import (builtins.fetchGit {
|
||||
url = "https://github.com/NixOS/nixpkgs-channels";
|
||||
ref = "nixos-20.03";
|
||||
rev = "afa9ca61924f05aacfe495a7ad0fd84709d236cc";
|
||||
}) {};
|
||||
in pkgs.mkShell {
|
||||
buildInputs = with pkgs; [
|
||||
(haskellPackages.ghcWithPackages (hpkgs: with hpkgs; [
|
||||
hspec
|
||||
optparse-applicative
|
||||
unordered-containers
|
||||
split
|
||||
]))
|
||||
];
|
||||
}
|
2
users/wpcarro/assessments/dotted-squares/.envrc
Normal file
2
users/wpcarro/assessments/dotted-squares/.envrc
Normal file
|
@ -0,0 +1,2 @@
|
|||
source_up
|
||||
use_nix
|
1
users/wpcarro/assessments/dotted-squares/.ghci
Normal file
1
users/wpcarro/assessments/dotted-squares/.ghci
Normal file
|
@ -0,0 +1 @@
|
|||
:set -Wall
|
218
users/wpcarro/assessments/dotted-squares/Main.hs
Normal file
218
users/wpcarro/assessments/dotted-squares/Main.hs
Normal file
|
@ -0,0 +1,218 @@
|
|||
{-# LANGUAGE DeriveGeneric #-}
|
||||
--------------------------------------------------------------------------------
|
||||
module Main where
|
||||
--------------------------------------------------------------------------------
|
||||
import Data.Hashable
|
||||
import Data.Function ((&))
|
||||
import GHC.Generics
|
||||
import Text.ParserCombinators.ReadP
|
||||
import Control.Applicative
|
||||
|
||||
import qualified Data.HashSet as HS
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
data Direction
|
||||
= DirLeft
|
||||
| DirRight
|
||||
| DirUp
|
||||
| DirDown
|
||||
deriving (Eq, Show)
|
||||
|
||||
data Point = Point Int Int
|
||||
deriving (Eq, Show, Ord, Generic)
|
||||
instance Hashable Point
|
||||
|
||||
data Orientation
|
||||
= Horizontal
|
||||
| Vertical
|
||||
deriving (Eq, Show)
|
||||
|
||||
data Anchor
|
||||
= Beg
|
||||
| End
|
||||
deriving (Eq, Show)
|
||||
|
||||
data Rotation
|
||||
= CW
|
||||
| CCW
|
||||
deriving (Eq, Show)
|
||||
|
||||
data Line = Line Point Point
|
||||
deriving (Show, Generic)
|
||||
instance Hashable Line
|
||||
|
||||
instance Eq Line where
|
||||
Line begA endA == Line begB endB =
|
||||
(begA == begB && endA == endB) ||
|
||||
(begA == endB && endA == begB)
|
||||
|
||||
data Game = Game (HS.HashSet Line) [Line]
|
||||
deriving (Eq, Show)
|
||||
|
||||
data Scoreboard = Scoreboard Int Int
|
||||
deriving (Eq)
|
||||
|
||||
instance Semigroup Scoreboard where
|
||||
(Scoreboard a b) <> (Scoreboard x y) =
|
||||
Scoreboard (a + x) (b + y)
|
||||
|
||||
instance Monoid Scoreboard where
|
||||
mempty = Scoreboard 0 0
|
||||
|
||||
data Turn
|
||||
= Player1
|
||||
| Player2
|
||||
deriving (Eq, Show)
|
||||
|
||||
next :: Turn -> Turn
|
||||
next Player1 = Player2
|
||||
next Player2 = Player1
|
||||
|
||||
instance Show Scoreboard where
|
||||
show (Scoreboard p1 p2) =
|
||||
"Player 1: " ++ show (p1) ++ " Player 2: " ++ show (p2)
|
||||
|
||||
digit :: ReadP Char
|
||||
digit = satisfy (\c -> c >= '0' && c <= '9')
|
||||
|
||||
int :: ReadP Int
|
||||
int = read <$> many1 digit
|
||||
|
||||
inputLine :: ReadP String
|
||||
inputLine = manyTill get (char '\n')
|
||||
|
||||
direction :: ReadP Direction
|
||||
direction = do
|
||||
c <- char 'L' <|> char 'R' <|> char 'U' <|> char 'D'
|
||||
case c of
|
||||
'L' -> pure DirLeft
|
||||
'R' -> pure DirRight
|
||||
'U' -> pure DirUp
|
||||
'D' -> pure DirDown
|
||||
_ -> fail $ "Unexpected direction: " ++ show c
|
||||
|
||||
validMove :: Int -> Int -> ReadP Line
|
||||
validMove w h = do
|
||||
x <- int
|
||||
skipSpaces
|
||||
y <- int
|
||||
skipSpaces
|
||||
dir <- direction
|
||||
_ <- char '\n'
|
||||
if x >= 0 && x <= w && y >= 0 && y <= h then do
|
||||
let beg = Point x y
|
||||
pure $ mkLine beg (shiftPoint dir beg)
|
||||
else
|
||||
fail "Expected a move on the game board"
|
||||
|
||||
game :: ReadP Game
|
||||
game = do
|
||||
w <- read <$> inputLine
|
||||
h <- read <$> inputLine
|
||||
locs <- read <$> inputLine
|
||||
moves <- count locs (validMove w h)
|
||||
eof
|
||||
pure $ Game mempty moves
|
||||
|
||||
parseInput :: String -> Maybe Game
|
||||
parseInput x = do
|
||||
case readP_to_S game x of
|
||||
[(res, "")] -> Just res
|
||||
_ -> Nothing
|
||||
|
||||
-- | Smart constructor to ensure that beg is always < end.
|
||||
mkLine :: Point -> Point -> Line
|
||||
mkLine beg end =
|
||||
if beg < end then Line beg end else Line end beg
|
||||
|
||||
mkLineDir :: Int -> Int -> Direction -> Line
|
||||
mkLineDir x y dir =
|
||||
let beg = Point x y
|
||||
in mkLine beg (shiftPoint dir beg)
|
||||
|
||||
mkLineDir' :: Point -> Direction -> Line
|
||||
mkLineDir' (Point x y) dir = mkLineDir x y dir
|
||||
|
||||
shiftPoint :: Direction -> Point -> Point
|
||||
shiftPoint DirLeft (Point x y) = Point (x - 1) y
|
||||
shiftPoint DirRight (Point x y) = Point (x + 1) y
|
||||
shiftPoint DirUp (Point x y) = Point x (y + 1)
|
||||
shiftPoint DirDown (Point x y) = Point x (y - 1)
|
||||
|
||||
shiftLine :: Direction -> Line -> Line
|
||||
shiftLine dir (Line beg end) =
|
||||
mkLine (shiftPoint dir beg) (shiftPoint dir end)
|
||||
|
||||
rotateLine :: Anchor -> Rotation -> Line -> Line
|
||||
rotateLine anchor rotation line =
|
||||
doRotateLine (classifyOrientation line) anchor rotation line
|
||||
|
||||
doRotateLine :: Orientation -> Anchor -> Rotation -> Line -> Line
|
||||
doRotateLine Horizontal Beg CW (Line beg _) = mkLineDir' beg DirDown
|
||||
doRotateLine Horizontal Beg CCW (Line beg _) = mkLineDir' beg DirUp
|
||||
doRotateLine Horizontal End CW (Line _ end) = mkLineDir' end DirUp
|
||||
doRotateLine Horizontal End CCW (Line _ end) = mkLineDir' end DirDown
|
||||
doRotateLine Vertical Beg CW (Line beg _) = mkLineDir' beg DirRight
|
||||
doRotateLine Vertical Beg CCW (Line beg _) = mkLineDir' beg DirLeft
|
||||
doRotateLine Vertical End CW (Line _ end) = mkLineDir' end DirLeft
|
||||
doRotateLine Vertical End CCW (Line _ end) = mkLineDir' end DirRight
|
||||
|
||||
classifyOrientation :: Line -> Orientation
|
||||
classifyOrientation (Line (Point _ y1) (Point _ y2)) =
|
||||
if y1 == y2 then Horizontal else Vertical
|
||||
|
||||
closesAnySquare :: HS.HashSet Line -> Line -> Bool
|
||||
closesAnySquare allMoves line = do
|
||||
let alreadyDrawn x = HS.member x allMoves
|
||||
case classifyOrientation line of
|
||||
Horizontal ->
|
||||
all alreadyDrawn
|
||||
[ shiftLine DirUp line
|
||||
, rotateLine Beg CCW line
|
||||
, rotateLine End CW line
|
||||
] ||
|
||||
all alreadyDrawn
|
||||
[ shiftLine DirDown line
|
||||
, rotateLine Beg CW line
|
||||
, rotateLine End CCW line
|
||||
]
|
||||
Vertical ->
|
||||
all alreadyDrawn
|
||||
[ shiftLine DirLeft line
|
||||
, rotateLine Beg CCW line
|
||||
, rotateLine End CW line
|
||||
] ||
|
||||
all alreadyDrawn
|
||||
[ shiftLine DirRight line
|
||||
, rotateLine Beg CW line
|
||||
, rotateLine End CCW line
|
||||
]
|
||||
|
||||
incScoreboard :: Turn -> Scoreboard -> Scoreboard
|
||||
incScoreboard Player1 score = score <> Scoreboard 1 0
|
||||
incScoreboard Player2 score = score <> Scoreboard 0 1
|
||||
|
||||
scoreGame :: Turn -> Game -> Scoreboard -> Maybe Scoreboard
|
||||
scoreGame _ (Game _ []) score = Just $ score
|
||||
scoreGame player (Game allMoves (line:rest)) score =
|
||||
if HS.member line allMoves then
|
||||
Nothing
|
||||
else do
|
||||
let allMoves' = HS.insert line allMoves
|
||||
score' = if closesAnySquare allMoves line then
|
||||
incScoreboard player score
|
||||
else score
|
||||
scoreGame (next player) (Game allMoves' rest) score'
|
||||
|
||||
(|>) :: a -> (a -> b) -> b
|
||||
(|>) = (&)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
input <- readFile "game.txt"
|
||||
case parseInput input of
|
||||
Nothing -> putStrLn "invalid"
|
||||
Just parsedGame ->
|
||||
case scoreGame Player1 parsedGame mempty of
|
||||
Nothing -> putStrLn "invalid"
|
||||
Just score -> print score
|
21
users/wpcarro/assessments/dotted-squares/README.md
Normal file
21
users/wpcarro/assessments/dotted-squares/README.md
Normal file
|
@ -0,0 +1,21 @@
|
|||
# Dotted Squares
|
||||
|
||||
This is my second attempt at solving this problem. I had an hour to solve it the
|
||||
first time, and I unfortunately came up short although I made good progress.
|
||||
|
||||
The problem asks to read input from a text file that looks like this:
|
||||
|
||||
```
|
||||
1 -- board width
|
||||
1 -- board height
|
||||
4 -- number of lines of "moves" (below)
|
||||
0 0 R -- create a unit vector (0,0) facing right
|
||||
0 0 U -- create a unit vector (0,0) facing up
|
||||
0 1 L -- create a unit vector (0,1) facing left
|
||||
1 1 D -- create a unit vector (1,1) facing down
|
||||
```
|
||||
|
||||
After parsing and validating the input, score the outcome a game where players
|
||||
one and two alternatively take turns drawing lines on a board. Anytime one of
|
||||
the players draws a line that creates a square from existing lines, they get a
|
||||
point.
|
80
users/wpcarro/assessments/dotted-squares/Spec.hs
Normal file
80
users/wpcarro/assessments/dotted-squares/Spec.hs
Normal file
|
@ -0,0 +1,80 @@
|
|||
--------------------------------------------------------------------------------
|
||||
module Spec where
|
||||
--------------------------------------------------------------------------------
|
||||
import Test.Hspec
|
||||
import Main hiding (main)
|
||||
import qualified Data.HashSet as HS
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
main :: IO ()
|
||||
main = hspec $ do
|
||||
describe "dotted-squares" $ do
|
||||
describe "parseInput" $ do
|
||||
it "works as expected" $ do
|
||||
input <- readFile "input-a.txt"
|
||||
parseInput input `shouldBe` Just (Game mempty [ mkLine (Point 0 0) (Point 1 0)
|
||||
, mkLine (Point 0 0) (Point 0 1)
|
||||
])
|
||||
|
||||
it "fails when the game has too many user moves" $ do
|
||||
input <- readFile "too-many-moves.txt"
|
||||
parseInput input `shouldBe` Nothing
|
||||
|
||||
it "fails when the game has too few user moves" $ do
|
||||
input <- readFile "too-few-moves.txt"
|
||||
parseInput input `shouldBe` Nothing
|
||||
|
||||
describe "shiftLine" $ do
|
||||
let horizontal = mkLineDir 1 1 DirRight
|
||||
vertical = mkLineDir 1 1 DirUp
|
||||
it "can move a horizontal line up" $
|
||||
shiftLine DirUp horizontal `shouldBe` mkLineDir 1 2 DirRight
|
||||
it "can move a horizontal line down" $
|
||||
shiftLine DirDown horizontal `shouldBe` mkLineDir 1 0 DirRight
|
||||
it "can move a horizontal line left" $
|
||||
shiftLine DirLeft horizontal `shouldBe` mkLineDir 0 1 DirRight
|
||||
it "can move a horizontal line right" $
|
||||
shiftLine DirRight horizontal `shouldBe` mkLineDir 2 1 DirRight
|
||||
it "can move a vertical line up" $
|
||||
shiftLine DirUp vertical `shouldBe` mkLineDir 1 2 DirUp
|
||||
it "can move a vertical line down" $
|
||||
shiftLine DirDown vertical `shouldBe` mkLineDir 1 0 DirUp
|
||||
it "can move a vertical line left" $
|
||||
shiftLine DirLeft vertical `shouldBe` mkLineDir 0 1 DirUp
|
||||
it "can move a vertical line right" $
|
||||
shiftLine DirRight vertical `shouldBe` mkLineDir 2 1 DirUp
|
||||
|
||||
describe "rotateLine" $ do
|
||||
let horizontal = mkLineDir 1 1 DirRight -- 1,1;2,1
|
||||
vertical = mkLineDir 1 1 DirUp -- 1,1;1,2
|
||||
it "can rotate a horizontal line CW anchored at its beginning" $
|
||||
rotateLine Beg CW horizontal `shouldBe` mkLineDir 1 1 DirDown
|
||||
it "can rotate a horizontal line CCW anchored at its beginning" $
|
||||
rotateLine Beg CCW horizontal `shouldBe` mkLineDir 1 1 DirUp
|
||||
it "can rotate a horizontal line CW anchored at its end" $
|
||||
rotateLine End CW horizontal `shouldBe` mkLineDir 2 1 DirUp
|
||||
it "can rotate a horizontal line CCW anchored at its end" $
|
||||
rotateLine End CCW horizontal `shouldBe` mkLineDir 2 1 DirDown
|
||||
|
||||
it "can rotate a vertical line CW anchored at its beginning" $
|
||||
rotateLine Beg CW vertical `shouldBe` mkLineDir 1 1 DirRight
|
||||
it "can rotate a vertical line CCW anchored at its beginning" $
|
||||
rotateLine Beg CCW vertical `shouldBe` mkLineDir 1 1 DirLeft
|
||||
it "can rotate a vertical line CW anchored at its end" $
|
||||
rotateLine End CW vertical `shouldBe` mkLineDir 1 2 DirLeft
|
||||
it "can rotate a vertical line CCW anchored at its end" $
|
||||
rotateLine End CCW vertical `shouldBe` mkLineDir 1 2 DirRight
|
||||
|
||||
describe "closesAnySquare" $ do
|
||||
let threeSides = [ (0, 0, DirRight)
|
||||
, (0, 0, DirUp)
|
||||
, (0, 1, DirRight)
|
||||
]
|
||||
|> fmap (\(x, y, dir) -> mkLineDir x y dir)
|
||||
|> HS.fromList
|
||||
it "returns true the line we supply makes a square" $
|
||||
closesAnySquare threeSides (mkLineDir 1 1 DirDown) `shouldBe` True
|
||||
it "returns false the line we supply doesn't make a square" $
|
||||
closesAnySquare threeSides (mkLineDir 1 1 DirUp) `shouldBe` False
|
||||
it "returns false when we have no existing lines" $
|
||||
closesAnySquare mempty (mkLineDir 1 1 DirUp) `shouldBe` False
|
|
@ -0,0 +1,7 @@
|
|||
1
|
||||
1
|
||||
4
|
||||
0 0 R
|
||||
0 0 R
|
||||
0 1 R
|
||||
0 1 R
|
7
users/wpcarro/assessments/dotted-squares/game.txt
Normal file
7
users/wpcarro/assessments/dotted-squares/game.txt
Normal file
|
@ -0,0 +1,7 @@
|
|||
1
|
||||
1
|
||||
4
|
||||
0 0 R
|
||||
0 0 U
|
||||
0 1 R
|
||||
1 1 D
|
5
users/wpcarro/assessments/dotted-squares/input-a.txt
Normal file
5
users/wpcarro/assessments/dotted-squares/input-a.txt
Normal file
|
@ -0,0 +1,5 @@
|
|||
1
|
||||
1
|
||||
2
|
||||
0 0 R
|
||||
0 0 U
|
8
users/wpcarro/assessments/dotted-squares/shell.nix
Normal file
8
users/wpcarro/assessments/dotted-squares/shell.nix
Normal file
|
@ -0,0 +1,8 @@
|
|||
let
|
||||
briefcase = import <briefcase> {};
|
||||
in briefcase.buildHaskell.shell {
|
||||
deps = hpkgs: with hpkgs; [
|
||||
hspec
|
||||
unordered-containers
|
||||
];
|
||||
}
|
|
@ -0,0 +1,6 @@
|
|||
1
|
||||
1
|
||||
4
|
||||
0 0 R
|
||||
0 0 U
|
||||
0 1 R
|
|
@ -0,0 +1,7 @@
|
|||
1
|
||||
1
|
||||
3
|
||||
0 0 R
|
||||
0 0 U
|
||||
0 1 R
|
||||
1 1 D
|
|
@ -0,0 +1,29 @@
|
|||
# The file '2010.census.txt' contains summary statistics from the 2010 United
|
||||
# States census including household income. The data is in an unspecified
|
||||
# format.
|
||||
|
||||
# Find the average of the column called:
|
||||
|
||||
# 'MEDIAN HOUSEHOLD INCOME'
|
||||
|
||||
# Ideally the solution should be a command line script, of the form:
|
||||
|
||||
# $ ./solution [options] [file...]
|
||||
|
||||
# The solution may be written in any language, Python is preferred but not
|
||||
# required.
|
||||
|
||||
# Google, stack overflow, etc. usage is allowed.
|
||||
|
||||
import requests
|
||||
|
||||
url = "https://assets.tryramp.com/interview/census/2010.census.txt"
|
||||
|
||||
def main():
|
||||
res = requests.get(url)
|
||||
if res.status not in {200}:
|
||||
raise Exception("Unexpected status code: {}".format(res.status_code))
|
||||
# download the content
|
||||
# parse row
|
||||
# select 'MEDIAN HOUSEHOLD INCOME' column
|
||||
pass
|
87
users/wpcarro/assessments/ramp/solution.py
Normal file
87
users/wpcarro/assessments/ramp/solution.py
Normal file
|
@ -0,0 +1,87 @@
|
|||
# The file '2010.census.txt' contains summary statistics from the 2010 United
|
||||
# States census including household income. The data is in an unspecified
|
||||
# format.
|
||||
|
||||
# Find the average of the column called:
|
||||
|
||||
# 'MEDIAN HOUSEHOLD INCOME'
|
||||
|
||||
# Ideally the solution should be a command line script, of the form:
|
||||
|
||||
# $ ./solution [options] [file...]
|
||||
|
||||
# The solution may be written in any language, Python is preferred but not
|
||||
# required.
|
||||
|
||||
# Google, stack overflow, etc. usage is allowed.
|
||||
|
||||
import requests
|
||||
import csv
|
||||
|
||||
url = "https://assets.tryramp.com/interview/census/2010.census.txt"
|
||||
column = 'MEDIAN HOUSEHOLD INCOME'
|
||||
columns = [
|
||||
'CENSUS YEAR',
|
||||
'TRACT',
|
||||
'BLOCK GROUP',
|
||||
'FIPS ID',
|
||||
'TOTAL POPULATION',
|
||||
'POPULATION WHITE',
|
||||
'POPULATION BLACK',
|
||||
'POPULATION ASIAN',
|
||||
'POPULATION OTHER',
|
||||
'POPULATION AMERICAN INDIAN',
|
||||
'POPULATION PACIFIC ISLANDER',
|
||||
'POPULATION ONE RACE',
|
||||
'POPULATION MULTI RACE',
|
||||
'POPULATION 25 OLDER',
|
||||
'MEDIAN AGE',
|
||||
'MEDIAN HOUSEHOLD INCOME',
|
||||
'HIGH SCHOOL MALE',
|
||||
'HIGH SCHOOL MORE MALE',
|
||||
'COLLEGE 1 YR LESS MALE',
|
||||
'COLLEGE 1 YR MORE MALE',
|
||||
'ASSOCIATES DEGREE MALE',
|
||||
'BACHELORS DEGREE MALE',
|
||||
'MASTERS DEGREE MALE',
|
||||
'PROFESSIONAL DEGREE MALE',
|
||||
'DOCTORAL DEGREE MALE',
|
||||
'HIGH SCHOOL FEMALE',
|
||||
'HIGH SCHOOL MORE FEMALE',
|
||||
'COLLEGE 1 YR LESS FEMALE',
|
||||
'COLLEGE 1 YR MORE FEMALE',
|
||||
'ASSOCIATES DEGREE FEMALE',
|
||||
'BACHELORS DEGREE FEMALE',
|
||||
'MASTERS DEGREE FEMALE',
|
||||
'PROFESSIONAL DEGREE FEMALE',
|
||||
'DOCTORAL DEGREE FEMALE',
|
||||
'PERCENT 25 YR OVER HIGH SCHOOL MORE',
|
||||
'HOUSING UNITS',
|
||||
'OCCUPIED HOUSING UNITS',
|
||||
'OWNER OCCUPIED HOUSING',
|
||||
'RENTER OCCUPIED HOUSING',
|
||||
'PERCENT OWNER OCCUPIED',
|
||||
'PERCENT RENTER OCCUPIED',
|
||||
'MEDIAN HOUSE VALUE OWNER OCCUPIED',
|
||||
'MEDIAN YEAR BUILT',
|
||||
'VACANCY RATES',
|
||||
]
|
||||
|
||||
|
||||
def average(xs):
|
||||
return sum(xs) / len(xs)
|
||||
|
||||
|
||||
def parse_body(body):
|
||||
return list(csv.DictReader(body.split('\n')[1:], delimiter='|', fieldnames=columns))
|
||||
|
||||
|
||||
def main():
|
||||
res = requests.get(url)
|
||||
if res.status_code not in {200}:
|
||||
raise Exception("Unexpected status code: {}".format(res.status_code))
|
||||
return average([int(d.get(column))
|
||||
for d in parse_body(res.text)
|
||||
if int(d.get(column)) >= 0])
|
||||
|
||||
print(main())
|
1
users/wpcarro/assessments/semiprimes/.gitignore
vendored
Normal file
1
users/wpcarro/assessments/semiprimes/.gitignore
vendored
Normal file
|
@ -0,0 +1 @@
|
|||
default.nix
|
44
users/wpcarro/assessments/semiprimes/README.md
Normal file
44
users/wpcarro/assessments/semiprimes/README.md
Normal file
|
@ -0,0 +1,44 @@
|
|||
# Semiprimes Service
|
||||
|
||||
## Introduction
|
||||
|
||||
A **composite** is a number containing at least two prime factors. For example:
|
||||
|
||||
```
|
||||
15 = 3 × 5
|
||||
9 = 3 × 3
|
||||
12 = 2 × 2 × 3
|
||||
```
|
||||
|
||||
There are ten composites below thirty containing precisely two, not necessarily
|
||||
distinct, prime factors: `4, 6, 9, 10, 14, 15, 21, 22, 25, 26`. Let’s call such
|
||||
numbers *Semiprimes*.
|
||||
|
||||
## Task
|
||||
|
||||
- Write a module which provides a function to tell whether a given number, `N`,
|
||||
is a semiprime. `N` will be less than 100,000
|
||||
- Please implement an API (RESTful or GraphQL) to factor a given number into two
|
||||
prime numbers if it’s a semiprime, otherwise, return an error message.
|
||||
|
||||
## Stretch Goals
|
||||
|
||||
- Handle the invalid inputs.
|
||||
- Support batch requests: i.e. users could provide 100 numbers, and the API
|
||||
return the answer for all.
|
||||
- Considering this module will be used by a long running service, could you
|
||||
optimize it to give answers faster?
|
||||
|
||||
## Usage
|
||||
|
||||
To run the application you'll need to have `elixir` installed. Assuming `elixir`
|
||||
is already installed, consult the following steps to start the application:
|
||||
|
||||
```shell
|
||||
$ cd server
|
||||
$ mix deps.get
|
||||
$ iex -S mix
|
||||
```
|
||||
|
||||
Now open a web browser and visit `http://localhost:8080`!
|
||||
|
1
users/wpcarro/assessments/semiprimes/default.nix
Normal file
1
users/wpcarro/assessments/semiprimes/default.nix
Normal file
|
@ -0,0 +1 @@
|
|||
# stubbed
|
|
@ -0,0 +1,4 @@
|
|||
# Used by "mix format"
|
||||
[
|
||||
inputs: ["{mix,.formatter}.exs", "{config,lib,test}/**/*.{ex,exs}"]
|
||||
]
|
24
users/wpcarro/assessments/semiprimes/server/.gitignore
vendored
Normal file
24
users/wpcarro/assessments/semiprimes/server/.gitignore
vendored
Normal file
|
@ -0,0 +1,24 @@
|
|||
# The directory Mix will write compiled artifacts to.
|
||||
/_build/
|
||||
|
||||
# If you run "mix test --cover", coverage assets end up here.
|
||||
/cover/
|
||||
|
||||
# The directory Mix downloads your dependencies sources to.
|
||||
/deps/
|
||||
|
||||
# Where third-party dependencies like ExDoc output generated docs.
|
||||
/doc/
|
||||
|
||||
# Ignore .fetch files in case you like to edit your project deps locally.
|
||||
/.fetch
|
||||
|
||||
# If the VM crashes, it generates a dump, let's ignore it too.
|
||||
erl_crash.dump
|
||||
|
||||
# Also ignore archive artifacts (built via "mix archive.build").
|
||||
*.ez
|
||||
|
||||
# Ignore package tarball (built via "mix hex.build").
|
||||
server-*.tar
|
||||
|
8
users/wpcarro/assessments/semiprimes/server/lib/app.ex
Normal file
8
users/wpcarro/assessments/semiprimes/server/lib/app.ex
Normal file
|
@ -0,0 +1,8 @@
|
|||
defmodule App do
|
||||
use Application
|
||||
|
||||
@impl true
|
||||
def start(_type, _args) do
|
||||
Sup.start_link()
|
||||
end
|
||||
end
|
41
users/wpcarro/assessments/semiprimes/server/lib/cache.ex
Normal file
41
users/wpcarro/assessments/semiprimes/server/lib/cache.ex
Normal file
|
@ -0,0 +1,41 @@
|
|||
defmodule Cache do
|
||||
@moduledoc """
|
||||
Cache is an in-memory key-value store.
|
||||
"""
|
||||
use Agent
|
||||
|
||||
@doc """
|
||||
Inititalize the key-value store.
|
||||
"""
|
||||
def start_link(_) do
|
||||
Agent.start_link(fn -> %{} end, name: __MODULE__)
|
||||
end
|
||||
|
||||
@doc """
|
||||
Attempt to return the value stored at `key`
|
||||
"""
|
||||
def get(key) do
|
||||
Agent.get(__MODULE__, &Map.get(&1, key))
|
||||
end
|
||||
|
||||
@doc """
|
||||
Write the `value` under the `key`. Last writer wins.
|
||||
"""
|
||||
def put(key, value) do
|
||||
Agent.update(__MODULE__, &Map.put(&1, key, value))
|
||||
end
|
||||
|
||||
@doc """
|
||||
List the contents of the cache. Useful for debugging purposes.
|
||||
"""
|
||||
def list() do
|
||||
Agent.get(__MODULE__, & &1)
|
||||
end
|
||||
|
||||
@doc """
|
||||
Invalidate the entire cache.
|
||||
"""
|
||||
def clear() do
|
||||
Agent.update(__MODULE__, fn _ -> %{} end)
|
||||
end
|
||||
end
|
22
users/wpcarro/assessments/semiprimes/server/lib/extras.ex
Normal file
22
users/wpcarro/assessments/semiprimes/server/lib/extras.ex
Normal file
|
@ -0,0 +1,22 @@
|
|||
defmodule Extras do
|
||||
@moduledoc """
|
||||
Hosts utility functions intended to supplement the standard library.
|
||||
"""
|
||||
|
||||
@doc """
|
||||
Return an ascending range starting at `a` and ending at `b` (exclusive).
|
||||
|
||||
## Examples
|
||||
|
||||
iex> Extras.range(2, 5)
|
||||
[2, 3, 4]
|
||||
|
||||
"""
|
||||
def range(a, b) do
|
||||
if b <= a do
|
||||
[]
|
||||
else
|
||||
[a] ++ range(a + 1, b)
|
||||
end
|
||||
end
|
||||
end
|
26
users/wpcarro/assessments/semiprimes/server/lib/math.ex
Normal file
26
users/wpcarro/assessments/semiprimes/server/lib/math.ex
Normal file
|
@ -0,0 +1,26 @@
|
|||
defmodule Math do
|
||||
@moduledoc """
|
||||
Math utilities.
|
||||
"""
|
||||
alias Extras
|
||||
|
||||
@doc """
|
||||
Returns the prime factors for `n`.
|
||||
|
||||
## Examples
|
||||
|
||||
iex> Math.factor(15)
|
||||
[3, 5]
|
||||
|
||||
"""
|
||||
def factor(1), do: []
|
||||
|
||||
def factor(n) do
|
||||
Extras.range(2, n - 1)
|
||||
|> Enum.find(&(rem(n, &1) == 0))
|
||||
|> case do
|
||||
nil -> [n]
|
||||
x -> [x | factor(div(n, x))]
|
||||
end
|
||||
end
|
||||
end
|
86
users/wpcarro/assessments/semiprimes/server/lib/router.ex
Normal file
86
users/wpcarro/assessments/semiprimes/server/lib/router.ex
Normal file
|
@ -0,0 +1,86 @@
|
|||
defmodule Router do
|
||||
use Plug.Router
|
||||
use Plug.Debugger
|
||||
require Logger
|
||||
|
||||
plug(Plug.Logger, log: :debug)
|
||||
plug(Plug.Parsers, parsers: [:urlencoded])
|
||||
plug(:match)
|
||||
plug(:dispatch)
|
||||
|
||||
@usage """
|
||||
Usage: Try querying some of the following endpoints...
|
||||
GET /
|
||||
GET /help
|
||||
GET /semiprime?number=<integer>
|
||||
GET /semiprimes?numbers=<comma-separated-integers>
|
||||
"""
|
||||
|
||||
get "/" do
|
||||
send_resp(conn, 200, "Welcome to Semiprimes Service!\n\n#{@usage}")
|
||||
end
|
||||
|
||||
get "/help" do
|
||||
send_resp(conn, 200, @usage)
|
||||
end
|
||||
|
||||
get "/semiprime" do
|
||||
case conn |> Map.get(:query_params) |> Map.get("number") do
|
||||
nil ->
|
||||
send_resp(conn, 400, "You must pass an integer as a query parameter. #{@usage}")
|
||||
|
||||
val ->
|
||||
case Integer.parse(val) do
|
||||
{n, ""} ->
|
||||
send_resp(conn, 200, semiprime_response(n))
|
||||
|
||||
_ ->
|
||||
send_resp(conn, 400, "We could not parse the number you provided.\n\n#{@usage}")
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
get "/semiprimes" do
|
||||
case conn |> Map.get(:query_params) |> Map.get("numbers") do
|
||||
nil ->
|
||||
send_resp(
|
||||
conn,
|
||||
400,
|
||||
"You must pass a comma-separated list of integers as a query parameter.\n\n#{@usage}"
|
||||
)
|
||||
|
||||
xs ->
|
||||
response =
|
||||
xs
|
||||
|> String.split(",")
|
||||
|> Stream.map(&Integer.parse/1)
|
||||
|> Stream.filter(fn
|
||||
{n, ""} -> true
|
||||
_ -> false
|
||||
end)
|
||||
|> Stream.map(fn {n, ""} -> semiprime_response(n) end)
|
||||
|> Enum.join("\n")
|
||||
|
||||
send_resp(conn, 200, response)
|
||||
end
|
||||
end
|
||||
|
||||
match _ do
|
||||
send_resp(conn, 404, "Not found.")
|
||||
end
|
||||
|
||||
################################################################################
|
||||
# Utils
|
||||
################################################################################
|
||||
|
||||
defp semiprime_response(n) do
|
||||
case Server.semiprime(n) do
|
||||
nil ->
|
||||
"#{n} is not a semiprime. Try another number!"
|
||||
|
||||
{hit_or_miss, factors} ->
|
||||
response = "#{n} is a semiprime! Its factors are #{Enum.join(factors, " and ")}."
|
||||
"Cache #{Atom.to_string(hit_or_miss)} - #{response}"
|
||||
end
|
||||
end
|
||||
end
|
33
users/wpcarro/assessments/semiprimes/server/lib/server.ex
Normal file
33
users/wpcarro/assessments/semiprimes/server/lib/server.ex
Normal file
|
@ -0,0 +1,33 @@
|
|||
defmodule Server do
|
||||
@moduledoc """
|
||||
Documentation for `Server`.
|
||||
"""
|
||||
|
||||
@doc """
|
||||
If `n` contains exactly two prime factors, return those prime factors;
|
||||
otherwise, return nothing.
|
||||
"""
|
||||
def semiprime(n) do
|
||||
case Cache.get(n) do
|
||||
nil ->
|
||||
case do_semiprime(n) do
|
||||
nil ->
|
||||
nil
|
||||
|
||||
res ->
|
||||
Cache.put(n, res)
|
||||
{:miss, res}
|
||||
end
|
||||
|
||||
hit ->
|
||||
{:hit, hit}
|
||||
end
|
||||
end
|
||||
|
||||
defp do_semiprime(n) do
|
||||
case Math.factor(n) do
|
||||
[_, _] = res -> res
|
||||
_ -> nil
|
||||
end
|
||||
end
|
||||
end
|
23
users/wpcarro/assessments/semiprimes/server/lib/sup.ex
Normal file
23
users/wpcarro/assessments/semiprimes/server/lib/sup.ex
Normal file
|
@ -0,0 +1,23 @@
|
|||
defmodule Sup do
|
||||
@moduledoc """
|
||||
Top-level supervisor for our OTP application. For now, this supervisor starts
|
||||
and monitors our cache.
|
||||
"""
|
||||
|
||||
use Supervisor
|
||||
alias Plug.Adapters.Cowboy
|
||||
|
||||
def start_link(opts \\ []) do
|
||||
Supervisor.start_link(__MODULE__, :ok, opts)
|
||||
end
|
||||
|
||||
@impl true
|
||||
def init(:ok) do
|
||||
children = [
|
||||
Cache,
|
||||
Cowboy.child_spec(scheme: :http, plug: Router, options: [port: 8000])
|
||||
]
|
||||
|
||||
Supervisor.init(children, strategy: :one_for_one)
|
||||
end
|
||||
end
|
32
users/wpcarro/assessments/semiprimes/server/mix.exs
Normal file
32
users/wpcarro/assessments/semiprimes/server/mix.exs
Normal file
|
@ -0,0 +1,32 @@
|
|||
defmodule Server.MixProject do
|
||||
use Mix.Project
|
||||
|
||||
def project do
|
||||
[
|
||||
app: :server,
|
||||
version: "0.1.0",
|
||||
elixir: "~> 1.10",
|
||||
start_permanent: Mix.env() == :prod,
|
||||
deps: deps()
|
||||
]
|
||||
end
|
||||
|
||||
# Run "mix help compile.app" to learn about applications.
|
||||
def application do
|
||||
[
|
||||
extra_applications: [:logger],
|
||||
mod: {App, []}
|
||||
]
|
||||
end
|
||||
|
||||
# Run "mix help deps" to learn about dependencies.
|
||||
defp deps do
|
||||
[
|
||||
{:cortex, "~> 0.1", only: [:dev, :test]},
|
||||
{:plug_cowboy, "~> 2.4.1"},
|
||||
{:cowboy, "~> 2.8.0"},
|
||||
{:plug, "~> 1.11.0"},
|
||||
{:poison, "~> 4.0.1"}
|
||||
]
|
||||
end
|
||||
end
|
14
users/wpcarro/assessments/semiprimes/server/mix.lock
Normal file
14
users/wpcarro/assessments/semiprimes/server/mix.lock
Normal file
|
@ -0,0 +1,14 @@
|
|||
%{
|
||||
"cortex": {:hex, :cortex, "0.6.0", "8094830fae266eb0ae34d1a58983c0c49484341f5044fb4dfb81746647bd2993", [:mix], [{:file_system, "~> 0.2", [hex: :file_system, repo: "hexpm", optional: false]}], "hexpm", "d0ef5a2b1269626149118684dc4ea77dbfbc67017f4b4065b71dcefa26cfcc49"},
|
||||
"cowboy": {:hex, :cowboy, "2.8.0", "f3dc62e35797ecd9ac1b50db74611193c29815401e53bac9a5c0577bd7bc667d", [:rebar3], [{:cowlib, "~> 2.9.1", [hex: :cowlib, repo: "hexpm", optional: false]}, {:ranch, "~> 1.7.1", [hex: :ranch, repo: "hexpm", optional: false]}], "hexpm", "4643e4fba74ac96d4d152c75803de6fad0b3fa5df354c71afdd6cbeeb15fac8a"},
|
||||
"cowboy_telemetry": {:hex, :cowboy_telemetry, "0.3.1", "ebd1a1d7aff97f27c66654e78ece187abdc646992714164380d8a041eda16754", [:rebar3], [{:cowboy, "~> 2.7", [hex: :cowboy, repo: "hexpm", optional: false]}, {:telemetry, "~> 0.4", [hex: :telemetry, repo: "hexpm", optional: false]}], "hexpm", "3a6efd3366130eab84ca372cbd4a7d3c3a97bdfcfb4911233b035d117063f0af"},
|
||||
"cowlib": {:hex, :cowlib, "2.9.1", "61a6c7c50cf07fdd24b2f45b89500bb93b6686579b069a89f88cb211e1125c78", [:rebar3], [], "hexpm", "e4175dc240a70d996156160891e1c62238ede1729e45740bdd38064dad476170"},
|
||||
"file_system": {:hex, :file_system, "0.2.10", "fb082005a9cd1711c05b5248710f8826b02d7d1784e7c3451f9c1231d4fc162d", [:mix], [], "hexpm", "41195edbfb562a593726eda3b3e8b103a309b733ad25f3d642ba49696bf715dc"},
|
||||
"mime": {:hex, :mime, "1.5.0", "203ef35ef3389aae6d361918bf3f952fa17a09e8e43b5aa592b93eba05d0fb8d", [:mix], [], "hexpm", "55a94c0f552249fc1a3dd9cd2d3ab9de9d3c89b559c2bd01121f824834f24746"},
|
||||
"plug": {:hex, :plug, "1.11.0", "f17217525597628298998bc3baed9f8ea1fa3f1160aa9871aee6df47a6e4d38e", [:mix], [{:mime, "~> 1.0", [hex: :mime, repo: "hexpm", optional: false]}, {:plug_crypto, "~> 1.1.1 or ~> 1.2", [hex: :plug_crypto, repo: "hexpm", optional: false]}, {:telemetry, "~> 0.4", [hex: :telemetry, repo: "hexpm", optional: false]}], "hexpm", "2d9c633f0499f9dc5c2fd069161af4e2e7756890b81adcbb2ceaa074e8308876"},
|
||||
"plug_cowboy": {:hex, :plug_cowboy, "2.4.1", "779ba386c0915027f22e14a48919a9545714f849505fa15af2631a0d298abf0f", [:mix], [{:cowboy, "~> 2.7", [hex: :cowboy, repo: "hexpm", optional: false]}, {:cowboy_telemetry, "~> 0.3", [hex: :cowboy_telemetry, repo: "hexpm", optional: false]}, {:plug, "~> 1.7", [hex: :plug, repo: "hexpm", optional: false]}, {:telemetry, "~> 0.4", [hex: :telemetry, repo: "hexpm", optional: false]}], "hexpm", "d72113b6dff7b37a7d9b2a5b68892808e3a9a752f2bf7e503240945385b70507"},
|
||||
"plug_crypto": {:hex, :plug_crypto, "1.2.0", "1cb20793aa63a6c619dd18bb33d7a3aa94818e5fd39ad357051a67f26dfa2df6", [:mix], [], "hexpm", "a48b538ae8bf381ffac344520755f3007cc10bd8e90b240af98ea29b69683fc2"},
|
||||
"poison": {:hex, :poison, "4.0.1", "bcb755a16fac91cad79bfe9fc3585bb07b9331e50cfe3420a24bcc2d735709ae", [:mix], [], "hexpm", "ba8836feea4b394bb718a161fc59a288fe0109b5006d6bdf97b6badfcf6f0f25"},
|
||||
"ranch": {:hex, :ranch, "1.7.1", "6b1fab51b49196860b733a49c07604465a47bdb78aa10c1c16a3d199f7f8c881", [:rebar3], [], "hexpm", "451d8527787df716d99dc36162fca05934915db0b6141bbdac2ea8d3c7afc7d7"},
|
||||
"telemetry": {:hex, :telemetry, "0.4.2", "2808c992455e08d6177322f14d3bdb6b625fbcfd233a73505870d8738a2f4599", [:rebar3], [], "hexpm", "2d1419bd9dda6a206d7b5852179511722e2b18812310d304620c7bd92a13fcef"},
|
||||
}
|
|
@ -0,0 +1,18 @@
|
|||
defmodule ExtrasTest do
|
||||
use ExUnit.Case
|
||||
doctest Extras
|
||||
|
||||
describe "range" do
|
||||
test "returns an empty list for descending sequences" do
|
||||
assert Extras.range(0, -2) == []
|
||||
end
|
||||
|
||||
test "returns an empty list for non-ascending sequences" do
|
||||
assert Extras.range(8, 8) == []
|
||||
end
|
||||
|
||||
test "returns an exclusive range" do
|
||||
assert Extras.range(3, 6) == [3, 4, 5]
|
||||
end
|
||||
end
|
||||
end
|
|
@ -0,0 +1,30 @@
|
|||
defmodule MathTest do
|
||||
use ExUnit.Case
|
||||
doctest Math
|
||||
|
||||
describe "factor" do
|
||||
test "returns the prime factors for an input" do
|
||||
[
|
||||
{15, [3, 5]},
|
||||
{12, [2, 2, 3]},
|
||||
{9, [3, 3]},
|
||||
{21, [3, 7]}
|
||||
]
|
||||
|> Enum.map(fn {input, expected} ->
|
||||
assert Math.factor(input) == expected
|
||||
end)
|
||||
end
|
||||
|
||||
test "handles large numbers" do
|
||||
assert Math.factor(104_023) == [17, 29, 211]
|
||||
end
|
||||
|
||||
test "returns an empty list for 1" do
|
||||
assert Math.factor(1) == []
|
||||
end
|
||||
|
||||
test "returns the prime number itself when the input is prime" do
|
||||
assert Math.factor(7) == [7]
|
||||
end
|
||||
end
|
||||
end
|
|
@ -0,0 +1,34 @@
|
|||
defmodule ServerTest do
|
||||
use ExUnit.Case
|
||||
doctest Server
|
||||
|
||||
describe "semiprime" do
|
||||
test "returns the factors when the number is semiprime" do
|
||||
Cache.clear()
|
||||
# Semiprimes below 30
|
||||
[
|
||||
{4, [2, 2]},
|
||||
{6, [2, 3]},
|
||||
{9, [3, 3]},
|
||||
{10, [2, 5]},
|
||||
{14, [2, 7]},
|
||||
{15, [3, 5]},
|
||||
{21, [3, 7]},
|
||||
{22, [2, 11]},
|
||||
{25, [5, 5]},
|
||||
{26, [2, 13]}
|
||||
]
|
||||
|> Enum.each(fn {input, expected} ->
|
||||
assert Server.semiprime(input) == {:miss, expected}
|
||||
end)
|
||||
end
|
||||
|
||||
test "returns nothing when the number is a composite number" do
|
||||
# Composite numbers below 30
|
||||
[1, 2, 3, 5, 7, 8, 11, 12, 13, 16, 17, 18, 19, 20, 23, 24, 27, 28, 29]
|
||||
|> Enum.each(fn x ->
|
||||
assert Server.semiprime(x) == nil
|
||||
end)
|
||||
end
|
||||
end
|
||||
end
|
|
@ -0,0 +1 @@
|
|||
ExUnit.start()
|
6
users/wpcarro/assessments/tt/.gitignore
vendored
Normal file
6
users/wpcarro/assessments/tt/.gitignore
vendored
Normal file
|
@ -0,0 +1,6 @@
|
|||
.envrc
|
||||
*.db
|
||||
*.sqlite3
|
||||
!populate.sqlite3
|
||||
*.db-shm
|
||||
*.db-wal
|
50
users/wpcarro/assessments/tt/README.md
Normal file
50
users/wpcarro/assessments/tt/README.md
Normal file
|
@ -0,0 +1,50 @@
|
|||
# TT
|
||||
|
||||
All of the commands defined herein should be run from the top-level directory of
|
||||
this repository (i.e. the directory in which this file exists).
|
||||
|
||||
## Server
|
||||
|
||||
To create the environment that contains all of this application's dependencies,
|
||||
run:
|
||||
|
||||
```shell
|
||||
$ nix-shell
|
||||
```
|
||||
|
||||
To run the server interactively, run:
|
||||
|
||||
```shell
|
||||
$ cd src/
|
||||
$ ghci
|
||||
```
|
||||
|
||||
Now compile and load the server with:
|
||||
|
||||
```
|
||||
Prelude> :l Main.hs
|
||||
*Main> main
|
||||
```
|
||||
|
||||
## Database
|
||||
|
||||
Create a new database named `db.sqlite3` with:
|
||||
|
||||
```shell
|
||||
$ sqlite3 db.sqlite3
|
||||
```
|
||||
|
||||
Populate the database with:
|
||||
|
||||
```
|
||||
sqlite3> .read populate.sqlite3
|
||||
```
|
||||
|
||||
You can verify that everything is setup with:
|
||||
|
||||
```
|
||||
sqlite3> .tables
|
||||
sqlite3> .schema
|
||||
sqlite3> SELECT * FROM Accounts;
|
||||
sqlite3> SELECT * FROM Trips;
|
||||
```
|
3
users/wpcarro/assessments/tt/client/.gitignore
vendored
Normal file
3
users/wpcarro/assessments/tt/client/.gitignore
vendored
Normal file
|
@ -0,0 +1,3 @@
|
|||
/elm-stuff
|
||||
/Main.min.js
|
||||
/output.css
|
18
users/wpcarro/assessments/tt/client/README.md
Normal file
18
users/wpcarro/assessments/tt/client/README.md
Normal file
|
@ -0,0 +1,18 @@
|
|||
# Elm
|
||||
|
||||
Elm has one of the best developer experiences that I'm aware of. The error
|
||||
messages are helpful and the entire experience is optimized to improve the ease
|
||||
of writing web applications.
|
||||
|
||||
## Developing
|
||||
|
||||
If you're interested in contributing, the following will create an environment
|
||||
in which you can develop:
|
||||
|
||||
```shell
|
||||
$ nix-shell
|
||||
$ npx tailwindcss build index.css -o output.css
|
||||
$ elm-live -- src/Main.elm --output=Main.min.js
|
||||
```
|
||||
|
||||
You can now view your web client at `http://localhost:8000`!
|
3
users/wpcarro/assessments/tt/client/dir-locals.nix
Normal file
3
users/wpcarro/assessments/tt/client/dir-locals.nix
Normal file
|
@ -0,0 +1,3 @@
|
|||
let
|
||||
briefcase = import /home/wpcarro/briefcase {};
|
||||
in briefcase.utils.nixBufferFromShell ./shell.nix
|
40
users/wpcarro/assessments/tt/client/elm.json
Normal file
40
users/wpcarro/assessments/tt/client/elm.json
Normal file
|
@ -0,0 +1,40 @@
|
|||
{
|
||||
"type": "application",
|
||||
"source-directories": [
|
||||
"src"
|
||||
],
|
||||
"elm-version": "0.19.1",
|
||||
"dependencies": {
|
||||
"direct": {
|
||||
"CurrySoftware/elm-datepicker": "4.0.0",
|
||||
"elm/browser": "1.0.2",
|
||||
"elm/core": "1.0.5",
|
||||
"elm/html": "1.0.0",
|
||||
"elm/http": "2.0.0",
|
||||
"elm/json": "1.1.3",
|
||||
"elm/random": "1.0.0",
|
||||
"elm/svg": "1.0.1",
|
||||
"elm/time": "1.0.0",
|
||||
"elm/url": "1.0.0",
|
||||
"elm-community/json-extra": "4.2.0",
|
||||
"elm-community/list-extra": "8.2.3",
|
||||
"elm-community/maybe-extra": "5.2.0",
|
||||
"elm-community/random-extra": "3.1.0",
|
||||
"justinmimbs/date": "3.2.1",
|
||||
"krisajenkins/remotedata": "6.0.1",
|
||||
"ryannhg/date-format": "2.3.0"
|
||||
},
|
||||
"indirect": {
|
||||
"elm/bytes": "1.0.8",
|
||||
"elm/file": "1.0.5",
|
||||
"elm/parser": "1.1.0",
|
||||
"elm/virtual-dom": "1.0.2",
|
||||
"owanturist/elm-union-find": "1.0.0",
|
||||
"rtfeldman/elm-iso8601-date-strings": "1.1.3"
|
||||
}
|
||||
},
|
||||
"test-dependencies": {
|
||||
"direct": {},
|
||||
"indirect": {}
|
||||
}
|
||||
}
|
142
users/wpcarro/assessments/tt/client/index.css
Normal file
142
users/wpcarro/assessments/tt/client/index.css
Normal file
|
@ -0,0 +1,142 @@
|
|||
@tailwind base;
|
||||
@tailwind components;
|
||||
@tailwind utilities;
|
||||
|
||||
.elm-datepicker--container {
|
||||
position: relative;
|
||||
}
|
||||
|
||||
.elm-datepicker--input:focus {
|
||||
outline: 0;
|
||||
}
|
||||
|
||||
.elm-datepicker--picker {
|
||||
position: absolute;
|
||||
border: 1px solid #CCC;
|
||||
z-index: 10;
|
||||
background-color: white;
|
||||
}
|
||||
|
||||
.elm-datepicker--picker-header,
|
||||
.elm-datepicker--weekdays {
|
||||
background: #F2F2F2;
|
||||
}
|
||||
|
||||
.elm-datepicker--picker-header {
|
||||
display: flex;
|
||||
align-items: center;
|
||||
}
|
||||
|
||||
.elm-datepicker--prev-container,
|
||||
.elm-datepicker--next-container {
|
||||
flex: 0 1 auto;
|
||||
cursor: pointer;
|
||||
}
|
||||
|
||||
.elm-datepicker--month-container {
|
||||
flex: 1 1 auto;
|
||||
padding: 0.5em;
|
||||
display: flex;
|
||||
flex-direction: column;
|
||||
}
|
||||
|
||||
.elm-datepicker--month,
|
||||
.elm-datepicker--year {
|
||||
flex: 1 1 auto;
|
||||
cursor: default;
|
||||
text-align: center;
|
||||
}
|
||||
|
||||
.elm-datepicker--year {
|
||||
font-size: 0.6em;
|
||||
font-weight: 700;
|
||||
}
|
||||
|
||||
.elm-datepicker--prev,
|
||||
.elm-datepicker--next {
|
||||
border: 6px solid transparent;
|
||||
background-color: inherit;
|
||||
display: block;
|
||||
width: 0;
|
||||
height: 0;
|
||||
padding: 0 0.2em;
|
||||
}
|
||||
|
||||
.elm-datepicker--prev {
|
||||
border-right-color: #AAA;
|
||||
}
|
||||
|
||||
.elm-datepicker--prev:hover {
|
||||
border-right-color: #BBB;
|
||||
}
|
||||
|
||||
.elm-datepicker--next {
|
||||
border-left-color: #AAA;
|
||||
}
|
||||
|
||||
.elm-datepicker--next:hover {
|
||||
border-left-color: #BBB;
|
||||
}
|
||||
|
||||
.elm-datepicker--table {
|
||||
border-spacing: 0;
|
||||
border-collapse: collapse;
|
||||
font-size: 0.8em;
|
||||
}
|
||||
|
||||
.elm-datepicker--table td {
|
||||
width: 2em;
|
||||
height: 2em;
|
||||
text-align: center;
|
||||
}
|
||||
|
||||
.elm-datepicker--row {
|
||||
border-top: 1px solid #F2F2F2;
|
||||
}
|
||||
|
||||
.elm-datepicker--dow {
|
||||
border-bottom: 1px solid #CCC;
|
||||
cursor: default;
|
||||
}
|
||||
|
||||
.elm-datepicker--day {
|
||||
cursor: pointer;
|
||||
}
|
||||
|
||||
.elm-datepicker--day:hover {
|
||||
background: #F2F2F2;
|
||||
}
|
||||
|
||||
.elm-datepicker--disabled {
|
||||
cursor: default;
|
||||
color: #DDD;
|
||||
}
|
||||
|
||||
.elm-datepicker--disabled:hover {
|
||||
background: inherit;
|
||||
}
|
||||
|
||||
.elm-datepicker--picked {
|
||||
color: white;
|
||||
background: darkblue;
|
||||
}
|
||||
|
||||
.elm-datepicker--picked:hover {
|
||||
background: darkblue;
|
||||
}
|
||||
|
||||
.elm-datepicker--today {
|
||||
font-weight: bold;
|
||||
}
|
||||
|
||||
.elm-datepicker--other-month {
|
||||
color: #AAA;
|
||||
}
|
||||
|
||||
.elm-datepicker--other-month.elm-datepicker--disabled {
|
||||
color: #EEE;
|
||||
}
|
||||
|
||||
.elm-datepicker--other-month.elm-datepicker--picked {
|
||||
color: white;
|
||||
}
|
38
users/wpcarro/assessments/tt/client/index.html
Normal file
38
users/wpcarro/assessments/tt/client/index.html
Normal file
|
@ -0,0 +1,38 @@
|
|||
<!DOCTYPE html>
|
||||
<html lang="en">
|
||||
<head>
|
||||
<meta charset="UTF-8" />
|
||||
<meta name="google-signin-client_id" content="580018768696-4beppspj6cu7rhjnfgok8lbmh9a4n3ok.apps.googleusercontent.com">
|
||||
<title>Elm SPA</title>
|
||||
<link rel="stylesheet" type="text/css" href="./output.css" />
|
||||
<link rel="stylesheet" type="text/css" href="./print.css" media="print" />
|
||||
<script src="https://apis.google.com/js/platform.js" async defer></script>
|
||||
<script src="./Main.min.js"></script>
|
||||
</head>
|
||||
<body class="font-serif">
|
||||
<div id="mount"></div>
|
||||
<script>
|
||||
function onSignIn(googleUser) {
|
||||
console.log(googleUser);
|
||||
}
|
||||
|
||||
var app = Elm.Main.init({node: document.getElementById("mount")});
|
||||
|
||||
app.ports.printPage.subscribe(function() {
|
||||
window.print();
|
||||
});
|
||||
|
||||
app.ports.googleSignIn.subscribe(function() {
|
||||
var auth2 = gapi.auth2.getAuthInstance();
|
||||
var googleUser = auth2.signIn();
|
||||
});
|
||||
|
||||
app.ports.googleSignOut.subscribe(function() {
|
||||
var auth2 = gapi.auth2.getAuthInstance();
|
||||
auth2.signOut().then(function() {
|
||||
console.log('Google user successfully signed out.');
|
||||
});
|
||||
});
|
||||
</script>
|
||||
</body>
|
||||
</html>
|
3
users/wpcarro/assessments/tt/client/print.css
Normal file
3
users/wpcarro/assessments/tt/client/print.css
Normal file
|
@ -0,0 +1,3 @@
|
|||
.no-print {
|
||||
display: none;
|
||||
}
|
10
users/wpcarro/assessments/tt/client/shell.nix
Normal file
10
users/wpcarro/assessments/tt/client/shell.nix
Normal file
|
@ -0,0 +1,10 @@
|
|||
let
|
||||
pkgs = import <nixpkgs> {};
|
||||
in pkgs.mkShell {
|
||||
buildInputs = with pkgs; [
|
||||
nodejs
|
||||
elmPackages.elm
|
||||
elmPackages.elm-format
|
||||
elmPackages.elm-live
|
||||
];
|
||||
}
|
189
users/wpcarro/assessments/tt/client/src/Admin.elm
Normal file
189
users/wpcarro/assessments/tt/client/src/Admin.elm
Normal file
|
@ -0,0 +1,189 @@
|
|||
module Admin exposing (render)
|
||||
|
||||
import Common
|
||||
import Date
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (..)
|
||||
import Maybe.Extra as ME
|
||||
import RemoteData
|
||||
import State
|
||||
import Tailwind
|
||||
import UI
|
||||
import Utils
|
||||
|
||||
|
||||
roleToggle : State.Model -> State.Role -> Html State.Msg
|
||||
roleToggle model role =
|
||||
div [ [ "px-1", "inline" ] |> Tailwind.use |> class ]
|
||||
[ UI.toggleButton
|
||||
{ toggled = model.inviteRole == Just role
|
||||
, label = State.roleToString role
|
||||
, handleEnable = State.UpdateInviteRole (Just role)
|
||||
, handleDisable = State.UpdateInviteRole Nothing
|
||||
}
|
||||
]
|
||||
|
||||
|
||||
inviteUser : State.Model -> Html State.Msg
|
||||
inviteUser model =
|
||||
div [ [ "pb-6" ] |> Tailwind.use |> class ]
|
||||
[ UI.header 3 "Invite a user"
|
||||
, UI.textField
|
||||
{ handleInput = State.UpdateInviteEmail
|
||||
, inputId = "invite-email"
|
||||
, inputValue = model.inviteEmail
|
||||
, pholder = "Email..."
|
||||
}
|
||||
, div [ [ "pt-4" ] |> Tailwind.use |> class ]
|
||||
[ roleToggle model State.User
|
||||
, roleToggle model State.Manager
|
||||
, roleToggle model State.Admin
|
||||
]
|
||||
, UI.baseButton
|
||||
{ enabled =
|
||||
List.all
|
||||
identity
|
||||
[ String.length model.inviteEmail > 0
|
||||
, ME.isJust model.inviteRole
|
||||
]
|
||||
, extraClasses = [ "my-4" ]
|
||||
, label =
|
||||
case model.inviteResponseStatus of
|
||||
RemoteData.Loading ->
|
||||
"Sending..."
|
||||
|
||||
_ ->
|
||||
"Send invitation"
|
||||
, handleClick =
|
||||
case model.inviteRole of
|
||||
Nothing ->
|
||||
State.DoNothing
|
||||
|
||||
Just role ->
|
||||
State.AttemptInviteUser role
|
||||
}
|
||||
]
|
||||
|
||||
|
||||
allTrips : State.Model -> Html State.Msg
|
||||
allTrips model =
|
||||
case model.trips of
|
||||
RemoteData.NotAsked ->
|
||||
UI.absentData { handleFetch = State.AttemptGetTrips }
|
||||
|
||||
RemoteData.Loading ->
|
||||
UI.paragraph "Loading..."
|
||||
|
||||
RemoteData.Failure e ->
|
||||
UI.paragraph ("Error: " ++ Utils.explainHttpError e)
|
||||
|
||||
RemoteData.Success xs ->
|
||||
ul []
|
||||
(xs
|
||||
|> List.map
|
||||
(\trip ->
|
||||
li []
|
||||
[ UI.paragraph (Date.toIsoString trip.startDate ++ " - " ++ Date.toIsoString trip.endDate ++ ", " ++ trip.username ++ " is going " ++ trip.destination)
|
||||
, UI.textButton
|
||||
{ label = "delete"
|
||||
, handleClick = State.AttemptDeleteTrip trip
|
||||
}
|
||||
]
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
allUsers : State.Model -> Html State.Msg
|
||||
allUsers model =
|
||||
case model.accounts of
|
||||
RemoteData.NotAsked ->
|
||||
UI.absentData { handleFetch = State.AttemptGetAccounts }
|
||||
|
||||
RemoteData.Loading ->
|
||||
UI.paragraph "Loading..."
|
||||
|
||||
RemoteData.Failure e ->
|
||||
UI.paragraph ("Error: " ++ Utils.explainHttpError e)
|
||||
|
||||
RemoteData.Success xs ->
|
||||
ul []
|
||||
(xs
|
||||
|> List.map
|
||||
(\account ->
|
||||
li []
|
||||
[ UI.paragraph
|
||||
(account.username
|
||||
++ " - "
|
||||
++ State.roleToString account.role
|
||||
)
|
||||
, UI.textButton
|
||||
{ label = "delete"
|
||||
, handleClick = State.AttemptDeleteAccount account.username
|
||||
}
|
||||
]
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
users : List String -> Html State.Msg
|
||||
users xs =
|
||||
ul []
|
||||
(xs
|
||||
|> List.map
|
||||
(\x ->
|
||||
li [ [ "py-4", "flex" ] |> Tailwind.use |> class ]
|
||||
[ p [ [ "flex-1" ] |> Tailwind.use |> class ] [ text x ]
|
||||
, div [ [ "flex-1" ] |> Tailwind.use |> class ]
|
||||
[ UI.simpleButton
|
||||
{ label = "Delete"
|
||||
, handleClick = State.AttemptDeleteAccount x
|
||||
}
|
||||
]
|
||||
]
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
render : State.Model -> Html State.Msg
|
||||
render model =
|
||||
div
|
||||
[ [ "container"
|
||||
, "mx-auto"
|
||||
, "text-center"
|
||||
]
|
||||
|> Tailwind.use
|
||||
|> class
|
||||
]
|
||||
[ UI.header 2 "Welcome!"
|
||||
, div []
|
||||
[ UI.textButton
|
||||
{ label = "Logout"
|
||||
, handleClick = State.AttemptLogout
|
||||
}
|
||||
]
|
||||
, div [ [ "py-3" ] |> Tailwind.use |> class ]
|
||||
[ case model.adminTab of
|
||||
State.Accounts ->
|
||||
UI.textButton
|
||||
{ label = "Switch to trips"
|
||||
, handleClick = State.UpdateAdminTab State.Trips
|
||||
}
|
||||
|
||||
State.Trips ->
|
||||
UI.textButton
|
||||
{ label = "Switch to accounts"
|
||||
, handleClick = State.UpdateAdminTab State.Accounts
|
||||
}
|
||||
]
|
||||
, case model.adminTab of
|
||||
State.Accounts ->
|
||||
div []
|
||||
[ inviteUser model
|
||||
, allUsers model
|
||||
]
|
||||
|
||||
State.Trips ->
|
||||
allTrips model
|
||||
, Common.allErrors model
|
||||
]
|
37
users/wpcarro/assessments/tt/client/src/Common.elm
Normal file
37
users/wpcarro/assessments/tt/client/src/Common.elm
Normal file
|
@ -0,0 +1,37 @@
|
|||
module Common exposing (..)
|
||||
|
||||
import Html exposing (..)
|
||||
import Maybe.Extra as ME
|
||||
import State
|
||||
import UI
|
||||
import Utils
|
||||
|
||||
|
||||
allErrors : State.Model -> Html State.Msg
|
||||
allErrors model =
|
||||
div []
|
||||
(State.allErrors
|
||||
model
|
||||
|> List.map
|
||||
(\( mError, title ) ->
|
||||
case mError of
|
||||
Nothing ->
|
||||
text ""
|
||||
|
||||
Just err ->
|
||||
UI.errorBanner
|
||||
{ title = title
|
||||
, body = Utils.explainHttpError err
|
||||
}
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
withSession : State.Model -> (State.Session -> Html State.Msg) -> Html State.Msg
|
||||
withSession model renderWithSession =
|
||||
case model.session of
|
||||
Nothing ->
|
||||
div [] [ UI.paragraph "You need a valid session to view this page. Please attempt to log in." ]
|
||||
|
||||
Just session ->
|
||||
renderWithSession session
|
199
users/wpcarro/assessments/tt/client/src/Login.elm
Normal file
199
users/wpcarro/assessments/tt/client/src/Login.elm
Normal file
|
@ -0,0 +1,199 @@
|
|||
module Login exposing (render)
|
||||
|
||||
import Common
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (..)
|
||||
import State
|
||||
import Tailwind
|
||||
import UI
|
||||
import Utils
|
||||
|
||||
|
||||
googleSignIn : Html State.Msg
|
||||
googleSignIn =
|
||||
div
|
||||
[ class "g-signin2"
|
||||
, attribute "onsuccess" "onSignIn"
|
||||
, onClick State.GoogleSignIn
|
||||
]
|
||||
[]
|
||||
|
||||
|
||||
loginForm : State.Model -> Html State.Msg
|
||||
loginForm model =
|
||||
div
|
||||
[ [ "w-full"
|
||||
, "max-w-xs"
|
||||
, "mx-auto"
|
||||
]
|
||||
|> Tailwind.use
|
||||
|> class
|
||||
]
|
||||
[ div
|
||||
[ [ "bg-white"
|
||||
, "shadow-md"
|
||||
, "rounded"
|
||||
, "px-8"
|
||||
, "pt-6"
|
||||
, "pb-8"
|
||||
, "mb-4"
|
||||
, "text-left"
|
||||
]
|
||||
|> Tailwind.use
|
||||
|> class
|
||||
]
|
||||
[ div [ [ "text-center", "pb-6" ] |> Tailwind.use |> class ]
|
||||
[ UI.textButton
|
||||
{ handleClick = State.ToggleLoginForm
|
||||
, label =
|
||||
case model.loginTab of
|
||||
State.LoginForm ->
|
||||
"Switch to sign up"
|
||||
|
||||
State.SignUpForm ->
|
||||
"Switch to login"
|
||||
}
|
||||
]
|
||||
, div
|
||||
[ [ "mb-4" ] |> Tailwind.use |> class ]
|
||||
[ UI.label_ { for_ = "username", text_ = "Username" }
|
||||
, UI.textField
|
||||
{ inputId = "Username"
|
||||
, pholder = "Username"
|
||||
, handleInput = State.UpdateUsername
|
||||
, inputValue = model.username
|
||||
}
|
||||
]
|
||||
, case model.loginTab of
|
||||
State.LoginForm ->
|
||||
text ""
|
||||
|
||||
State.SignUpForm ->
|
||||
div
|
||||
[ [ "mb-4" ] |> Tailwind.use |> class ]
|
||||
[ UI.label_ { for_ = "email", text_ = "Email" }
|
||||
, input
|
||||
[ [ "shadow"
|
||||
, "appearance-none"
|
||||
, "border"
|
||||
, "rounded"
|
||||
, "w-full"
|
||||
, "py-2"
|
||||
, "px-3"
|
||||
, "text-gray-700"
|
||||
, "leading-tight"
|
||||
, "focus:outline-none"
|
||||
, "focus:shadow-outline"
|
||||
]
|
||||
|> Tailwind.use
|
||||
|> class
|
||||
, id "email"
|
||||
, placeholder "who@domain.tld"
|
||||
, onInput State.UpdateEmail
|
||||
]
|
||||
[]
|
||||
]
|
||||
, div
|
||||
[ [ "mb-4" ] |> Tailwind.use |> class ]
|
||||
[ UI.label_ { for_ = "password", text_ = "Password" }
|
||||
, input
|
||||
[ [ "shadow"
|
||||
, "appearance-none"
|
||||
, "border"
|
||||
, "rounded"
|
||||
, "w-full"
|
||||
, "py-2"
|
||||
, "px-3"
|
||||
, "text-gray-700"
|
||||
, "leading-tight"
|
||||
, "focus:outline-none"
|
||||
, "focus:shadow-outline"
|
||||
]
|
||||
|> Tailwind.use
|
||||
|> class
|
||||
, id "password"
|
||||
, type_ "password"
|
||||
, placeholder "******************"
|
||||
, onInput State.UpdatePassword
|
||||
]
|
||||
[]
|
||||
]
|
||||
, case model.loginTab of
|
||||
State.LoginForm ->
|
||||
div [ [ "flex", "space-around" ] |> Tailwind.use |> class ]
|
||||
[ UI.simpleButton
|
||||
{ handleClick = State.AttemptLogin
|
||||
, label = "Login"
|
||||
}
|
||||
, div [ [ "pl-4" ] |> Tailwind.use |> class ] [ googleSignIn ]
|
||||
]
|
||||
|
||||
State.SignUpForm ->
|
||||
if
|
||||
List.all identity
|
||||
[ String.length model.username > 0
|
||||
, String.length model.email > 0
|
||||
, String.length model.password > 0
|
||||
]
|
||||
then
|
||||
div []
|
||||
[ UI.simpleButton
|
||||
{ handleClick = State.AttemptSignUp
|
||||
, label = "Sign up"
|
||||
}
|
||||
]
|
||||
|
||||
else
|
||||
UI.disabledButton { label = "Sign up" }
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
login :
|
||||
State.Model
|
||||
-> Html State.Msg
|
||||
login model =
|
||||
div
|
||||
[ [ "text-center"
|
||||
, "py-20"
|
||||
, "bg-gray-200"
|
||||
, "h-screen"
|
||||
]
|
||||
|> Tailwind.use
|
||||
|> class
|
||||
]
|
||||
[ UI.header 3 "Welcome to Trip Planner"
|
||||
, loginForm model
|
||||
, Common.allErrors model
|
||||
]
|
||||
|
||||
|
||||
logout : State.Model -> Html State.Msg
|
||||
logout model =
|
||||
div
|
||||
[ [ "text-center"
|
||||
, "py-20"
|
||||
, "bg-gray-200"
|
||||
, "h-screen"
|
||||
]
|
||||
|> Tailwind.use
|
||||
|> class
|
||||
]
|
||||
[ UI.header 3 "Looks like you're already signed in..."
|
||||
, UI.simpleButton
|
||||
{ label = "Logout"
|
||||
, handleClick = State.AttemptLogout
|
||||
}
|
||||
, Common.allErrors model
|
||||
]
|
||||
|
||||
|
||||
render : State.Model -> Html State.Msg
|
||||
render model =
|
||||
case model.session of
|
||||
Nothing ->
|
||||
login model
|
||||
|
||||
Just x ->
|
||||
logout model
|
62
users/wpcarro/assessments/tt/client/src/Main.elm
Normal file
62
users/wpcarro/assessments/tt/client/src/Main.elm
Normal file
|
@ -0,0 +1,62 @@
|
|||
module Main exposing (main)
|
||||
|
||||
import Admin
|
||||
import Browser
|
||||
import Html exposing (..)
|
||||
import Login
|
||||
import Manager
|
||||
import State
|
||||
import Url
|
||||
import User
|
||||
|
||||
|
||||
viewForRoute : State.Route -> (State.Model -> Html State.Msg)
|
||||
viewForRoute route =
|
||||
case route of
|
||||
State.Login ->
|
||||
Login.render
|
||||
|
||||
State.UserHome ->
|
||||
User.render
|
||||
|
||||
State.ManagerHome ->
|
||||
Manager.render
|
||||
|
||||
State.AdminHome ->
|
||||
Admin.render
|
||||
|
||||
|
||||
view : State.Model -> Browser.Document State.Msg
|
||||
view model =
|
||||
{ title = "TripPlanner"
|
||||
, body =
|
||||
[ case ( model.session, model.route ) of
|
||||
-- Redirect to /login when someone is not authenticated.
|
||||
-- TODO(wpcarro): We should ensure that /login shows in the URL
|
||||
-- bar.
|
||||
( Nothing, _ ) ->
|
||||
Login.render model
|
||||
|
||||
( Just session, Nothing ) ->
|
||||
Login.render model
|
||||
|
||||
-- Authenticated
|
||||
( Just session, Just route ) ->
|
||||
if State.isAuthorized session.role route then
|
||||
viewForRoute route model
|
||||
|
||||
else
|
||||
text "Access denied. You are not authorized to be here. Evacuate the area immediately"
|
||||
]
|
||||
}
|
||||
|
||||
|
||||
main =
|
||||
Browser.application
|
||||
{ init = State.init
|
||||
, onUrlChange = State.UrlChanged
|
||||
, onUrlRequest = State.LinkClicked
|
||||
, subscriptions = \_ -> Sub.none
|
||||
, update = State.update
|
||||
, view = view
|
||||
}
|
70
users/wpcarro/assessments/tt/client/src/Manager.elm
Normal file
70
users/wpcarro/assessments/tt/client/src/Manager.elm
Normal file
|
@ -0,0 +1,70 @@
|
|||
module Manager exposing (render)
|
||||
|
||||
import Array
|
||||
import Common
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (..)
|
||||
import RemoteData
|
||||
import State
|
||||
import Tailwind
|
||||
import UI
|
||||
import Utils
|
||||
|
||||
|
||||
allUsers : State.Model -> Html State.Msg
|
||||
allUsers model =
|
||||
case model.accounts of
|
||||
RemoteData.NotAsked ->
|
||||
UI.absentData { handleFetch = State.AttemptGetAccounts }
|
||||
|
||||
RemoteData.Loading ->
|
||||
UI.paragraph "Loading..."
|
||||
|
||||
RemoteData.Failure e ->
|
||||
UI.paragraph ("Error: " ++ Utils.explainHttpError e)
|
||||
|
||||
RemoteData.Success xs ->
|
||||
ul []
|
||||
(xs
|
||||
|> List.map
|
||||
(\account ->
|
||||
li []
|
||||
[ UI.paragraph
|
||||
(account.username
|
||||
++ " - "
|
||||
++ State.roleToString account.role
|
||||
)
|
||||
, UI.textButton
|
||||
{ label = "delete"
|
||||
, handleClick = State.AttemptDeleteAccount account.username
|
||||
}
|
||||
]
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
render : State.Model -> Html State.Msg
|
||||
render model =
|
||||
Common.withSession model
|
||||
(\session ->
|
||||
div
|
||||
[ class
|
||||
([ "container"
|
||||
, "mx-auto"
|
||||
, "text-center"
|
||||
]
|
||||
|> Tailwind.use
|
||||
)
|
||||
]
|
||||
[ h1 []
|
||||
[ UI.header 2 ("Welcome back, " ++ session.username ++ "!")
|
||||
, UI.textButton
|
||||
{ label = "Logout"
|
||||
, handleClick = State.AttemptLogout
|
||||
}
|
||||
, allUsers model
|
||||
, Common.allErrors model
|
||||
]
|
||||
]
|
||||
)
|
7
users/wpcarro/assessments/tt/client/src/Shared.elm
Normal file
7
users/wpcarro/assessments/tt/client/src/Shared.elm
Normal file
|
@ -0,0 +1,7 @@
|
|||
module Shared exposing (..)
|
||||
|
||||
clientOrigin =
|
||||
"http://localhost:8000"
|
||||
|
||||
serverOrigin =
|
||||
"http://localhost:3000"
|
1014
users/wpcarro/assessments/tt/client/src/State.elm
Normal file
1014
users/wpcarro/assessments/tt/client/src/State.elm
Normal file
File diff suppressed because it is too large
Load diff
29
users/wpcarro/assessments/tt/client/src/Tailwind.elm
Normal file
29
users/wpcarro/assessments/tt/client/src/Tailwind.elm
Normal file
|
@ -0,0 +1,29 @@
|
|||
module Tailwind exposing (..)
|
||||
|
||||
{-| Functions to make Tailwind development in Elm even more pleasant.
|
||||
-}
|
||||
|
||||
|
||||
{-| Conditionally use `class` selection when `condition` is true.
|
||||
-}
|
||||
when : Bool -> String -> String
|
||||
when condition class =
|
||||
if condition then
|
||||
class
|
||||
|
||||
else
|
||||
""
|
||||
|
||||
|
||||
if_ : Bool -> String -> String -> String
|
||||
if_ condition whenTrue whenFalse =
|
||||
if condition then
|
||||
whenTrue
|
||||
|
||||
else
|
||||
whenFalse
|
||||
|
||||
|
||||
use : List String -> String
|
||||
use styles =
|
||||
String.join " " styles
|
318
users/wpcarro/assessments/tt/client/src/UI.elm
Normal file
318
users/wpcarro/assessments/tt/client/src/UI.elm
Normal file
|
@ -0,0 +1,318 @@
|
|||
module UI exposing (..)
|
||||
|
||||
import Date
|
||||
import DatePicker exposing (defaultSettings)
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (..)
|
||||
import State
|
||||
import Tailwind
|
||||
|
||||
|
||||
label_ : { for_ : String, text_ : String } -> Html msg
|
||||
label_ { for_, text_ } =
|
||||
label
|
||||
[ [ "block"
|
||||
, "text-gray-700"
|
||||
, "text-sm"
|
||||
, "font-bold"
|
||||
, "mb-2"
|
||||
]
|
||||
|> Tailwind.use
|
||||
|> class
|
||||
, for for_
|
||||
]
|
||||
[ text text_ ]
|
||||
|
||||
|
||||
errorBanner : { title : String, body : String } -> Html msg
|
||||
errorBanner { title, body } =
|
||||
div
|
||||
[ [ "text-left"
|
||||
, "fixed"
|
||||
, "container"
|
||||
, "top-0"
|
||||
, "mt-6"
|
||||
]
|
||||
|> Tailwind.use
|
||||
|> class
|
||||
, style "left" "50%"
|
||||
|
||||
-- TODO(wpcarro): Consider supporting breakpoints, but for now
|
||||
-- don't.
|
||||
, style "width" "800px"
|
||||
, style "margin-left" "-400px"
|
||||
]
|
||||
[ div
|
||||
[ [ "bg-red-500"
|
||||
, "text-white"
|
||||
, "font-bold"
|
||||
, "rounded-t"
|
||||
, "px-4"
|
||||
, "py-2"
|
||||
]
|
||||
|> Tailwind.use
|
||||
|> class
|
||||
]
|
||||
[ text title ]
|
||||
, div
|
||||
[ [ "border"
|
||||
, "border-t-0"
|
||||
, "border-red-400"
|
||||
, "rounded-b"
|
||||
, "bg-red-100"
|
||||
, "px-4"
|
||||
, "py-3"
|
||||
, "text-red-700"
|
||||
]
|
||||
|> Tailwind.use
|
||||
|> class
|
||||
]
|
||||
[ p [] [ text body ] ]
|
||||
]
|
||||
|
||||
|
||||
baseButton :
|
||||
{ label : String
|
||||
, enabled : Bool
|
||||
, handleClick : msg
|
||||
, extraClasses : List String
|
||||
}
|
||||
-> Html msg
|
||||
baseButton { label, enabled, handleClick, extraClasses } =
|
||||
button
|
||||
[ [ if enabled then
|
||||
"bg-blue-500"
|
||||
|
||||
else
|
||||
"bg-gray-500"
|
||||
, if enabled then
|
||||
"hover:bg-blue-700"
|
||||
|
||||
else
|
||||
""
|
||||
, if enabled then
|
||||
""
|
||||
|
||||
else
|
||||
"cursor-not-allowed"
|
||||
, "text-white"
|
||||
, "font-bold"
|
||||
, "py-1"
|
||||
, "shadow-lg"
|
||||
, "px-4"
|
||||
, "rounded"
|
||||
, "focus:outline-none"
|
||||
, "focus:shadow-outline"
|
||||
]
|
||||
++ extraClasses
|
||||
|> Tailwind.use
|
||||
|> class
|
||||
, onClick handleClick
|
||||
, disabled (not enabled)
|
||||
]
|
||||
[ text label ]
|
||||
|
||||
|
||||
simpleButton :
|
||||
{ label : String
|
||||
, handleClick : msg
|
||||
}
|
||||
-> Html msg
|
||||
simpleButton { label, handleClick } =
|
||||
baseButton
|
||||
{ label = label
|
||||
, enabled = True
|
||||
, handleClick = handleClick
|
||||
, extraClasses = []
|
||||
}
|
||||
|
||||
|
||||
disabledButton :
|
||||
{ label : String }
|
||||
-> Html State.Msg
|
||||
disabledButton { label } =
|
||||
baseButton
|
||||
{ label = label
|
||||
, enabled = False
|
||||
, handleClick = State.DoNothing
|
||||
, extraClasses = []
|
||||
}
|
||||
|
||||
|
||||
textButton :
|
||||
{ label : String
|
||||
, handleClick : msg
|
||||
}
|
||||
-> Html msg
|
||||
textButton { label, handleClick } =
|
||||
button
|
||||
[ [ "text-blue-600"
|
||||
, "hover:text-blue-500"
|
||||
, "font-bold"
|
||||
, "hover:underline"
|
||||
, "focus:outline-none"
|
||||
]
|
||||
|> Tailwind.use
|
||||
|> class
|
||||
, onClick handleClick
|
||||
]
|
||||
[ text label ]
|
||||
|
||||
|
||||
textField :
|
||||
{ pholder : String
|
||||
, inputId : String
|
||||
, handleInput : String -> msg
|
||||
, inputValue : String
|
||||
}
|
||||
-> Html msg
|
||||
textField { pholder, inputId, handleInput, inputValue } =
|
||||
input
|
||||
[ [ "shadow"
|
||||
, "appearance-none"
|
||||
, "border"
|
||||
, "rounded"
|
||||
, "w-full"
|
||||
, "py-2"
|
||||
, "px-3"
|
||||
, "text-gray-700"
|
||||
, "leading-tight"
|
||||
, "focus:outline-none"
|
||||
, "focus:shadow-outline"
|
||||
]
|
||||
|> Tailwind.use
|
||||
|> class
|
||||
, id inputId
|
||||
, value inputValue
|
||||
, placeholder pholder
|
||||
, onInput handleInput
|
||||
]
|
||||
[]
|
||||
|
||||
|
||||
toggleButton :
|
||||
{ toggled : Bool
|
||||
, label : String
|
||||
, handleEnable : msg
|
||||
, handleDisable : msg
|
||||
}
|
||||
-> Html msg
|
||||
toggleButton { toggled, label, handleEnable, handleDisable } =
|
||||
button
|
||||
[ [ if toggled then
|
||||
"bg-blue-700"
|
||||
|
||||
else
|
||||
"bg-blue-500"
|
||||
, "hover:bg-blue-700"
|
||||
, "text-white"
|
||||
, "font-bold"
|
||||
, "py-2"
|
||||
, "px-4"
|
||||
, "rounded"
|
||||
, "focus:outline-none"
|
||||
, "focus:shadow-outline"
|
||||
]
|
||||
|> Tailwind.use
|
||||
|> class
|
||||
, onClick
|
||||
(if toggled then
|
||||
handleDisable
|
||||
|
||||
else
|
||||
handleEnable
|
||||
)
|
||||
]
|
||||
[ text label ]
|
||||
|
||||
|
||||
paragraph : String -> Html msg
|
||||
paragraph x =
|
||||
p [ [ "text-xl" ] |> Tailwind.use |> class ] [ text x ]
|
||||
|
||||
|
||||
header : Int -> String -> Html msg
|
||||
header which x =
|
||||
let
|
||||
hStyles =
|
||||
case which of
|
||||
1 ->
|
||||
[ "text-6xl"
|
||||
, "py-12"
|
||||
]
|
||||
|
||||
2 ->
|
||||
[ "text-3xl"
|
||||
, "py-6"
|
||||
]
|
||||
|
||||
_ ->
|
||||
[ "text-2xl"
|
||||
, "py-2"
|
||||
]
|
||||
in
|
||||
h1
|
||||
[ hStyles
|
||||
++ [ "font-bold"
|
||||
, "text-gray-700"
|
||||
]
|
||||
|> Tailwind.use
|
||||
|> class
|
||||
]
|
||||
[ text x ]
|
||||
|
||||
|
||||
link : String -> String -> Html msg
|
||||
link path label =
|
||||
a
|
||||
[ href path
|
||||
, [ "underline"
|
||||
, "text-blue-600"
|
||||
, "text-xl"
|
||||
]
|
||||
|> Tailwind.use
|
||||
|> class
|
||||
]
|
||||
[ text label ]
|
||||
|
||||
|
||||
absentData : { handleFetch : msg } -> Html msg
|
||||
absentData { handleFetch } =
|
||||
div []
|
||||
[ paragraph "Welp... it looks like you've caught us in a state that we considered impossible: we did not fetch the data upon which this page depends. Maybe you can help us out by clicking the super secret, highly privileged \"Fetch data\" button below (we don't normally show people this)."
|
||||
, div [ [ "py-4" ] |> Tailwind.use |> class ]
|
||||
[ simpleButton
|
||||
{ label = "Fetch data"
|
||||
, handleClick = handleFetch
|
||||
}
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
datePicker :
|
||||
{ mDate : Maybe Date.Date
|
||||
, prompt : String
|
||||
, prefix : String
|
||||
, picker : DatePicker.DatePicker
|
||||
, onUpdate : DatePicker.Msg -> State.Msg
|
||||
}
|
||||
-> Html State.Msg
|
||||
datePicker { mDate, prompt, prefix, picker, onUpdate } =
|
||||
let
|
||||
settings =
|
||||
{ defaultSettings
|
||||
| placeholder = prompt
|
||||
, inputClassList =
|
||||
[ ( "text-center", True )
|
||||
, ( "py-2", True )
|
||||
]
|
||||
}
|
||||
in
|
||||
div [ [ "w-1/2", "py-4", "mx-auto" ] |> Tailwind.use |> class ]
|
||||
[ DatePicker.view mDate settings picker |> Html.map onUpdate ]
|
||||
|
||||
|
||||
wrapNoPrint : Html State.Msg -> Html State.Msg
|
||||
wrapNoPrint component =
|
||||
div [ [ "no-print" ] |> Tailwind.use |> class ] [ component ]
|
245
users/wpcarro/assessments/tt/client/src/User.elm
Normal file
245
users/wpcarro/assessments/tt/client/src/User.elm
Normal file
|
@ -0,0 +1,245 @@
|
|||
module User exposing (render)
|
||||
|
||||
import Common
|
||||
import Date
|
||||
import DatePicker
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (..)
|
||||
import Maybe.Extra as ME
|
||||
import RemoteData
|
||||
import State
|
||||
import Tailwind
|
||||
import UI
|
||||
import Utils
|
||||
|
||||
|
||||
createTrip : State.Model -> Html State.Msg
|
||||
createTrip model =
|
||||
div []
|
||||
[ UI.header 3 "Plan Upcoming Trip"
|
||||
, UI.textField
|
||||
{ pholder = "Where are you going?"
|
||||
, inputId = "destination"
|
||||
, handleInput = State.UpdateTripDestination
|
||||
, inputValue = model.tripDestination
|
||||
}
|
||||
, div [ [ "flex" ] |> Tailwind.use |> class ]
|
||||
[ UI.datePicker
|
||||
{ mDate = model.tripStartDate
|
||||
, prompt = "Set departure date"
|
||||
, prefix = "Departure: "
|
||||
, picker = model.startDatePicker
|
||||
, onUpdate = State.UpdateTripStartDate
|
||||
}
|
||||
, UI.datePicker
|
||||
{ mDate = model.tripEndDate
|
||||
, prompt = "Set return date"
|
||||
, prefix = "Return: "
|
||||
, picker = model.endDatePicker
|
||||
, onUpdate = State.UpdateTripEndDate
|
||||
}
|
||||
]
|
||||
, UI.textField
|
||||
{ pholder = "Comments?"
|
||||
, inputId = "comment"
|
||||
, handleInput = State.UpdateTripComment
|
||||
, inputValue = model.tripComment
|
||||
}
|
||||
, UI.baseButton
|
||||
{ enabled =
|
||||
List.all
|
||||
identity
|
||||
[ String.length model.tripDestination > 0
|
||||
, String.length model.tripComment > 0
|
||||
, ME.isJust model.tripStartDate
|
||||
, ME.isJust model.tripEndDate
|
||||
]
|
||||
, extraClasses = [ "my-4" ]
|
||||
, handleClick =
|
||||
case ( model.tripStartDate, model.tripEndDate ) of
|
||||
( Nothing, _ ) ->
|
||||
State.DoNothing
|
||||
|
||||
( _, Nothing ) ->
|
||||
State.DoNothing
|
||||
|
||||
( Just startDate, Just endDate ) ->
|
||||
State.AttemptCreateTrip startDate endDate
|
||||
, label = "Schedule trip"
|
||||
}
|
||||
]
|
||||
|
||||
|
||||
renderEditTrip : State.Model -> State.Trip -> Html State.Msg
|
||||
renderEditTrip model trip =
|
||||
li []
|
||||
[ div []
|
||||
[ UI.textField
|
||||
{ handleInput = State.UpdateEditTripDestination
|
||||
, inputId = "edit-trip-destination"
|
||||
, inputValue = model.editTripDestination
|
||||
, pholder = "Destination"
|
||||
}
|
||||
, UI.textField
|
||||
{ handleInput = State.UpdateEditTripComment
|
||||
, inputId = "edit-trip-comment"
|
||||
, inputValue = model.editTripComment
|
||||
, pholder = "Comment"
|
||||
}
|
||||
]
|
||||
, div []
|
||||
[ UI.baseButton
|
||||
{ enabled =
|
||||
case model.updateTripStatus of
|
||||
RemoteData.Loading ->
|
||||
False
|
||||
|
||||
_ ->
|
||||
True
|
||||
, extraClasses = []
|
||||
, label =
|
||||
case model.updateTripStatus of
|
||||
RemoteData.Loading ->
|
||||
"Saving..."
|
||||
|
||||
_ ->
|
||||
"Save"
|
||||
, handleClick =
|
||||
State.AttemptUpdateTrip
|
||||
{ username = trip.username
|
||||
, destination = trip.destination
|
||||
, startDate = trip.startDate
|
||||
}
|
||||
{ username = trip.username
|
||||
, destination = model.editTripDestination
|
||||
, startDate = trip.startDate
|
||||
, endDate = trip.endDate
|
||||
, comment = model.editTripComment
|
||||
}
|
||||
}
|
||||
, UI.simpleButton
|
||||
{ label = "Cancel"
|
||||
, handleClick = State.CancelEditTrip
|
||||
}
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
renderTrip : Date.Date -> State.Trip -> Html State.Msg
|
||||
renderTrip today trip =
|
||||
li
|
||||
[ [ "py-2" ]
|
||||
|> Tailwind.use
|
||||
|> class
|
||||
]
|
||||
[ if Date.compare today trip.startDate == GT then
|
||||
UI.paragraph
|
||||
(String.fromInt (Date.diff Date.Days trip.startDate today)
|
||||
++ " days until you're travelling to "
|
||||
++ trip.destination
|
||||
++ " for "
|
||||
++ String.fromInt
|
||||
(Date.diff
|
||||
Date.Days
|
||||
trip.startDate
|
||||
trip.endDate
|
||||
)
|
||||
++ " days."
|
||||
)
|
||||
|
||||
else
|
||||
UI.paragraph
|
||||
(String.fromInt (Date.diff Date.Days today trip.endDate)
|
||||
++ " days ago you returned from your trip to "
|
||||
++ trip.destination
|
||||
)
|
||||
, UI.paragraph ("\"" ++ trip.comment ++ "\"")
|
||||
, UI.wrapNoPrint
|
||||
(UI.textButton
|
||||
{ label = "Edit"
|
||||
, handleClick = State.EditTrip trip
|
||||
}
|
||||
)
|
||||
, UI.wrapNoPrint
|
||||
(UI.textButton
|
||||
{ label = "Delete"
|
||||
, handleClick = State.AttemptDeleteTrip trip
|
||||
}
|
||||
)
|
||||
]
|
||||
|
||||
|
||||
trips : State.Model -> Html State.Msg
|
||||
trips model =
|
||||
div []
|
||||
[ UI.header 3 "Your Trips"
|
||||
, case model.trips of
|
||||
RemoteData.NotAsked ->
|
||||
UI.paragraph "Somehow we've reached the user home page without requesting your trips data. Please report this to our engineering team at bugs@tripplaner.tld"
|
||||
|
||||
RemoteData.Loading ->
|
||||
UI.paragraph "Loading your trips..."
|
||||
|
||||
RemoteData.Failure e ->
|
||||
UI.paragraph ("Error: " ++ Utils.explainHttpError e)
|
||||
|
||||
RemoteData.Success xs ->
|
||||
case model.todaysDate of
|
||||
Nothing ->
|
||||
text ""
|
||||
|
||||
Just today ->
|
||||
div [ [ "mb-10" ] |> Tailwind.use |> class ]
|
||||
[ ul [ [ "my-4" ] |> Tailwind.use |> class ]
|
||||
(xs
|
||||
|> List.sortWith (\x y -> Date.compare y.startDate x.startDate)
|
||||
|> List.map
|
||||
(\trip ->
|
||||
case model.editingTrip of
|
||||
Nothing ->
|
||||
renderTrip today trip
|
||||
|
||||
Just x ->
|
||||
if x == trip then
|
||||
renderEditTrip model trip
|
||||
|
||||
else
|
||||
renderTrip today trip
|
||||
)
|
||||
)
|
||||
, UI.wrapNoPrint
|
||||
(UI.simpleButton
|
||||
{ label = "Print iternary"
|
||||
, handleClick = State.PrintPage
|
||||
}
|
||||
)
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
render : State.Model -> Html State.Msg
|
||||
render model =
|
||||
Common.withSession model
|
||||
(\session ->
|
||||
div
|
||||
[ class
|
||||
([ "container"
|
||||
, "mx-auto"
|
||||
, "text-center"
|
||||
]
|
||||
|> Tailwind.use
|
||||
)
|
||||
]
|
||||
[ UI.wrapNoPrint (UI.header 2 ("Welcome, " ++ session.username ++ "!"))
|
||||
, UI.wrapNoPrint (createTrip model)
|
||||
, trips model
|
||||
, UI.wrapNoPrint
|
||||
(UI.textButton
|
||||
{ label = "Logout"
|
||||
, handleClick = State.AttemptLogout
|
||||
}
|
||||
)
|
||||
, Common.allErrors model
|
||||
]
|
||||
)
|
109
users/wpcarro/assessments/tt/client/src/Utils.elm
Normal file
109
users/wpcarro/assessments/tt/client/src/Utils.elm
Normal file
|
@ -0,0 +1,109 @@
|
|||
module Utils exposing (..)
|
||||
|
||||
import DateFormat
|
||||
import Http
|
||||
import Time
|
||||
import Shared
|
||||
|
||||
|
||||
explainHttpError : Http.Error -> String
|
||||
explainHttpError e =
|
||||
case e of
|
||||
Http.BadUrl _ ->
|
||||
"Bad URL: you may have supplied an improperly formatted URL"
|
||||
|
||||
Http.Timeout ->
|
||||
"Timeout: the resource you requested did not arrive within the interval of time that you claimed it should"
|
||||
|
||||
Http.BadStatus s ->
|
||||
"Bad Status: the server returned a bad status code: " ++ String.fromInt s
|
||||
|
||||
Http.BadBody b ->
|
||||
"Bad Body: our application had trouble decoding the body of the response from the server: " ++ b
|
||||
|
||||
Http.NetworkError ->
|
||||
"Network Error: something went awry in the network stack. I recommend checking the server logs if you can."
|
||||
|
||||
|
||||
getWithCredentials :
|
||||
{ url : String
|
||||
, expect : Http.Expect msg
|
||||
}
|
||||
-> Cmd msg
|
||||
getWithCredentials { url, expect } =
|
||||
Http.riskyRequest
|
||||
{ url = url
|
||||
, headers = [ Http.header "Origin" Shared.clientOrigin ]
|
||||
, method = "GET"
|
||||
, timeout = Nothing
|
||||
, tracker = Nothing
|
||||
, body = Http.emptyBody
|
||||
, expect = expect
|
||||
}
|
||||
|
||||
|
||||
postWithCredentials :
|
||||
{ url : String
|
||||
, body : Http.Body
|
||||
, expect : Http.Expect msg
|
||||
}
|
||||
-> Cmd msg
|
||||
postWithCredentials { url, body, expect } =
|
||||
Http.riskyRequest
|
||||
{ url = url
|
||||
, headers = [ Http.header "Origin" Shared.clientOrigin ]
|
||||
, method = "POST"
|
||||
, timeout = Nothing
|
||||
, tracker = Nothing
|
||||
, body = body
|
||||
, expect = expect
|
||||
}
|
||||
|
||||
|
||||
deleteWithCredentials :
|
||||
{ url : String
|
||||
, body : Http.Body
|
||||
, expect : Http.Expect msg
|
||||
}
|
||||
-> Cmd msg
|
||||
deleteWithCredentials { url, body, expect } =
|
||||
Http.riskyRequest
|
||||
{ url = url
|
||||
, headers = [ Http.header "Origin" Shared.clientOrigin ]
|
||||
, method = "DELETE"
|
||||
, timeout = Nothing
|
||||
, tracker = Nothing
|
||||
, body = body
|
||||
, expect = expect
|
||||
}
|
||||
|
||||
putWithCredentials :
|
||||
{ url : String
|
||||
, body : Http.Body
|
||||
, expect : Http.Expect msg
|
||||
}
|
||||
-> Cmd msg
|
||||
putWithCredentials { url, body, expect } =
|
||||
Http.riskyRequest
|
||||
{ url = url
|
||||
, headers = [ Http.header "Origin" Shared.clientOrigin ]
|
||||
, method = "PUT"
|
||||
, timeout = Nothing
|
||||
, tracker = Nothing
|
||||
, body = body
|
||||
, expect = expect
|
||||
}
|
||||
|
||||
|
||||
|
||||
formatTime : Time.Posix -> String
|
||||
formatTime ts =
|
||||
DateFormat.format
|
||||
[ DateFormat.monthNameFull
|
||||
, DateFormat.text " "
|
||||
, DateFormat.dayOfMonthSuffix
|
||||
, DateFormat.text ", "
|
||||
, DateFormat.yearNumber
|
||||
]
|
||||
Time.utc
|
||||
ts
|
2
users/wpcarro/assessments/tt/data/accounts.csv
Normal file
2
users/wpcarro/assessments/tt/data/accounts.csv
Normal file
|
@ -0,0 +1,2 @@
|
|||
mimi,$2b$12$LynoGCNbe2RA1WWSiBEMVudJKs5dxnssY16rYmUyiwlSBIhHBOLbu,miriamwright@google.com,user,
|
||||
wpcarro,$2b$12$3wbi4xfQmksLsu6GOKTbj.5WHywESATnXB4R8FJ55RSRLy6X9xA7u,wpcarro@google.com,admin,
|
|
3
users/wpcarro/assessments/tt/data/trips.csv
Normal file
3
users/wpcarro/assessments/tt/data/trips.csv
Normal file
|
@ -0,0 +1,3 @@
|
|||
mimi,Rome,2020-08-10,2020-08-12,Heading home before the upcoming trip with Panarea.
|
||||
mimi,Panarea,2020-08-15,2020-08-28,Exciting upcoming trip with Matt and Sarah!
|
||||
mimi,London,2020-08-30,2020-09-15,Heading back to London...
|
|
7
users/wpcarro/assessments/tt/populate.sqlite3
Normal file
7
users/wpcarro/assessments/tt/populate.sqlite3
Normal file
|
@ -0,0 +1,7 @@
|
|||
PRAGMA foreign_keys = on;
|
||||
.read src/init.sql
|
||||
.mode csv
|
||||
.import data/accounts.csv Accounts
|
||||
.import data/trips.csv Trips
|
||||
.mode column
|
||||
.headers on
|
23
users/wpcarro/assessments/tt/shell.nix
Normal file
23
users/wpcarro/assessments/tt/shell.nix
Normal file
|
@ -0,0 +1,23 @@
|
|||
let
|
||||
pkgs = import <nixpkgs> {};
|
||||
hailgun-src = builtins.fetchGit {
|
||||
url = "https://bitbucket.org/echo_rm/hailgun.git";
|
||||
rev = "9d5da7c902b2399e0fcf3d494ee04cf2bbfe7c9e";
|
||||
};
|
||||
hailgun = pkgs.haskellPackages.callCabal2nix "hailgun" hailgun-src {};
|
||||
in pkgs.mkShell {
|
||||
buildInputs = with pkgs; [
|
||||
(haskellPackages.ghcWithPackages (hpkgs: with hpkgs; [
|
||||
hpkgs.servant-server
|
||||
hpkgs.aeson
|
||||
hpkgs.resource-pool
|
||||
hpkgs.sqlite-simple
|
||||
hpkgs.wai-cors
|
||||
hpkgs.warp
|
||||
hpkgs.cryptonite
|
||||
hpkgs.uuid
|
||||
hpkgs.envy
|
||||
hailgun
|
||||
]))
|
||||
];
|
||||
}
|
2
users/wpcarro/assessments/tt/src/.ghci
Normal file
2
users/wpcarro/assessments/tt/src/.ghci
Normal file
|
@ -0,0 +1,2 @@
|
|||
:set prompt "> "
|
||||
:set -Wall
|
75
users/wpcarro/assessments/tt/src/API.hs
Normal file
75
users/wpcarro/assessments/tt/src/API.hs
Normal file
|
@ -0,0 +1,75 @@
|
|||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
--------------------------------------------------------------------------------
|
||||
module API where
|
||||
--------------------------------------------------------------------------------
|
||||
import Data.Text
|
||||
import Servant.API
|
||||
import Web.Cookie
|
||||
|
||||
import qualified Types as T
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- | Once authenticated, users receive a SessionCookie.
|
||||
type SessionCookie = Header' '[Required] "Cookie" T.SessionCookie
|
||||
|
||||
type API =
|
||||
-- accounts: Create
|
||||
"accounts"
|
||||
:> Header "Cookie" T.SessionCookie
|
||||
:> ReqBody '[JSON] T.CreateAccountRequest
|
||||
:> Post '[JSON] NoContent
|
||||
:<|> "verify"
|
||||
:> ReqBody '[JSON] T.VerifyAccountRequest
|
||||
:> Post '[JSON] NoContent
|
||||
-- accounts: Read
|
||||
-- accounts: Update
|
||||
-- accounts: Delete
|
||||
:<|> "accounts"
|
||||
:> SessionCookie
|
||||
:> QueryParam' '[Required] "username" Text
|
||||
:> Delete '[JSON] NoContent
|
||||
-- accounts: List
|
||||
:<|> "accounts"
|
||||
:> SessionCookie
|
||||
:> Get '[JSON] [T.User]
|
||||
|
||||
-- trips: Create
|
||||
:<|> "trips"
|
||||
:> SessionCookie
|
||||
:> ReqBody '[JSON] T.Trip
|
||||
:> Post '[JSON] NoContent
|
||||
-- trips: Read
|
||||
-- trips: Update
|
||||
:<|> "trips"
|
||||
:> SessionCookie
|
||||
:> ReqBody '[JSON] T.UpdateTripRequest
|
||||
:> Put '[JSON] NoContent
|
||||
-- trips: Delete
|
||||
:<|> "trips"
|
||||
:> SessionCookie
|
||||
:> ReqBody '[JSON] T.TripPK
|
||||
:> Delete '[JSON] NoContent
|
||||
-- trips: List
|
||||
:<|> "trips"
|
||||
:> SessionCookie
|
||||
:> Get '[JSON] [T.Trip]
|
||||
|
||||
-- Miscellaneous
|
||||
:<|> "login"
|
||||
:> ReqBody '[JSON] T.AccountCredentials
|
||||
:> Post '[JSON] (Headers '[Header "Set-Cookie" SetCookie] T.Session)
|
||||
:<|> "logout"
|
||||
:> SessionCookie
|
||||
:> Get '[JSON] (Headers '[Header "Set-Cookie" SetCookie] NoContent)
|
||||
:<|> "unfreeze"
|
||||
:> SessionCookie
|
||||
:> ReqBody '[JSON] T.UnfreezeAccountRequest
|
||||
:> Post '[JSON] NoContent
|
||||
:<|> "invite"
|
||||
:> SessionCookie
|
||||
:> ReqBody '[JSON] T.InviteUserRequest
|
||||
:> Post '[JSON] NoContent
|
||||
:<|> "accept-invitation"
|
||||
:> ReqBody '[JSON] T.AcceptInvitationRequest
|
||||
:> Post '[JSON] NoContent
|
49
users/wpcarro/assessments/tt/src/Accounts.hs
Normal file
49
users/wpcarro/assessments/tt/src/Accounts.hs
Normal file
|
@ -0,0 +1,49 @@
|
|||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
--------------------------------------------------------------------------------
|
||||
module Accounts where
|
||||
--------------------------------------------------------------------------------
|
||||
import Database.SQLite.Simple
|
||||
|
||||
import qualified PendingAccounts
|
||||
import qualified Types as T
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- | Delete the account in PendingAccounts and create on in Accounts.
|
||||
transferFromPending :: FilePath -> T.PendingAccount -> IO ()
|
||||
transferFromPending dbFile T.PendingAccount{..} = withConnection dbFile $
|
||||
\conn -> withTransaction conn $ do
|
||||
PendingAccounts.delete dbFile pendingAccountUsername
|
||||
execute conn "INSERT INTO Accounts (username,password,email,role) VALUES (?,?,?,?)"
|
||||
( pendingAccountUsername
|
||||
, pendingAccountPassword
|
||||
, pendingAccountEmail
|
||||
, pendingAccountRole
|
||||
)
|
||||
|
||||
-- | Create a new account in the Accounts table.
|
||||
create :: FilePath -> T.Username -> T.ClearTextPassword -> T.Email -> T.Role -> IO ()
|
||||
create dbFile username password email role = withConnection dbFile $ \conn -> do
|
||||
hashed <- T.hashPassword password
|
||||
execute conn "INSERT INTO Accounts (username,password,email,role) VALUES (?,?,?,?)"
|
||||
(username, hashed, email, role)
|
||||
|
||||
-- | Delete `username` from `dbFile`.
|
||||
delete :: FilePath -> T.Username -> IO ()
|
||||
delete dbFile username = withConnection dbFile $ \conn -> do
|
||||
execute conn "DELETE FROM Accounts WHERE username = ?"
|
||||
(Only username)
|
||||
|
||||
-- | Attempt to find `username` in the Account table of `dbFile`.
|
||||
lookup :: FilePath -> T.Username -> IO (Maybe T.Account)
|
||||
lookup dbFile username = withConnection dbFile $ \conn -> do
|
||||
res <- query conn "SELECT username,password,email,role,profilePicture FROM Accounts WHERE username = ?" (Only username)
|
||||
case res of
|
||||
[x] -> pure (Just x)
|
||||
_ -> pure Nothing
|
||||
|
||||
-- | Return a list of accounts with the sensitive data removed.
|
||||
list :: FilePath -> IO [T.User]
|
||||
list dbFile = withConnection dbFile $ \conn -> do
|
||||
accounts <- query_ conn "SELECT username,password,email,role,profilePicture FROM Accounts"
|
||||
pure $ T.userFromAccount <$> accounts
|
270
users/wpcarro/assessments/tt/src/App.hs
Normal file
270
users/wpcarro/assessments/tt/src/App.hs
Normal file
|
@ -0,0 +1,270 @@
|
|||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
--------------------------------------------------------------------------------
|
||||
module App where
|
||||
--------------------------------------------------------------------------------
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Data.String.Conversions (cs)
|
||||
import Data.Text (Text)
|
||||
import Servant
|
||||
import API
|
||||
import Utils
|
||||
import Web.Cookie
|
||||
|
||||
import qualified Network.Wai.Handler.Warp as Warp
|
||||
import qualified Network.Wai.Middleware.Cors as Cors
|
||||
import qualified System.Random as Random
|
||||
import qualified Email as Email
|
||||
import qualified Data.UUID as UUID
|
||||
import qualified Types as T
|
||||
import qualified Accounts as Accounts
|
||||
import qualified Auth as Auth
|
||||
import qualified Trips as Trips
|
||||
import qualified Sessions as Sessions
|
||||
import qualified Invitations as Invitations
|
||||
import qualified LoginAttempts as LoginAttempts
|
||||
import qualified PendingAccounts as PendingAccounts
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
err429 :: ServerError
|
||||
err429 = ServerError
|
||||
{ errHTTPCode = 429
|
||||
, errReasonPhrase = "Too many requests"
|
||||
, errBody = ""
|
||||
, errHeaders = []
|
||||
}
|
||||
|
||||
-- | Send an email to recipient, `to`, with a secret code.
|
||||
sendVerifyEmail :: T.Config
|
||||
-> T.Username
|
||||
-> T.Email
|
||||
-> T.RegistrationSecret
|
||||
-> IO (Either Email.SendError Email.SendSuccess)
|
||||
sendVerifyEmail T.Config{..} (T.Username username) email (T.RegistrationSecret secretUUID) = do
|
||||
Email.send mailgunAPIKey subject (cs body) email
|
||||
where
|
||||
subject = "Please confirm your account"
|
||||
body =
|
||||
let secret = secretUUID |> UUID.toString in
|
||||
"To verify your account: POST /verify username=" ++ cs username ++ " secret=" ++ secret
|
||||
|
||||
-- | Send an invitation email to recipient, `to`, with a secret code.
|
||||
sendInviteEmail :: T.Config
|
||||
-> T.Email
|
||||
-> T.InvitationSecret
|
||||
-> IO (Either Email.SendError Email.SendSuccess)
|
||||
sendInviteEmail T.Config{..} email@(T.Email to) (T.InvitationSecret secretUUID) = do
|
||||
Email.send mailgunAPIKey subject (cs body) email
|
||||
where
|
||||
subject = "You've been invited!"
|
||||
body =
|
||||
let secret = secretUUID |> UUID.toString in
|
||||
"To accept the invitation: POST /accept-invitation username=<username> password=<password> email=" ++ cs to ++ " secret=" ++ secret
|
||||
|
||||
server :: T.Config -> Server API
|
||||
server config@T.Config{..} = createAccount
|
||||
:<|> verifyAccount
|
||||
:<|> deleteAccount
|
||||
:<|> listAccounts
|
||||
:<|> createTrip
|
||||
:<|> updateTrip
|
||||
:<|> deleteTrip
|
||||
:<|> listTrips
|
||||
:<|> login
|
||||
:<|> logout
|
||||
:<|> unfreezeAccount
|
||||
:<|> inviteUser
|
||||
:<|> acceptInvitation
|
||||
where
|
||||
-- Admit Admins + whatever the predicate `p` passes.
|
||||
adminsAnd cookie p = Auth.assert dbFile cookie (\acct@T.Account{..} -> accountRole == T.Admin || p acct)
|
||||
-- Admit Admins only.
|
||||
adminsOnly cookie = adminsAnd cookie (const True)
|
||||
|
||||
-- TODO(wpcarro): Handle failed CONSTRAINTs instead of sending 500s
|
||||
createAccount :: Maybe T.SessionCookie
|
||||
-> T.CreateAccountRequest
|
||||
-> Handler NoContent
|
||||
createAccount mCookie T.CreateAccountRequest{..} =
|
||||
case (mCookie, createAccountRequestRole) of
|
||||
(_, T.RegularUser) ->
|
||||
doCreateAccount
|
||||
(Nothing, T.Manager) ->
|
||||
throwError err401 { errBody = "Only admins can create Manager accounts" }
|
||||
(Nothing, T.Admin) ->
|
||||
throwError err401 { errBody = "Only admins can create Admin accounts" }
|
||||
(Just cookie, _) ->
|
||||
adminsAnd cookie (\T.Account{..} -> accountRole == T.Manager) doCreateAccount
|
||||
where
|
||||
doCreateAccount :: Handler NoContent
|
||||
doCreateAccount = do
|
||||
secretUUID <- liftIO $ T.RegistrationSecret <$> Random.randomIO
|
||||
liftIO $ PendingAccounts.create dbFile
|
||||
secretUUID
|
||||
createAccountRequestUsername
|
||||
createAccountRequestPassword
|
||||
createAccountRequestRole
|
||||
createAccountRequestEmail
|
||||
res <- liftIO $ sendVerifyEmail config
|
||||
createAccountRequestUsername
|
||||
createAccountRequestEmail
|
||||
secretUUID
|
||||
case res of
|
||||
Left _ -> undefined
|
||||
Right _ -> pure NoContent
|
||||
|
||||
verifyAccount :: T.VerifyAccountRequest -> Handler NoContent
|
||||
verifyAccount T.VerifyAccountRequest{..} = do
|
||||
mPendingAccount <- liftIO $ PendingAccounts.get dbFile verifyAccountRequestUsername
|
||||
case mPendingAccount of
|
||||
Nothing ->
|
||||
throwError err401 { errBody = "Either your secret or your username (or both) is invalid" }
|
||||
Just pendingAccount@T.PendingAccount{..} ->
|
||||
if pendingAccountSecret == verifyAccountRequestSecret then do
|
||||
liftIO $ Accounts.transferFromPending dbFile pendingAccount
|
||||
pure NoContent
|
||||
else
|
||||
throwError err401 { errBody = "The secret you provided is invalid" }
|
||||
|
||||
deleteAccount :: T.SessionCookie -> Text -> Handler NoContent
|
||||
deleteAccount cookie username = adminsOnly cookie $ do
|
||||
liftIO $ Accounts.delete dbFile (T.Username username)
|
||||
pure NoContent
|
||||
|
||||
listAccounts :: T.SessionCookie -> Handler [T.User]
|
||||
listAccounts cookie = adminsOnly cookie $ do
|
||||
liftIO $ Accounts.list dbFile
|
||||
|
||||
createTrip :: T.SessionCookie -> T.Trip -> Handler NoContent
|
||||
createTrip cookie trip@T.Trip{..} =
|
||||
adminsAnd cookie (\T.Account{..} -> accountUsername == tripUsername) $ do
|
||||
liftIO $ Trips.create dbFile trip
|
||||
pure NoContent
|
||||
|
||||
updateTrip :: T.SessionCookie -> T.UpdateTripRequest -> Handler NoContent
|
||||
updateTrip cookie updates@T.UpdateTripRequest{..} =
|
||||
adminsAnd cookie (\T.Account{..} -> accountUsername == T.tripPKUsername updateTripRequestTripPK) $ do
|
||||
mTrip <- liftIO $ Trips.get dbFile updateTripRequestTripPK
|
||||
case mTrip of
|
||||
Nothing -> throwError err400 { errBody = "tripKey is invalid" }
|
||||
Just trip@T.Trip{..} -> do
|
||||
-- TODO(wpcarro): Prefer function in Trips module that does this in a
|
||||
-- DB transaction.
|
||||
liftIO $ Trips.delete dbFile updateTripRequestTripPK
|
||||
liftIO $ Trips.create dbFile (T.updateTrip updates trip)
|
||||
pure NoContent
|
||||
|
||||
deleteTrip :: T.SessionCookie -> T.TripPK -> Handler NoContent
|
||||
deleteTrip cookie tripPK@T.TripPK{..} =
|
||||
adminsAnd cookie (\T.Account{..} -> accountUsername == tripPKUsername) $ do
|
||||
liftIO $ Trips.delete dbFile tripPK
|
||||
pure NoContent
|
||||
|
||||
listTrips :: T.SessionCookie -> Handler [T.Trip]
|
||||
listTrips cookie = do
|
||||
mAccount <- liftIO $ Auth.accountFromCookie dbFile cookie
|
||||
case mAccount of
|
||||
Nothing -> throwError err401 { errBody = "Your session cookie is invalid. Try logging out and logging back in." }
|
||||
Just T.Account{..} ->
|
||||
case accountRole of
|
||||
T.Admin -> liftIO $ Trips.listAll dbFile
|
||||
_ -> liftIO $ Trips.list dbFile accountUsername
|
||||
|
||||
login :: T.AccountCredentials
|
||||
-> Handler (Headers '[Header "Set-Cookie" SetCookie] T.Session)
|
||||
login (T.AccountCredentials username password) = do
|
||||
mAccount <- liftIO $ Accounts.lookup dbFile username
|
||||
case mAccount of
|
||||
Just account@T.Account{..} -> do
|
||||
mAttempts <- liftIO $ LoginAttempts.forUsername dbFile accountUsername
|
||||
case mAttempts of
|
||||
Nothing ->
|
||||
if T.passwordsMatch password accountPassword then do
|
||||
uuid <- liftIO $ Sessions.findOrCreate dbFile account
|
||||
pure $ addHeader (Auth.mkCookie uuid)
|
||||
T.Session{ sessionUsername = accountUsername
|
||||
, sessionRole = accountRole
|
||||
}
|
||||
else do
|
||||
liftIO $ LoginAttempts.increment dbFile username
|
||||
throwError err401 { errBody = "Your credentials are invalid" }
|
||||
Just attempts ->
|
||||
if attempts >= 3 then
|
||||
throwError err429
|
||||
else if T.passwordsMatch password accountPassword then do
|
||||
uuid <- liftIO $ Sessions.findOrCreate dbFile account
|
||||
pure $ addHeader (Auth.mkCookie uuid)
|
||||
T.Session{ sessionUsername = accountUsername
|
||||
, sessionRole = accountRole
|
||||
}
|
||||
else do
|
||||
liftIO $ LoginAttempts.increment dbFile username
|
||||
throwError err401 { errBody = "Your credentials are invalid" }
|
||||
|
||||
-- In this branch, the user didn't supply a known username.
|
||||
Nothing -> throwError err401 { errBody = "Your credentials are invalid" }
|
||||
|
||||
logout :: T.SessionCookie
|
||||
-> Handler (Headers '[Header "Set-Cookie" SetCookie] NoContent)
|
||||
logout cookie = do
|
||||
case Auth.uuidFromCookie cookie of
|
||||
Nothing ->
|
||||
pure $ addHeader Auth.emptyCookie NoContent
|
||||
Just uuid -> do
|
||||
liftIO $ Sessions.delete dbFile uuid
|
||||
pure $ addHeader Auth.emptyCookie NoContent
|
||||
|
||||
unfreezeAccount :: T.SessionCookie
|
||||
-> T.UnfreezeAccountRequest
|
||||
-> Handler NoContent
|
||||
unfreezeAccount cookie T.UnfreezeAccountRequest{..} =
|
||||
adminsAnd cookie (\T.Account{..} -> accountRole == T.Manager) $ do
|
||||
liftIO $ LoginAttempts.reset dbFile unfreezeAccountRequestUsername
|
||||
pure NoContent
|
||||
|
||||
inviteUser :: T.SessionCookie
|
||||
-> T.InviteUserRequest
|
||||
-> Handler NoContent
|
||||
inviteUser cookie T.InviteUserRequest{..} = adminsOnly cookie $ do
|
||||
secretUUID <- liftIO $ T.InvitationSecret <$> Random.randomIO
|
||||
liftIO $ Invitations.create dbFile
|
||||
secretUUID
|
||||
inviteUserRequestEmail
|
||||
inviteUserRequestRole
|
||||
res <- liftIO $ sendInviteEmail config inviteUserRequestEmail secretUUID
|
||||
case res of
|
||||
Left _ -> undefined
|
||||
Right _ -> pure NoContent
|
||||
|
||||
acceptInvitation :: T.AcceptInvitationRequest -> Handler NoContent
|
||||
acceptInvitation T.AcceptInvitationRequest{..} = do
|
||||
mInvitation <- liftIO $ Invitations.get dbFile acceptInvitationRequestEmail
|
||||
case mInvitation of
|
||||
Nothing -> throwError err404 { errBody = "No invitation for email" }
|
||||
Just T.Invitation{..} ->
|
||||
if invitationSecret == acceptInvitationRequestSecret then do
|
||||
liftIO $ Accounts.create dbFile
|
||||
acceptInvitationRequestUsername
|
||||
acceptInvitationRequestPassword
|
||||
invitationEmail
|
||||
invitationRole
|
||||
pure NoContent
|
||||
else
|
||||
throwError err401 { errBody = "You are not providing a valid secret" }
|
||||
|
||||
run :: T.Config -> IO ()
|
||||
run config@T.Config{..} =
|
||||
Warp.run 3000 (enforceCors $ serve (Proxy @ API) $ server config)
|
||||
where
|
||||
enforceCors = Cors.cors (const $ Just corsPolicy)
|
||||
corsPolicy :: Cors.CorsResourcePolicy
|
||||
corsPolicy =
|
||||
Cors.simpleCorsResourcePolicy
|
||||
{ Cors.corsOrigins = Just ([cs configClient], True)
|
||||
, Cors.corsMethods = Cors.simpleMethods ++ ["PUT", "PATCH", "DELETE", "OPTIONS"]
|
||||
, Cors.corsRequestHeaders = Cors.simpleHeaders ++ ["Content-Type", "Authorization"]
|
||||
}
|
64
users/wpcarro/assessments/tt/src/Auth.hs
Normal file
64
users/wpcarro/assessments/tt/src/Auth.hs
Normal file
|
@ -0,0 +1,64 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
--------------------------------------------------------------------------------
|
||||
module Auth where
|
||||
--------------------------------------------------------------------------------
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Web.Cookie
|
||||
import Servant
|
||||
|
||||
import qualified Data.UUID as UUID
|
||||
import qualified Sessions as Sessions
|
||||
import qualified Accounts as Accounts
|
||||
import qualified Types as T
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- | Return the UUID from a Session cookie.
|
||||
uuidFromCookie :: T.SessionCookie -> Maybe T.SessionUUID
|
||||
uuidFromCookie (T.SessionCookie cookies) = do
|
||||
auth <- lookup "auth" cookies
|
||||
uuid <- UUID.fromASCIIBytes auth
|
||||
pure $ T.SessionUUID uuid
|
||||
|
||||
-- | Attempt to return the account associated with `cookie`.
|
||||
accountFromCookie :: FilePath -> T.SessionCookie -> IO (Maybe T.Account)
|
||||
accountFromCookie dbFile cookie =
|
||||
case uuidFromCookie cookie of
|
||||
Nothing -> pure Nothing
|
||||
Just uuid -> do
|
||||
mSession <- Sessions.get dbFile uuid
|
||||
case mSession of
|
||||
Nothing -> pure Nothing
|
||||
Just T.StoredSession{..} -> do
|
||||
mAccount <- Accounts.lookup dbFile storedSessionUsername
|
||||
case mAccount of
|
||||
Nothing -> pure Nothing
|
||||
Just x -> pure (Just x)
|
||||
|
||||
-- | Create a new session cookie.
|
||||
mkCookie :: T.SessionUUID -> SetCookie
|
||||
mkCookie (T.SessionUUID uuid) =
|
||||
defaultSetCookie
|
||||
{ setCookieName = "auth"
|
||||
, setCookieValue = UUID.toASCIIBytes uuid
|
||||
}
|
||||
|
||||
-- | Use this to clear out the session cookie.
|
||||
emptyCookie :: SetCookie
|
||||
emptyCookie =
|
||||
defaultSetCookie
|
||||
{ setCookieName = "auth"
|
||||
, setCookieValue = ""
|
||||
}
|
||||
|
||||
-- | Throw a 401 error if the `predicate` fails.
|
||||
assert :: FilePath -> T.SessionCookie -> (T.Account -> Bool) -> Handler a -> Handler a
|
||||
assert dbFile cookie predicate handler = do
|
||||
mRole <- liftIO $ accountFromCookie dbFile cookie
|
||||
case mRole of
|
||||
Nothing -> throwError err401 { errBody = "Missing valid session cookie" }
|
||||
Just account ->
|
||||
if predicate account then
|
||||
handler
|
||||
else
|
||||
throwError err401 { errBody = "You are not authorized to access this resource" }
|
46
users/wpcarro/assessments/tt/src/Email.hs
Normal file
46
users/wpcarro/assessments/tt/src/Email.hs
Normal file
|
@ -0,0 +1,46 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
--------------------------------------------------------------------------------
|
||||
module Email where
|
||||
--------------------------------------------------------------------------------
|
||||
import Data.Text
|
||||
import Data.String.Conversions (cs)
|
||||
import Utils
|
||||
|
||||
import qualified Mail.Hailgun as MG
|
||||
import qualified Types as T
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
newtype SendSuccess = SendSuccess MG.HailgunSendResponse
|
||||
|
||||
data SendError
|
||||
= MessageError MG.HailgunErrorMessage
|
||||
| ResponseError MG.HailgunErrorResponse
|
||||
|
||||
-- | Attempt to send an email with `subject` and with message, `body`.
|
||||
send :: Text
|
||||
-> Text
|
||||
-> Text
|
||||
-> T.Email
|
||||
-> IO (Either SendError SendSuccess)
|
||||
send apiKey subject body (T.Email to) = do
|
||||
case mkMsg of
|
||||
Left e -> pure $ Left (MessageError e)
|
||||
Right x -> do
|
||||
res <- MG.sendEmail ctx x
|
||||
case res of
|
||||
Left e -> pure $ Left (ResponseError e)
|
||||
Right y -> pure $ Right (SendSuccess y)
|
||||
where
|
||||
ctx = MG.HailgunContext { MG.hailgunDomain = "sandboxda5038873f924b50af2f82a0f05cffdf.mailgun.org"
|
||||
, MG.hailgunApiKey = cs apiKey
|
||||
, MG.hailgunProxy = Nothing
|
||||
}
|
||||
mkMsg = MG.hailgunMessage
|
||||
subject
|
||||
(body |> cs |> MG.TextOnly)
|
||||
"mailgun@sandboxda5038873f924b50af2f82a0f05cffdf.mailgun.org"
|
||||
(MG.MessageRecipients { MG.recipientsTo = [cs to]
|
||||
, MG.recipientsCC = []
|
||||
, MG.recipientsBCC = []
|
||||
})
|
||||
[]
|
21
users/wpcarro/assessments/tt/src/Invitations.hs
Normal file
21
users/wpcarro/assessments/tt/src/Invitations.hs
Normal file
|
@ -0,0 +1,21 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
--------------------------------------------------------------------------------
|
||||
module Invitations where
|
||||
--------------------------------------------------------------------------------
|
||||
import Database.SQLite.Simple
|
||||
|
||||
import qualified Types as T
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
create :: FilePath -> T.InvitationSecret -> T.Email -> T.Role -> IO ()
|
||||
create dbFile secret email role = withConnection dbFile $ \conn -> do
|
||||
execute conn "INSERT INTO Invitations (email,role,secret) VALUES (?,?,?)"
|
||||
(email, role, secret)
|
||||
|
||||
get :: FilePath -> T.Email -> IO (Maybe T.Invitation)
|
||||
get dbFile email = withConnection dbFile $ \conn -> do
|
||||
res <- query conn "SELECT email,role,secret FROM Invitations WHERE email = ?" (Only email)
|
||||
case res of
|
||||
[x] -> pure (Just x)
|
||||
_ -> pure Nothing
|
30
users/wpcarro/assessments/tt/src/LoginAttempts.hs
Normal file
30
users/wpcarro/assessments/tt/src/LoginAttempts.hs
Normal file
|
@ -0,0 +1,30 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
--------------------------------------------------------------------------------
|
||||
module LoginAttempts where
|
||||
--------------------------------------------------------------------------------
|
||||
import Database.SQLite.Simple
|
||||
|
||||
import qualified Types as T
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
reset :: FilePath -> T.Username -> IO ()
|
||||
reset dbFile username = withConnection dbFile $ \conn ->
|
||||
execute conn "UPDATE LoginAttempts SET numAttempts = 0 WHERE username = ?"
|
||||
(Only username)
|
||||
|
||||
-- | Attempt to return the number of failed login attempts for
|
||||
-- `username`. Returns a Maybe in case `username` doesn't exist.
|
||||
forUsername :: FilePath -> T.Username -> IO (Maybe Integer)
|
||||
forUsername dbFile username = withConnection dbFile $ \conn -> do
|
||||
res <- query conn "SELECT username,numAttempts FROM LoginAttempts WHERE username = ?"
|
||||
(Only username)
|
||||
case res of
|
||||
[T.LoginAttempt{..}] -> pure (Just loginAttemptNumAttempts)
|
||||
_ -> pure Nothing
|
||||
|
||||
-- | INSERT a failed login attempt for `username` or UPDATE an existing entry.
|
||||
increment :: FilePath -> T.Username -> IO ()
|
||||
increment dbFile username = withConnection dbFile $ \conn ->
|
||||
execute conn "INSERT INTO LoginAttempts (username,numAttempts) VALUES (?,?) ON CONFLICT (username) DO UPDATE SET numAttempts = numAttempts + 1"
|
||||
(username, 1 :: Integer)
|
13
users/wpcarro/assessments/tt/src/Main.hs
Normal file
13
users/wpcarro/assessments/tt/src/Main.hs
Normal file
|
@ -0,0 +1,13 @@
|
|||
--------------------------------------------------------------------------------
|
||||
module Main where
|
||||
--------------------------------------------------------------------------------
|
||||
import qualified App
|
||||
import qualified System.Envy as Envy
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
mEnv <- Envy.decodeEnv
|
||||
case mEnv of
|
||||
Left err -> putStrLn err
|
||||
Right env -> App.run env
|
32
users/wpcarro/assessments/tt/src/PendingAccounts.hs
Normal file
32
users/wpcarro/assessments/tt/src/PendingAccounts.hs
Normal file
|
@ -0,0 +1,32 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
--------------------------------------------------------------------------------
|
||||
module PendingAccounts where
|
||||
--------------------------------------------------------------------------------
|
||||
import Database.SQLite.Simple
|
||||
|
||||
import qualified Types as T
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
create :: FilePath
|
||||
-> T.RegistrationSecret
|
||||
-> T.Username
|
||||
-> T.ClearTextPassword
|
||||
-> T.Role
|
||||
-> T.Email
|
||||
-> IO ()
|
||||
create dbFile secret username password role email = withConnection dbFile $ \conn -> do
|
||||
hashed <- T.hashPassword password
|
||||
execute conn "INSERT INTO PendingAccounts (secret,username,password,role,email) VALUES (?,?,?,?,?)"
|
||||
(secret, username, hashed, role, email)
|
||||
|
||||
get :: FilePath -> T.Username -> IO (Maybe T.PendingAccount)
|
||||
get dbFile username = withConnection dbFile $ \conn -> do
|
||||
res <- query conn "SELECT secret,username,password,role,email FROM PendingAccounts WHERE username = ?" (Only username)
|
||||
case res of
|
||||
[x] -> pure (Just x)
|
||||
_ -> pure Nothing
|
||||
|
||||
delete :: FilePath -> T.Username -> IO ()
|
||||
delete dbFile username = withConnection dbFile $ \conn ->
|
||||
execute conn "DELETE FROM PendingAccounts WHERE username = ?" (Only username)
|
74
users/wpcarro/assessments/tt/src/Sessions.hs
Normal file
74
users/wpcarro/assessments/tt/src/Sessions.hs
Normal file
|
@ -0,0 +1,74 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
--------------------------------------------------------------------------------
|
||||
module Sessions where
|
||||
--------------------------------------------------------------------------------
|
||||
import Database.SQLite.Simple
|
||||
|
||||
import qualified Data.Time.Clock as Clock
|
||||
import qualified Types as T
|
||||
import qualified System.Random as Random
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- | Return True if `session` was created at most three hours ago.
|
||||
isValid :: T.StoredSession -> IO Bool
|
||||
isValid session = do
|
||||
t1 <- Clock.getCurrentTime
|
||||
let t0 = T.storedSessionTsCreated session in
|
||||
pure $ Clock.diffUTCTime t1 t0 <= 3 * 60 * 60
|
||||
|
||||
-- | Lookup the session by UUID.
|
||||
get :: FilePath -> T.SessionUUID -> IO (Maybe T.StoredSession)
|
||||
get dbFile uuid = withConnection dbFile $ \conn -> do
|
||||
res <- query conn "SELECT uuid,username,tsCreated FROM Sessions WHERE uuid = ?" (Only uuid)
|
||||
case res of
|
||||
[x] -> pure (Just x)
|
||||
_ -> pure Nothing
|
||||
|
||||
-- | Lookup the session stored under `username` in `dbFile`.
|
||||
find :: FilePath -> T.Username -> IO (Maybe T.StoredSession)
|
||||
find dbFile username = withConnection dbFile $ \conn -> do
|
||||
res <- query conn "SELECT uuid,username,tsCreated FROM Sessions WHERE username = ?" (Only username)
|
||||
case res of
|
||||
[x] -> pure (Just x)
|
||||
_ -> pure Nothing
|
||||
|
||||
-- | Create a session under the `username` key in `dbFile`.
|
||||
create :: FilePath -> T.Username -> IO T.SessionUUID
|
||||
create dbFile username = withConnection dbFile $ \conn -> do
|
||||
now <- Clock.getCurrentTime
|
||||
uuid <- Random.randomIO
|
||||
execute conn "INSERT INTO Sessions (uuid,username,tsCreated) VALUES (?,?,?)"
|
||||
(T.SessionUUID uuid, username, now)
|
||||
pure (T.SessionUUID uuid)
|
||||
|
||||
-- | Reset the tsCreated field to the current time to ensure the token is valid.
|
||||
refresh :: FilePath -> T.SessionUUID -> IO ()
|
||||
refresh dbFile uuid = withConnection dbFile $ \conn -> do
|
||||
now <- Clock.getCurrentTime
|
||||
execute conn "UPDATE Sessions SET tsCreated = ? WHERE uuid = ?"
|
||||
(now, uuid)
|
||||
pure ()
|
||||
|
||||
-- | Delete the session under `username` from `dbFile`.
|
||||
delete :: FilePath -> T.SessionUUID -> IO ()
|
||||
delete dbFile uuid = withConnection dbFile $ \conn ->
|
||||
execute conn "DELETE FROM Sessions WHERE uuid = ?" (Only uuid)
|
||||
|
||||
-- | Find or create a session in the Sessions table. If a session exists,
|
||||
-- refresh the token's validity.
|
||||
findOrCreate :: FilePath -> T.Account -> IO T.SessionUUID
|
||||
findOrCreate dbFile account =
|
||||
let username = T.accountUsername account in do
|
||||
mSession <- find dbFile username
|
||||
case mSession of
|
||||
Nothing -> create dbFile username
|
||||
Just session ->
|
||||
let uuid = T.storedSessionUUID session in do
|
||||
refresh dbFile uuid
|
||||
pure uuid
|
||||
|
||||
-- | Return a list of all sessions in the Sessions table.
|
||||
list :: FilePath -> IO [T.StoredSession]
|
||||
list dbFile = withConnection dbFile $ \conn ->
|
||||
query_ conn "SELECT uuid,username,tsCreated FROM Sessions"
|
42
users/wpcarro/assessments/tt/src/Trips.hs
Normal file
42
users/wpcarro/assessments/tt/src/Trips.hs
Normal file
|
@ -0,0 +1,42 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
--------------------------------------------------------------------------------
|
||||
module Trips where
|
||||
--------------------------------------------------------------------------------
|
||||
import Database.SQLite.Simple
|
||||
import Utils
|
||||
|
||||
import qualified Types as T
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- | Create a new `trip` in `dbFile`.
|
||||
create :: FilePath -> T.Trip -> IO ()
|
||||
create dbFile trip = withConnection dbFile $ \conn ->
|
||||
execute conn "INSERT INTO Trips (username,destination,startDate,endDate,comment) VALUES (?,?,?,?,?)"
|
||||
(trip |> T.tripFields)
|
||||
|
||||
-- | Attempt to get the trip record from `dbFile` under `tripKey`.
|
||||
get :: FilePath -> T.TripPK -> IO (Maybe T.Trip)
|
||||
get dbFile tripKey = withConnection dbFile $ \conn -> do
|
||||
res <- query conn "SELECT username,destination,startDate,endDate,comment FROM Trips WHERE username = ? AND destination = ? AND startDate = ? LIMIT 1"
|
||||
(T.tripPKFields tripKey)
|
||||
case res of
|
||||
[x] -> pure (Just x)
|
||||
_ -> pure Nothing
|
||||
|
||||
-- | Delete a trip from `dbFile` using its `tripKey` Primary Key.
|
||||
delete :: FilePath -> T.TripPK -> IO ()
|
||||
delete dbFile tripKey =
|
||||
withConnection dbFile $ \conn -> do
|
||||
execute conn "DELETE FROM Trips WHERE username = ? AND destination = ? and startDate = ?"
|
||||
(T.tripPKFields tripKey)
|
||||
|
||||
-- | Return a list of all of the trips in `dbFile`.
|
||||
listAll :: FilePath -> IO [T.Trip]
|
||||
listAll dbFile = withConnection dbFile $ \conn ->
|
||||
query_ conn "SELECT username,destination,startDate,endDate,comment FROM Trips ORDER BY date(startDate) ASC"
|
||||
|
||||
-- | Return a list of all of the trips in `dbFile`.
|
||||
list :: FilePath -> T.Username -> IO [T.Trip]
|
||||
list dbFile username = withConnection dbFile $ \conn ->
|
||||
query conn "SELECT username,destination,startDate,endDate,comment FROM Trips WHERE username = ? ORDER BY date(startDate) ASC"
|
||||
(Only username)
|
544
users/wpcarro/assessments/tt/src/Types.hs
Normal file
544
users/wpcarro/assessments/tt/src/Types.hs
Normal file
|
@ -0,0 +1,544 @@
|
|||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
--------------------------------------------------------------------------------
|
||||
module Types where
|
||||
--------------------------------------------------------------------------------
|
||||
import Data.Aeson
|
||||
import Utils
|
||||
import Data.Text
|
||||
import Data.Typeable
|
||||
import Database.SQLite.Simple
|
||||
import Database.SQLite.Simple.Ok
|
||||
import Database.SQLite.Simple.FromField
|
||||
import Database.SQLite.Simple.ToField
|
||||
import GHC.Generics
|
||||
import Web.Cookie
|
||||
import Servant.API
|
||||
import System.Envy (FromEnv, fromEnv, env)
|
||||
import Crypto.Random.Types (MonadRandom)
|
||||
|
||||
import qualified Data.Time.Calendar as Calendar
|
||||
import qualified Crypto.KDF.BCrypt as BC
|
||||
import qualified Data.Time.Clock as Clock
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.Text.Encoding as TE
|
||||
import qualified Data.Maybe as M
|
||||
import qualified Data.UUID as UUID
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- | Top-level application configuration.
|
||||
data Config = Config
|
||||
{ mailgunAPIKey :: Text
|
||||
, dbFile :: FilePath
|
||||
, configClient :: Text
|
||||
, configServer :: Text
|
||||
} deriving (Eq, Show)
|
||||
|
||||
instance FromEnv Config where
|
||||
fromEnv _ = do
|
||||
mailgunAPIKey <- env "MAILGUN_API_KEY"
|
||||
dbFile <- env "DB_FILE"
|
||||
configClient <- env "CLIENT"
|
||||
configServer <- env "SERVER"
|
||||
pure Config {..}
|
||||
|
||||
-- TODO(wpcarro): Properly handle NULL for columns like profilePicture.
|
||||
forNewtype :: (Typeable b) => (Text -> b) -> FieldParser b
|
||||
forNewtype wrapper y =
|
||||
case fieldData y of
|
||||
(SQLText x) -> Ok (wrapper x)
|
||||
x -> returnError ConversionFailed y ("We expected SQLText, but we received: " ++ show x)
|
||||
|
||||
newtype Username = Username Text
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
instance ToJSON Username
|
||||
instance FromJSON Username
|
||||
|
||||
instance ToField Username where
|
||||
toField (Username x) = SQLText x
|
||||
|
||||
instance FromField Username where
|
||||
fromField = forNewtype Username
|
||||
|
||||
newtype HashedPassword = HashedPassword BS.ByteString
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
instance ToField HashedPassword where
|
||||
toField (HashedPassword x) = SQLText (TE.decodeUtf8 x)
|
||||
|
||||
instance FromField HashedPassword where
|
||||
fromField y =
|
||||
case fieldData y of
|
||||
(SQLText x) -> x |> TE.encodeUtf8 |> HashedPassword |> Ok
|
||||
x -> returnError ConversionFailed y ("We expected SQLText, but we received: " ++ show x)
|
||||
|
||||
newtype ClearTextPassword = ClearTextPassword Text
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
instance ToJSON ClearTextPassword
|
||||
instance FromJSON ClearTextPassword
|
||||
|
||||
instance ToField ClearTextPassword where
|
||||
toField (ClearTextPassword x) = SQLText x
|
||||
|
||||
instance FromField ClearTextPassword where
|
||||
fromField = forNewtype ClearTextPassword
|
||||
|
||||
newtype Email = Email Text
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
instance ToJSON Email
|
||||
instance FromJSON Email
|
||||
|
||||
instance ToField Email where
|
||||
toField (Email x) = SQLText x
|
||||
|
||||
instance FromField Email where
|
||||
fromField = forNewtype Email
|
||||
|
||||
data Role = RegularUser | Manager | Admin
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
instance ToJSON Role where
|
||||
toJSON RegularUser = "user"
|
||||
toJSON Manager = "manager"
|
||||
toJSON Admin = "admin"
|
||||
|
||||
instance FromJSON Role where
|
||||
parseJSON = withText "Role" $ \x ->
|
||||
case x of
|
||||
"user" -> pure RegularUser
|
||||
"manager" -> pure Manager
|
||||
"admin" -> pure Admin
|
||||
_ -> fail "Expected \"user\" or \"manager\" or \"admin\""
|
||||
|
||||
instance ToField Role where
|
||||
toField RegularUser = SQLText "user"
|
||||
toField Manager = SQLText "manager"
|
||||
toField Admin = SQLText "admin"
|
||||
|
||||
instance FromField Role where
|
||||
fromField y =
|
||||
case fieldData y of
|
||||
(SQLText "user") -> Ok RegularUser
|
||||
(SQLText "manager") -> Ok Manager
|
||||
(SQLText "admin") -> Ok Admin
|
||||
x -> returnError ConversionFailed y ("We expected user, manager, admin, but we received: " ++ show x)
|
||||
|
||||
-- TODO(wpcarro): Prefer Data.ByteString instead of Text
|
||||
newtype ProfilePicture = ProfilePicture Text
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
instance ToJSON ProfilePicture
|
||||
instance FromJSON ProfilePicture
|
||||
|
||||
instance ToField ProfilePicture where
|
||||
toField (ProfilePicture x) = SQLText x
|
||||
|
||||
instance FromField ProfilePicture where
|
||||
fromField = forNewtype ProfilePicture
|
||||
|
||||
data Account = Account
|
||||
{ accountUsername :: Username
|
||||
, accountPassword :: HashedPassword
|
||||
, accountEmail :: Email
|
||||
, accountRole :: Role
|
||||
, accountProfilePicture :: Maybe ProfilePicture
|
||||
} deriving (Eq, Show, Generic)
|
||||
|
||||
-- | Return a tuple with all of the fields for an Account record to use for SQL.
|
||||
accountFields :: Account -> (Username, HashedPassword, Email, Role, Maybe ProfilePicture)
|
||||
accountFields (Account {..})
|
||||
= ( accountUsername
|
||||
, accountPassword
|
||||
, accountEmail
|
||||
, accountRole
|
||||
, accountProfilePicture
|
||||
)
|
||||
|
||||
instance FromRow Account where
|
||||
fromRow = do
|
||||
accountUsername <- field
|
||||
accountPassword <- field
|
||||
accountEmail <- field
|
||||
accountRole <- field
|
||||
accountProfilePicture <- field
|
||||
pure Account{..}
|
||||
|
||||
data Session = Session
|
||||
{ sessionUsername :: Username
|
||||
, sessionRole :: Role
|
||||
} deriving (Eq, Show)
|
||||
|
||||
instance ToJSON Session where
|
||||
toJSON (Session username role) =
|
||||
object [ "username" .= username
|
||||
, "role" .= role
|
||||
]
|
||||
|
||||
newtype Comment = Comment Text
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
instance ToJSON Comment
|
||||
instance FromJSON Comment
|
||||
|
||||
instance ToField Comment where
|
||||
toField (Comment x) = SQLText x
|
||||
|
||||
instance FromField Comment where
|
||||
fromField = forNewtype Comment
|
||||
|
||||
newtype Destination = Destination Text
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
instance ToJSON Destination
|
||||
instance FromJSON Destination
|
||||
|
||||
instance ToField Destination where
|
||||
toField (Destination x) = SQLText x
|
||||
|
||||
instance FromField Destination where
|
||||
fromField = forNewtype Destination
|
||||
|
||||
newtype Year = Year Integer deriving (Eq, Show)
|
||||
newtype Month = Month Integer deriving (Eq, Show)
|
||||
newtype Day = Day Integer deriving (Eq, Show)
|
||||
data Date = Date
|
||||
{ dateYear :: Year
|
||||
, dateMonth :: Month
|
||||
, dateDay :: Day
|
||||
} deriving (Eq, Show)
|
||||
|
||||
data Trip = Trip
|
||||
{ tripUsername :: Username
|
||||
, tripDestination :: Destination
|
||||
, tripStartDate :: Calendar.Day
|
||||
, tripEndDate :: Calendar.Day
|
||||
, tripComment :: Comment
|
||||
} deriving (Eq, Show, Generic)
|
||||
|
||||
instance FromRow Trip where
|
||||
fromRow = do
|
||||
tripUsername <- field
|
||||
tripDestination <- field
|
||||
tripStartDate <- field
|
||||
tripEndDate <- field
|
||||
tripComment <- field
|
||||
pure Trip{..}
|
||||
|
||||
-- | The fields used as the Primary Key for a Trip entry.
|
||||
data TripPK = TripPK
|
||||
{ tripPKUsername :: Username
|
||||
, tripPKDestination :: Destination
|
||||
, tripPKStartDate :: Calendar.Day
|
||||
} deriving (Eq, Show, Generic)
|
||||
|
||||
tripPKFields :: TripPK -> (Username, Destination, Calendar.Day)
|
||||
tripPKFields (TripPK{..})
|
||||
= (tripPKUsername, tripPKDestination, tripPKStartDate)
|
||||
|
||||
instance FromJSON TripPK where
|
||||
parseJSON = withObject "TripPK" $ \x -> do
|
||||
tripPKUsername <- x .: "username"
|
||||
tripPKDestination <- x .: "destination"
|
||||
tripPKStartDate <- x .: "startDate"
|
||||
pure TripPK{..}
|
||||
|
||||
-- | Return the tuple representation of a Trip record for SQL.
|
||||
tripFields :: Trip
|
||||
-> (Username, Destination, Calendar.Day, Calendar.Day, Comment)
|
||||
tripFields (Trip{..})
|
||||
= ( tripUsername
|
||||
, tripDestination
|
||||
, tripStartDate
|
||||
, tripEndDate
|
||||
, tripComment
|
||||
)
|
||||
|
||||
instance ToJSON Trip where
|
||||
toJSON (Trip username destination startDate endDate comment) =
|
||||
object [ "username" .= username
|
||||
, "destination" .= destination
|
||||
, "startDate" .= startDate
|
||||
, "endDate" .= endDate
|
||||
, "comment" .= comment
|
||||
]
|
||||
|
||||
instance FromJSON Trip where
|
||||
parseJSON = withObject "Trip" $ \x -> do
|
||||
tripUsername <- x .: "username"
|
||||
tripDestination <- x .: "destination"
|
||||
tripStartDate <- x .: "startDate"
|
||||
tripEndDate <- x .: "endDate"
|
||||
tripComment <- x .: "comment"
|
||||
pure Trip{..}
|
||||
|
||||
-- | Users and Accounts both refer to the same underlying entities; however,
|
||||
-- Users model the user-facing Account details, hiding sensitive details like
|
||||
-- passwords and emails.
|
||||
data User = User
|
||||
{ userUsername :: Username
|
||||
, userProfilePicture :: Maybe ProfilePicture
|
||||
, userRole :: Role
|
||||
} deriving (Eq, Show, Generic)
|
||||
|
||||
instance ToJSON User where
|
||||
toJSON (User username profilePicture role) =
|
||||
object [ "username" .= username
|
||||
, "profilePicture" .= profilePicture
|
||||
, "role" .= role
|
||||
]
|
||||
|
||||
userFromAccount :: Account -> User
|
||||
userFromAccount account =
|
||||
User { userUsername = accountUsername account
|
||||
, userProfilePicture = accountProfilePicture account
|
||||
, userRole = accountRole account
|
||||
}
|
||||
|
||||
-- | This is the data that a user needs to supply to authenticate with the
|
||||
-- application.
|
||||
data AccountCredentials = AccountCredentials
|
||||
{ accountCredentialsUsername :: Username
|
||||
, accountCredentialsPassword :: ClearTextPassword
|
||||
} deriving (Eq, Show, Generic)
|
||||
|
||||
instance FromJSON AccountCredentials where
|
||||
parseJSON = withObject "AccountCredentials" $ \x -> do
|
||||
accountCredentialsUsername <- x.: "username"
|
||||
accountCredentialsPassword <- x.: "password"
|
||||
pure AccountCredentials{..}
|
||||
|
||||
|
||||
-- | Hash password `x`.
|
||||
hashPassword :: (MonadRandom m) => ClearTextPassword -> m HashedPassword
|
||||
hashPassword (ClearTextPassword x) = do
|
||||
hashed <- BC.hashPassword 12 (x |> unpack |> B.pack)
|
||||
pure $ HashedPassword hashed
|
||||
|
||||
-- | Return True if the cleartext password matches the hashed password.
|
||||
passwordsMatch :: ClearTextPassword -> HashedPassword -> Bool
|
||||
passwordsMatch (ClearTextPassword clear) (HashedPassword hashed) =
|
||||
BC.validatePassword (clear |> unpack |> B.pack) hashed
|
||||
|
||||
data CreateAccountRequest = CreateAccountRequest
|
||||
{ createAccountRequestUsername :: Username
|
||||
, createAccountRequestPassword :: ClearTextPassword
|
||||
, createAccountRequestEmail :: Email
|
||||
, createAccountRequestRole :: Role
|
||||
} deriving (Eq, Show)
|
||||
|
||||
instance FromJSON CreateAccountRequest where
|
||||
parseJSON = withObject "CreateAccountRequest" $ \x -> do
|
||||
createAccountRequestUsername <- x .: "username"
|
||||
createAccountRequestPassword <- x .: "password"
|
||||
createAccountRequestEmail <- x .: "email"
|
||||
createAccountRequestRole <- x .: "role"
|
||||
pure $ CreateAccountRequest{..}
|
||||
|
||||
createAccountRequestFields :: CreateAccountRequest
|
||||
-> (Username, ClearTextPassword, Email, Role)
|
||||
createAccountRequestFields CreateAccountRequest{..} =
|
||||
( createAccountRequestUsername
|
||||
, createAccountRequestPassword
|
||||
, createAccountRequestEmail
|
||||
, createAccountRequestRole
|
||||
)
|
||||
|
||||
newtype SessionUUID = SessionUUID UUID.UUID
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
instance FromField SessionUUID where
|
||||
fromField y =
|
||||
case fieldData y of
|
||||
(SQLText x) ->
|
||||
case UUID.fromText x of
|
||||
Nothing -> returnError ConversionFailed y ("Could not convert to UUID: " ++ show x)
|
||||
Just uuid -> Ok $ SessionUUID uuid
|
||||
_ -> returnError ConversionFailed y "Expected SQLText for SessionUUID, but we received"
|
||||
|
||||
instance ToField SessionUUID where
|
||||
toField (SessionUUID uuid) =
|
||||
uuid |> UUID.toText |> SQLText
|
||||
|
||||
data StoredSession = StoredSession
|
||||
{ storedSessionUUID :: SessionUUID
|
||||
, storedSessionUsername :: Username
|
||||
, storedSessionTsCreated :: Clock.UTCTime
|
||||
} deriving (Eq, Show, Generic)
|
||||
|
||||
instance FromRow StoredSession where
|
||||
fromRow = do
|
||||
storedSessionUUID <- field
|
||||
storedSessionUsername <- field
|
||||
storedSessionTsCreated <- field
|
||||
pure StoredSession {..}
|
||||
|
||||
data LoginAttempt = LoginAttempt
|
||||
{ loginAttemptUsername :: Username
|
||||
, loginAttemptNumAttempts :: Integer
|
||||
} deriving (Eq, Show)
|
||||
|
||||
instance FromRow LoginAttempt where
|
||||
fromRow = do
|
||||
loginAttemptUsername <- field
|
||||
loginAttemptNumAttempts <- field
|
||||
pure LoginAttempt {..}
|
||||
|
||||
newtype SessionCookie = SessionCookie Cookies
|
||||
|
||||
instance FromHttpApiData SessionCookie where
|
||||
parseHeader x =
|
||||
x |> parseCookies |> SessionCookie |> pure
|
||||
parseQueryParam x =
|
||||
x |> TE.encodeUtf8 |> parseCookies |> SessionCookie |> pure
|
||||
|
||||
newtype RegistrationSecret = RegistrationSecret UUID.UUID
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
instance FromHttpApiData RegistrationSecret where
|
||||
parseQueryParam x =
|
||||
case UUID.fromText x of
|
||||
Nothing -> Left x
|
||||
Just uuid -> Right (RegistrationSecret uuid)
|
||||
|
||||
instance FromField RegistrationSecret where
|
||||
fromField y =
|
||||
case fieldData y of
|
||||
(SQLText x) ->
|
||||
case UUID.fromText x of
|
||||
Nothing -> returnError ConversionFailed y ("Could not convert text to UUID: " ++ show x)
|
||||
Just uuid -> Ok $ RegistrationSecret uuid
|
||||
_ -> returnError ConversionFailed y "Field data is not SQLText, which is what we expect"
|
||||
|
||||
instance ToField RegistrationSecret where
|
||||
toField (RegistrationSecret secretUUID) =
|
||||
secretUUID |> UUID.toText |> SQLText
|
||||
|
||||
instance FromJSON RegistrationSecret
|
||||
|
||||
data VerifyAccountRequest = VerifyAccountRequest
|
||||
{ verifyAccountRequestUsername :: Username
|
||||
, verifyAccountRequestSecret :: RegistrationSecret
|
||||
} deriving (Eq, Show)
|
||||
|
||||
instance FromJSON VerifyAccountRequest where
|
||||
parseJSON = withObject "VerifyAccountRequest" $ \x -> do
|
||||
verifyAccountRequestUsername <- x .: "username"
|
||||
verifyAccountRequestSecret <- x .: "secret"
|
||||
pure VerifyAccountRequest{..}
|
||||
|
||||
data PendingAccount = PendingAccount
|
||||
{ pendingAccountSecret :: RegistrationSecret
|
||||
, pendingAccountUsername :: Username
|
||||
, pendingAccountPassword :: HashedPassword
|
||||
, pendingAccountRole :: Role
|
||||
, pendingAccountEmail :: Email
|
||||
} deriving (Eq, Show)
|
||||
|
||||
instance FromRow PendingAccount where
|
||||
fromRow = do
|
||||
pendingAccountSecret <- field
|
||||
pendingAccountUsername <- field
|
||||
pendingAccountPassword <- field
|
||||
pendingAccountRole <- field
|
||||
pendingAccountEmail <- field
|
||||
pure PendingAccount {..}
|
||||
|
||||
data UpdateTripRequest = UpdateTripRequest
|
||||
{ updateTripRequestTripPK :: TripPK
|
||||
, updateTripRequestDestination :: Maybe Destination
|
||||
, updateTripRequestStartDate :: Maybe Calendar.Day
|
||||
, updateTripRequestEndDate :: Maybe Calendar.Day
|
||||
, updateTripRequestComment :: Maybe Comment
|
||||
} deriving (Eq, Show)
|
||||
|
||||
instance FromJSON UpdateTripRequest where
|
||||
parseJSON = withObject "UpdateTripRequest" $ \x -> do
|
||||
updateTripRequestTripPK <- x .: "tripKey"
|
||||
-- the following four fields might not be present
|
||||
updateTripRequestDestination <- x .:? "destination"
|
||||
updateTripRequestStartDate <- x .:? "startDate"
|
||||
updateTripRequestEndDate <- x .:? "endDate"
|
||||
updateTripRequestComment <- x .:? "comment"
|
||||
pure UpdateTripRequest{..}
|
||||
|
||||
-- | Apply the updates in the UpdateTripRequest to Trip.
|
||||
updateTrip :: UpdateTripRequest -> Trip -> Trip
|
||||
updateTrip UpdateTripRequest{..} Trip{..} = Trip
|
||||
{ tripUsername = tripUsername
|
||||
, tripDestination = M.fromMaybe tripDestination updateTripRequestDestination
|
||||
, tripStartDate = M.fromMaybe tripStartDate updateTripRequestStartDate
|
||||
, tripEndDate = M.fromMaybe tripEndDate updateTripRequestEndDate
|
||||
, tripComment = M.fromMaybe tripComment updateTripRequestComment
|
||||
}
|
||||
|
||||
data UnfreezeAccountRequest = UnfreezeAccountRequest
|
||||
{ unfreezeAccountRequestUsername :: Username
|
||||
} deriving (Eq, Show)
|
||||
|
||||
instance FromJSON UnfreezeAccountRequest where
|
||||
parseJSON = withObject "UnfreezeAccountRequest" $ \x -> do
|
||||
unfreezeAccountRequestUsername <- x .: "username"
|
||||
pure UnfreezeAccountRequest{..}
|
||||
|
||||
data InviteUserRequest = InviteUserRequest
|
||||
{ inviteUserRequestEmail :: Email
|
||||
, inviteUserRequestRole :: Role
|
||||
} deriving (Eq, Show)
|
||||
|
||||
instance FromJSON InviteUserRequest where
|
||||
parseJSON = withObject "InviteUserRequest" $ \x -> do
|
||||
inviteUserRequestEmail <- x .: "email"
|
||||
inviteUserRequestRole <- x .: "role"
|
||||
pure InviteUserRequest{..}
|
||||
|
||||
newtype InvitationSecret = InvitationSecret UUID.UUID
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
instance ToJSON InvitationSecret
|
||||
instance FromJSON InvitationSecret
|
||||
|
||||
instance ToField InvitationSecret where
|
||||
toField (InvitationSecret secretUUID) =
|
||||
secretUUID |> UUID.toText |> SQLText
|
||||
|
||||
instance FromField InvitationSecret where
|
||||
fromField y =
|
||||
case fieldData y of
|
||||
(SQLText x) ->
|
||||
case UUID.fromText x of
|
||||
Nothing -> returnError ConversionFailed y ("Could not convert text to UUID: " ++ show x)
|
||||
Just z -> Ok $ InvitationSecret z
|
||||
_ -> returnError ConversionFailed y "Field data is not SQLText, which is what we expect"
|
||||
|
||||
data Invitation = Invitation
|
||||
{ invitationEmail :: Email
|
||||
, invitationRole :: Role
|
||||
, invitationSecret :: InvitationSecret
|
||||
} deriving (Eq, Show)
|
||||
|
||||
instance FromRow Invitation where
|
||||
fromRow = Invitation <$> field
|
||||
<*> field
|
||||
<*> field
|
||||
|
||||
data AcceptInvitationRequest = AcceptInvitationRequest
|
||||
{ acceptInvitationRequestUsername :: Username
|
||||
, acceptInvitationRequestPassword :: ClearTextPassword
|
||||
, acceptInvitationRequestEmail :: Email
|
||||
, acceptInvitationRequestSecret :: InvitationSecret
|
||||
} deriving (Eq, Show)
|
||||
|
||||
instance FromJSON AcceptInvitationRequest where
|
||||
parseJSON = withObject "AcceptInvitationRequest" $ \x -> do
|
||||
acceptInvitationRequestUsername <- x .: "username"
|
||||
acceptInvitationRequestPassword <- x .: "password"
|
||||
acceptInvitationRequestEmail <- x .: "email"
|
||||
acceptInvitationRequestSecret <- x .: "secret"
|
||||
pure AcceptInvitationRequest{..}
|
9
users/wpcarro/assessments/tt/src/Utils.hs
Normal file
9
users/wpcarro/assessments/tt/src/Utils.hs
Normal file
|
@ -0,0 +1,9 @@
|
|||
--------------------------------------------------------------------------------
|
||||
module Utils where
|
||||
--------------------------------------------------------------------------------
|
||||
import Data.Function ((&))
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- | Prefer this operator to the ampersand for stylistic reasons.
|
||||
(|>) :: a -> (a -> b) -> b
|
||||
(|>) = (&)
|
67
users/wpcarro/assessments/tt/src/init.sql
Normal file
67
users/wpcarro/assessments/tt/src/init.sql
Normal file
|
@ -0,0 +1,67 @@
|
|||
-- Run `.read init.sql` from within a SQLite3 REPL to initialize the tables we
|
||||
-- need for this application. This will erase all current entries, so use with
|
||||
-- caution.
|
||||
-- Make sure to set `PRAGMA foreign_keys = on;` when transacting with the
|
||||
-- database.
|
||||
|
||||
BEGIN TRANSACTION;
|
||||
|
||||
DROP TABLE IF EXISTS Accounts;
|
||||
DROP TABLE IF EXISTS Trips;
|
||||
DROP TABLE IF EXISTS Sessions;
|
||||
DROP TABLE IF EXISTS LoginAttempts;
|
||||
DROP TABLE IF EXISTS PendingAccounts;
|
||||
DROP TABLE IF EXISTS Invitations;
|
||||
|
||||
CREATE TABLE Accounts (
|
||||
username TEXT CHECK(LENGTH(username) > 0) NOT NULL,
|
||||
password TEXT CHECK(LENGTH(password) > 0) NOT NULL,
|
||||
email TEXT CHECK(LENGTH(email) > 0) NOT NULL UNIQUE,
|
||||
role TEXT CHECK(role IN ('user', 'manager', 'admin')) NOT NULL,
|
||||
profilePicture BLOB,
|
||||
PRIMARY KEY (username)
|
||||
);
|
||||
|
||||
CREATE TABLE Trips (
|
||||
username TEXT NOT NULL,
|
||||
destination TEXT CHECK(LENGTH(destination) > 0) NOT NULL,
|
||||
startDate TEXT CHECK(LENGTH(startDate) == 10) NOT NULL, -- 'YYYY-MM-DD'
|
||||
endDate TEXT CHECK(LENGTH(endDate) == 10) NOT NULL, -- 'YYYY-MM-DD'
|
||||
comment TEXT NOT NULL,
|
||||
PRIMARY KEY (username, destination, startDate),
|
||||
FOREIGN KEY (username) REFERENCES Accounts ON DELETE CASCADE
|
||||
);
|
||||
|
||||
CREATE TABLE Sessions (
|
||||
uuid TEXT CHECK(LENGTH(uuid) == 36) NOT NULL,
|
||||
username TEXT NOT NULL UNIQUE,
|
||||
-- TODO(wpcarro): Add a LENGTH CHECK here
|
||||
tsCreated TEXT NOT NULL, -- 'YYYY-MM-DD HH:MM:SS'
|
||||
PRIMARY KEY (uuid),
|
||||
FOREIGN KEY (username) REFERENCES Accounts ON DELETE CASCADE
|
||||
);
|
||||
|
||||
CREATE TABLE LoginAttempts (
|
||||
username TEXT NOT NULL UNIQUE,
|
||||
numAttempts INTEGER NOT NULL,
|
||||
PRIMARY KEY (username),
|
||||
FOREIGN KEY (username) REFERENCES Accounts ON DELETE CASCADE
|
||||
);
|
||||
|
||||
CREATE TABLE PendingAccounts (
|
||||
secret TEXT CHECK(LENGTH(secret) == 36) NOT NULL,
|
||||
username TEXT CHECK(LENGTH(username) > 0) NOT NULL,
|
||||
password TEXT CHECK(LENGTH(password) > 0) NOT NULL,
|
||||
role TEXT CHECK(role IN ('user', 'manager', 'admin')) NOT NULL,
|
||||
email TEXT CHECK(LENGTH(email) > 0) NOT NULL UNIQUE,
|
||||
PRIMARY KEY (username)
|
||||
);
|
||||
|
||||
CREATE TABLE Invitations (
|
||||
email TEXT CHECK(LENGTH(email) > 0) NOT NULL UNIQUE,
|
||||
role TEXT CHECK(role IN ('user', 'manager', 'admin')) NOT NULL,
|
||||
secret TEXT CHECK(LENGTH(secret) == 36) NOT NULL,
|
||||
PRIMARY KEY (email)
|
||||
);
|
||||
|
||||
COMMIT;
|
21
users/wpcarro/assessments/tt/tests/create-accounts.sh
Executable file
21
users/wpcarro/assessments/tt/tests/create-accounts.sh
Executable file
|
@ -0,0 +1,21 @@
|
|||
#!/usr/bin/env sh
|
||||
|
||||
# This script populates the Accounts table over HTTP.
|
||||
|
||||
http POST :3000/accounts \
|
||||
username=mimi \
|
||||
password=testing \
|
||||
email=miriamwright@google.com \
|
||||
role=user
|
||||
|
||||
http POST :3000/accounts \
|
||||
username=bill \
|
||||
password=testing \
|
||||
email=wpcarro@gmail.com \
|
||||
role=manager
|
||||
|
||||
http POST :3000/accounts \
|
||||
username=wpcarro \
|
||||
password=testing \
|
||||
email=wpcarro@google.com \
|
||||
role=admin
|
18
users/wpcarro/assessments/tt/todo.org
Normal file
18
users/wpcarro/assessments/tt/todo.org
Normal file
|
@ -0,0 +1,18 @@
|
|||
* TODO Users must be able to create an account
|
||||
* TODO Users must verify their account by email
|
||||
* TODO Support federated login with Google
|
||||
* TODO Users must be able to authenticate and login
|
||||
* TODO Define three roles: user, manager, admin
|
||||
* TODO Users can add trips
|
||||
* TODO Users can edit trips
|
||||
* TODO Users can delete trips
|
||||
* TODO Users can filter trips
|
||||
* TODO Support all actions via the REST API
|
||||
* TODO Block users after three failed authentication attempts
|
||||
* TODO Only admins and managers can unblock blocked login attempts
|
||||
* TODO Add unit tests
|
||||
* TODO Add E2E tests
|
||||
* TODO Pull user profile pictures using Gravatar
|
||||
* TODO Allow users to change their profile picture
|
||||
* TODO Admins should be allowed to invite new users via email
|
||||
* TODO Allow users to print their travel itineraries
|
21
users/wpcarro/boilerplate/README.md
Normal file
21
users/wpcarro/boilerplate/README.md
Normal file
|
@ -0,0 +1,21 @@
|
|||
# Boilerplate
|
||||
|
||||
Storing some boilerplate code to help me reduce the time it takes me to develop
|
||||
and deploy applications.
|
||||
|
||||
## Usage
|
||||
|
||||
Let's say that you would like to create a game for
|
||||
`sandbox.wpcarro.dev/game`. We will create a new TypeScript project with the
|
||||
following:
|
||||
|
||||
```shell
|
||||
$ cp ~/briefcase/boilerplate/typescript ~/briefcase/website/sandbox/game
|
||||
```
|
||||
|
||||
This initializes the project. To start developing, run:
|
||||
|
||||
```shell
|
||||
$ nix-shell
|
||||
$ yarn run dev
|
||||
```
|
2
users/wpcarro/boilerplate/clojure/.envrc
Normal file
2
users/wpcarro/boilerplate/clojure/.envrc
Normal file
|
@ -0,0 +1,2 @@
|
|||
source_up
|
||||
use_nix
|
4
users/wpcarro/boilerplate/clojure/.gitignore
vendored
Normal file
4
users/wpcarro/boilerplate/clojure/.gitignore
vendored
Normal file
|
@ -0,0 +1,4 @@
|
|||
/.lein-repl-history
|
||||
/target
|
||||
/?
|
||||
/.nrepl-port
|
33
users/wpcarro/boilerplate/clojure/README.md
Normal file
33
users/wpcarro/boilerplate/clojure/README.md
Normal file
|
@ -0,0 +1,33 @@
|
|||
# Clojure Boilerplate
|
||||
|
||||
This boilerplate uses `lein` to manage the project.
|
||||
|
||||
## Files to change
|
||||
|
||||
To use this boilerplate, run the following in a shell:
|
||||
|
||||
```shell
|
||||
$ cp ~/briefcase/boilerplate/clojure path/to/new-project
|
||||
```
|
||||
|
||||
After running the above command, change the following files to remove the
|
||||
placeholder values:
|
||||
|
||||
- `README.md`: Change the title; change the description; drop "Files to change";
|
||||
keep "Getting started"
|
||||
- `project.clj`: Change title
|
||||
- `src/main.clj`: Change `:doc`; drop `main/foo`
|
||||
|
||||
## Getting started
|
||||
|
||||
From a shell, run:
|
||||
|
||||
```shell
|
||||
$ lein repl
|
||||
```
|
||||
|
||||
From Emacs, navigate to a source code buffer and run:
|
||||
|
||||
```
|
||||
M-x cider-jack-in
|
||||
```
|
2
users/wpcarro/boilerplate/clojure/project.clj
Normal file
2
users/wpcarro/boilerplate/clojure/project.clj
Normal file
|
@ -0,0 +1,2 @@
|
|||
(defproject boilerplate "0.0.1"
|
||||
:dependencies [[org.clojure/clojure "1.8.0"]])
|
8
users/wpcarro/boilerplate/clojure/shell.nix
Normal file
8
users/wpcarro/boilerplate/clojure/shell.nix
Normal file
|
@ -0,0 +1,8 @@
|
|||
let
|
||||
briefcase = import <briefcase> {};
|
||||
pkgs = briefcase.third_party.pkgs;
|
||||
in pkgs.mkShell {
|
||||
buildInputs = with pkgs; [
|
||||
leiningen
|
||||
];
|
||||
}
|
8
users/wpcarro/boilerplate/clojure/src/main.clj
Normal file
8
users/wpcarro/boilerplate/clojure/src/main.clj
Normal file
|
@ -0,0 +1,8 @@
|
|||
(ns ^{:doc "Top-level module."
|
||||
:author "William Carroll"}
|
||||
main)
|
||||
|
||||
(declare main)
|
||||
|
||||
(defn foo [a b]
|
||||
(+ a b))
|
2
users/wpcarro/boilerplate/elm/.envrc
Normal file
2
users/wpcarro/boilerplate/elm/.envrc
Normal file
|
@ -0,0 +1,2 @@
|
|||
source_up
|
||||
use_nix
|
Some files were not shown because too many files have changed in this diff Show more
Loading…
Reference in a new issue