diff options
Diffstat (limited to 'users/wpcarro/assessments')
83 files changed, 5350 insertions, 0 deletions
diff --git a/users/wpcarro/assessments/brilliant/.ghci b/users/wpcarro/assessments/brilliant/.ghci new file mode 100644 index 000000000000..efc88e630ccb --- /dev/null +++ b/users/wpcarro/assessments/brilliant/.ghci @@ -0,0 +1,2 @@ +:set prompt "> " +:set -Wall diff --git a/users/wpcarro/assessments/brilliant/App.hs b/users/wpcarro/assessments/brilliant/App.hs new file mode 100644 index 000000000000..0272988f371c --- /dev/null +++ b/users/wpcarro/assessments/brilliant/App.hs @@ -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) diff --git a/users/wpcarro/assessments/brilliant/Keyboard.hs b/users/wpcarro/assessments/brilliant/Keyboard.hs new file mode 100644 index 000000000000..13b5de0145aa --- /dev/null +++ b/users/wpcarro/assessments/brilliant/Keyboard.hs @@ -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',',','.','/'] + ] diff --git a/users/wpcarro/assessments/brilliant/Main.hs b/users/wpcarro/assessments/brilliant/Main.hs new file mode 100644 index 000000000000..e94c73bea287 --- /dev/null +++ b/users/wpcarro/assessments/brilliant/Main.hs @@ -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") diff --git a/users/wpcarro/assessments/brilliant/README.md b/users/wpcarro/assessments/brilliant/README.md new file mode 100644 index 000000000000..60d7de4e25ae --- /dev/null +++ b/users/wpcarro/assessments/brilliant/README.md @@ -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][,][.][/] +``` diff --git a/users/wpcarro/assessments/brilliant/Spec.hs b/users/wpcarro/assessments/brilliant/Spec.hs new file mode 100644 index 000000000000..e99e025641fa --- /dev/null +++ b/users/wpcarro/assessments/brilliant/Spec.hs @@ -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] == [] diff --git a/users/wpcarro/assessments/brilliant/Transforms.hs b/users/wpcarro/assessments/brilliant/Transforms.hs new file mode 100644 index 000000000000..d8df8f8372e0 --- /dev/null +++ b/users/wpcarro/assessments/brilliant/Transforms.hs @@ -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 diff --git a/users/wpcarro/assessments/brilliant/Utils.hs b/users/wpcarro/assessments/brilliant/Utils.hs new file mode 100644 index 000000000000..c69d00333b8e --- /dev/null +++ b/users/wpcarro/assessments/brilliant/Utils.hs @@ -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 diff --git a/users/wpcarro/assessments/brilliant/default.nix b/users/wpcarro/assessments/brilliant/default.nix new file mode 100644 index 000000000000..886ba87e1caf --- /dev/null +++ b/users/wpcarro/assessments/brilliant/default.nix @@ -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 = []; +} diff --git a/users/wpcarro/assessments/brilliant/shell.nix b/users/wpcarro/assessments/brilliant/shell.nix new file mode 100644 index 000000000000..d0a6c7e5e6f5 --- /dev/null +++ b/users/wpcarro/assessments/brilliant/shell.nix @@ -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 + ])) + ]; +} diff --git a/users/wpcarro/assessments/dotted-squares/.envrc b/users/wpcarro/assessments/dotted-squares/.envrc new file mode 100644 index 000000000000..a4a62da526d3 --- /dev/null +++ b/users/wpcarro/assessments/dotted-squares/.envrc @@ -0,0 +1,2 @@ +source_up +use_nix diff --git a/users/wpcarro/assessments/dotted-squares/.ghci b/users/wpcarro/assessments/dotted-squares/.ghci new file mode 100644 index 000000000000..b100af4432c5 --- /dev/null +++ b/users/wpcarro/assessments/dotted-squares/.ghci @@ -0,0 +1 @@ +:set -Wall diff --git a/users/wpcarro/assessments/dotted-squares/Main.hs b/users/wpcarro/assessments/dotted-squares/Main.hs new file mode 100644 index 000000000000..44f91e2b2311 --- /dev/null +++ b/users/wpcarro/assessments/dotted-squares/Main.hs @@ -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 diff --git a/users/wpcarro/assessments/dotted-squares/README.md b/users/wpcarro/assessments/dotted-squares/README.md new file mode 100644 index 000000000000..3d13da1cb18e --- /dev/null +++ b/users/wpcarro/assessments/dotted-squares/README.md @@ -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. diff --git a/users/wpcarro/assessments/dotted-squares/Spec.hs b/users/wpcarro/assessments/dotted-squares/Spec.hs new file mode 100644 index 000000000000..b5d604085b9b --- /dev/null +++ b/users/wpcarro/assessments/dotted-squares/Spec.hs @@ -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 diff --git a/users/wpcarro/assessments/dotted-squares/colliding-moves.txt b/users/wpcarro/assessments/dotted-squares/colliding-moves.txt new file mode 100644 index 000000000000..a831fa95c08e --- /dev/null +++ b/users/wpcarro/assessments/dotted-squares/colliding-moves.txt @@ -0,0 +1,7 @@ +1 +1 +4 +0 0 R +0 0 R +0 1 R +0 1 R diff --git a/users/wpcarro/assessments/dotted-squares/game.txt b/users/wpcarro/assessments/dotted-squares/game.txt new file mode 100644 index 000000000000..0af71d1f5b56 --- /dev/null +++ b/users/wpcarro/assessments/dotted-squares/game.txt @@ -0,0 +1,7 @@ +1 +1 +4 +0 0 R +0 0 U +0 1 R +1 1 D diff --git a/users/wpcarro/assessments/dotted-squares/input-a.txt b/users/wpcarro/assessments/dotted-squares/input-a.txt new file mode 100644 index 000000000000..b9e871eced86 --- /dev/null +++ b/users/wpcarro/assessments/dotted-squares/input-a.txt @@ -0,0 +1,5 @@ +1 +1 +2 +0 0 R +0 0 U diff --git a/users/wpcarro/assessments/dotted-squares/shell.nix b/users/wpcarro/assessments/dotted-squares/shell.nix new file mode 100644 index 000000000000..87eb23d731e2 --- /dev/null +++ b/users/wpcarro/assessments/dotted-squares/shell.nix @@ -0,0 +1,8 @@ +let + briefcase = import <briefcase> {}; +in briefcase.buildHaskell.shell { + deps = hpkgs: with hpkgs; [ + hspec + unordered-containers + ]; +} diff --git a/users/wpcarro/assessments/dotted-squares/too-few-moves.txt b/users/wpcarro/assessments/dotted-squares/too-few-moves.txt new file mode 100644 index 000000000000..d684679d264f --- /dev/null +++ b/users/wpcarro/assessments/dotted-squares/too-few-moves.txt @@ -0,0 +1,6 @@ +1 +1 +4 +0 0 R +0 0 U +0 1 R diff --git a/users/wpcarro/assessments/dotted-squares/too-many-moves.txt b/users/wpcarro/assessments/dotted-squares/too-many-moves.txt new file mode 100644 index 000000000000..bfcced43b930 --- /dev/null +++ b/users/wpcarro/assessments/dotted-squares/too-many-moves.txt @@ -0,0 +1,7 @@ +1 +1 +3 +0 0 R +0 0 U +0 1 R +1 1 D diff --git a/users/wpcarro/assessments/ramp/solution-emacs-elixir-format.py b/users/wpcarro/assessments/ramp/solution-emacs-elixir-format.py new file mode 100644 index 000000000000..d0d948402001 --- /dev/null +++ b/users/wpcarro/assessments/ramp/solution-emacs-elixir-format.py @@ -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 diff --git a/users/wpcarro/assessments/ramp/solution.py b/users/wpcarro/assessments/ramp/solution.py new file mode 100644 index 000000000000..28060bfb3c40 --- /dev/null +++ b/users/wpcarro/assessments/ramp/solution.py @@ -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()) diff --git a/users/wpcarro/assessments/semiprimes/.gitignore b/users/wpcarro/assessments/semiprimes/.gitignore new file mode 100644 index 000000000000..b5b25bd64822 --- /dev/null +++ b/users/wpcarro/assessments/semiprimes/.gitignore @@ -0,0 +1 @@ +default.nix diff --git a/users/wpcarro/assessments/semiprimes/README.md b/users/wpcarro/assessments/semiprimes/README.md new file mode 100644 index 000000000000..7d5a15482ab3 --- /dev/null +++ b/users/wpcarro/assessments/semiprimes/README.md @@ -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`! + diff --git a/users/wpcarro/assessments/semiprimes/default.nix b/users/wpcarro/assessments/semiprimes/default.nix new file mode 100644 index 000000000000..29452eac250c --- /dev/null +++ b/users/wpcarro/assessments/semiprimes/default.nix @@ -0,0 +1 @@ +# stubbed diff --git a/users/wpcarro/assessments/semiprimes/server/.formatter.exs b/users/wpcarro/assessments/semiprimes/server/.formatter.exs new file mode 100644 index 000000000000..d2cda26eddc9 --- /dev/null +++ b/users/wpcarro/assessments/semiprimes/server/.formatter.exs @@ -0,0 +1,4 @@ +# Used by "mix format" +[ + inputs: ["{mix,.formatter}.exs", "{config,lib,test}/**/*.{ex,exs}"] +] diff --git a/users/wpcarro/assessments/semiprimes/server/.gitignore b/users/wpcarro/assessments/semiprimes/server/.gitignore new file mode 100644 index 000000000000..db9704a85ff6 --- /dev/null +++ b/users/wpcarro/assessments/semiprimes/server/.gitignore @@ -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 + diff --git a/users/wpcarro/assessments/semiprimes/server/lib/app.ex b/users/wpcarro/assessments/semiprimes/server/lib/app.ex new file mode 100644 index 000000000000..7a6fa5ea248d --- /dev/null +++ b/users/wpcarro/assessments/semiprimes/server/lib/app.ex @@ -0,0 +1,8 @@ +defmodule App do + use Application + + @impl true + def start(_type, _args) do + Sup.start_link() + end +end diff --git a/users/wpcarro/assessments/semiprimes/server/lib/cache.ex b/users/wpcarro/assessments/semiprimes/server/lib/cache.ex new file mode 100644 index 000000000000..cd064cc1ae4b --- /dev/null +++ b/users/wpcarro/assessments/semiprimes/server/lib/cache.ex @@ -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 diff --git a/users/wpcarro/assessments/semiprimes/server/lib/extras.ex b/users/wpcarro/assessments/semiprimes/server/lib/extras.ex new file mode 100644 index 000000000000..f0c2ea4b9e21 --- /dev/null +++ b/users/wpcarro/assessments/semiprimes/server/lib/extras.ex @@ -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 diff --git a/users/wpcarro/assessments/semiprimes/server/lib/math.ex b/users/wpcarro/assessments/semiprimes/server/lib/math.ex new file mode 100644 index 000000000000..8a33be475389 --- /dev/null +++ b/users/wpcarro/assessments/semiprimes/server/lib/math.ex @@ -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 diff --git a/users/wpcarro/assessments/semiprimes/server/lib/router.ex b/users/wpcarro/assessments/semiprimes/server/lib/router.ex new file mode 100644 index 000000000000..cb55520920de --- /dev/null +++ b/users/wpcarro/assessments/semiprimes/server/lib/router.ex @@ -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 diff --git a/users/wpcarro/assessments/semiprimes/server/lib/server.ex b/users/wpcarro/assessments/semiprimes/server/lib/server.ex new file mode 100644 index 000000000000..7ab5e905b5a0 --- /dev/null +++ b/users/wpcarro/assessments/semiprimes/server/lib/server.ex @@ -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 diff --git a/users/wpcarro/assessments/semiprimes/server/lib/sup.ex b/users/wpcarro/assessments/semiprimes/server/lib/sup.ex new file mode 100644 index 000000000000..13a6ab374ff6 --- /dev/null +++ b/users/wpcarro/assessments/semiprimes/server/lib/sup.ex @@ -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 diff --git a/users/wpcarro/assessments/semiprimes/server/mix.exs b/users/wpcarro/assessments/semiprimes/server/mix.exs new file mode 100644 index 000000000000..9062f927e7a8 --- /dev/null +++ b/users/wpcarro/assessments/semiprimes/server/mix.exs @@ -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 diff --git a/users/wpcarro/assessments/semiprimes/server/mix.lock b/users/wpcarro/assessments/semiprimes/server/mix.lock new file mode 100644 index 000000000000..2ae7efbb3fb6 --- /dev/null +++ b/users/wpcarro/assessments/semiprimes/server/mix.lock @@ -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"}, +} diff --git a/users/wpcarro/assessments/semiprimes/server/test/extras_test.exs b/users/wpcarro/assessments/semiprimes/server/test/extras_test.exs new file mode 100644 index 000000000000..67d0b8875cae --- /dev/null +++ b/users/wpcarro/assessments/semiprimes/server/test/extras_test.exs @@ -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 diff --git a/users/wpcarro/assessments/semiprimes/server/test/math_test.exs b/users/wpcarro/assessments/semiprimes/server/test/math_test.exs new file mode 100644 index 000000000000..c7186c824a8c --- /dev/null +++ b/users/wpcarro/assessments/semiprimes/server/test/math_test.exs @@ -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 diff --git a/users/wpcarro/assessments/semiprimes/server/test/server_test.exs b/users/wpcarro/assessments/semiprimes/server/test/server_test.exs new file mode 100644 index 000000000000..08d559734b5a --- /dev/null +++ b/users/wpcarro/assessments/semiprimes/server/test/server_test.exs @@ -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 diff --git a/users/wpcarro/assessments/semiprimes/server/test/test_helper.exs b/users/wpcarro/assessments/semiprimes/server/test/test_helper.exs new file mode 100644 index 000000000000..869559e709ea --- /dev/null +++ b/users/wpcarro/assessments/semiprimes/server/test/test_helper.exs @@ -0,0 +1 @@ +ExUnit.start() diff --git a/users/wpcarro/assessments/tt/.gitignore b/users/wpcarro/assessments/tt/.gitignore new file mode 100644 index 000000000000..d4d62d436b26 --- /dev/null +++ b/users/wpcarro/assessments/tt/.gitignore @@ -0,0 +1,6 @@ +.envrc +*.db +*.sqlite3 +!populate.sqlite3 +*.db-shm +*.db-wal \ No newline at end of file diff --git a/users/wpcarro/assessments/tt/README.md b/users/wpcarro/assessments/tt/README.md new file mode 100644 index 000000000000..0231ef3ab8a4 --- /dev/null +++ b/users/wpcarro/assessments/tt/README.md @@ -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; +``` diff --git a/users/wpcarro/assessments/tt/client/.gitignore b/users/wpcarro/assessments/tt/client/.gitignore new file mode 100644 index 000000000000..1cb4f3034cc3 --- /dev/null +++ b/users/wpcarro/assessments/tt/client/.gitignore @@ -0,0 +1,3 @@ +/elm-stuff +/Main.min.js +/output.css diff --git a/users/wpcarro/assessments/tt/client/README.md b/users/wpcarro/assessments/tt/client/README.md new file mode 100644 index 000000000000..04804ad94fac --- /dev/null +++ b/users/wpcarro/assessments/tt/client/README.md @@ -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`! diff --git a/users/wpcarro/assessments/tt/client/dir-locals.nix b/users/wpcarro/assessments/tt/client/dir-locals.nix new file mode 100644 index 000000000000..5c3ae08870b0 --- /dev/null +++ b/users/wpcarro/assessments/tt/client/dir-locals.nix @@ -0,0 +1,3 @@ +let + briefcase = import /home/wpcarro/briefcase {}; +in briefcase.utils.nixBufferFromShell ./shell.nix diff --git a/users/wpcarro/assessments/tt/client/elm.json b/users/wpcarro/assessments/tt/client/elm.json new file mode 100644 index 000000000000..c4095e118e24 --- /dev/null +++ b/users/wpcarro/assessments/tt/client/elm.json @@ -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": {} + } +} diff --git a/users/wpcarro/assessments/tt/client/index.css b/users/wpcarro/assessments/tt/client/index.css new file mode 100644 index 000000000000..52114e0e9fb0 --- /dev/null +++ b/users/wpcarro/assessments/tt/client/index.css @@ -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; +} diff --git a/users/wpcarro/assessments/tt/client/index.html b/users/wpcarro/assessments/tt/client/index.html new file mode 100644 index 000000000000..9e6cef70dbb4 --- /dev/null +++ b/users/wpcarro/assessments/tt/client/index.html @@ -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> diff --git a/users/wpcarro/assessments/tt/client/print.css b/users/wpcarro/assessments/tt/client/print.css new file mode 100644 index 000000000000..3cfb279230cb --- /dev/null +++ b/users/wpcarro/assessments/tt/client/print.css @@ -0,0 +1,3 @@ +.no-print { + display: none; +} diff --git a/users/wpcarro/assessments/tt/client/shell.nix b/users/wpcarro/assessments/tt/client/shell.nix new file mode 100644 index 000000000000..15ac040b9462 --- /dev/null +++ b/users/wpcarro/assessments/tt/client/shell.nix @@ -0,0 +1,10 @@ +let + pkgs = import <nixpkgs> {}; +in pkgs.mkShell { + buildInputs = with pkgs; [ + nodejs + elmPackages.elm + elmPackages.elm-format + elmPackages.elm-live + ]; +} diff --git a/users/wpcarro/assessments/tt/client/src/Admin.elm b/users/wpcarro/assessments/tt/client/src/Admin.elm new file mode 100644 index 000000000000..d95609ee15e4 --- /dev/null +++ b/users/wpcarro/assessments/tt/client/src/Admin.elm @@ -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 + ] diff --git a/users/wpcarro/assessments/tt/client/src/Common.elm b/users/wpcarro/assessments/tt/client/src/Common.elm new file mode 100644 index 000000000000..63ba97b794ac --- /dev/null +++ b/users/wpcarro/assessments/tt/client/src/Common.elm @@ -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 diff --git a/users/wpcarro/assessments/tt/client/src/Login.elm b/users/wpcarro/assessments/tt/client/src/Login.elm new file mode 100644 index 000000000000..b1a436098afd --- /dev/null +++ b/users/wpcarro/assessments/tt/client/src/Login.elm @@ -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 diff --git a/users/wpcarro/assessments/tt/client/src/Main.elm b/users/wpcarro/assessments/tt/client/src/Main.elm new file mode 100644 index 000000000000..de71a72db0df --- /dev/null +++ b/users/wpcarro/assessments/tt/client/src/Main.elm @@ -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 + } diff --git a/users/wpcarro/assessments/tt/client/src/Manager.elm b/users/wpcarro/assessments/tt/client/src/Manager.elm new file mode 100644 index 000000000000..cd15c99a34a8 --- /dev/null +++ b/users/wpcarro/assessments/tt/client/src/Manager.elm @@ -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 + ] + ] + ) diff --git a/users/wpcarro/assessments/tt/client/src/Shared.elm b/users/wpcarro/assessments/tt/client/src/Shared.elm new file mode 100644 index 000000000000..addb0a4ffd12 --- /dev/null +++ b/users/wpcarro/assessments/tt/client/src/Shared.elm @@ -0,0 +1,7 @@ +module Shared exposing (..) + +clientOrigin = + "http://localhost:8000" + +serverOrigin = + "http://localhost:3000" diff --git a/users/wpcarro/assessments/tt/client/src/State.elm b/users/wpcarro/assessments/tt/client/src/State.elm new file mode 100644 index 000000000000..b3f78bb16980 --- /dev/null +++ b/users/wpcarro/assessments/tt/client/src/State.elm @@ -0,0 +1,1014 @@ +port module State exposing (..) + +import Array exposing (Array) +import Browser +import Browser.Navigation as Nav +import Date +import DatePicker +import Http +import Json.Decode as JD +import Json.Decode.Extra as JDE +import Json.Encode as JE +import Json.Encode.Extra as JEE +import Process +import RemoteData exposing (WebData) +import Shared +import Task +import Time +import Url +import Url.Builder as UrlBuilder +import Url.Parser exposing ((</>), Parser, int, map, oneOf, s, string) +import Utils + + + +-------------------------------------------------------------------------------- +-- Types +-------------------------------------------------------------------------------- + + +type Msg + = DoNothing + | UpdateUsername String + | UpdateEmail String + | UpdatePassword String + | UpdateRole String + | UpdateAdminTab AdminTab + | UpdateTripDestination String + | UpdateTripStartDate DatePicker.Msg + | UpdateTripEndDate DatePicker.Msg + | UpdateTripComment String + | UpdateEditTripDestination String + | UpdateEditTripComment String + | ClearErrors + | ToggleLoginForm + | PrintPage + | GoogleSignIn + | GoogleSignOut + | UpdateInviteEmail String + | UpdateInviteRole (Maybe Role) + | ReceiveTodaysDate Date.Date + | EditTrip Trip + | CancelEditTrip + -- SPA + | LinkClicked Browser.UrlRequest + | UrlChanged Url.Url + -- Outbound network + | AttemptGetAccounts + | AttemptGetTrips + | AttemptSignUp + | AttemptLogin + | AttemptLogout + | AttemptDeleteAccount String + | AttemptCreateTrip Date.Date Date.Date + | AttemptDeleteTrip Trip + | AttemptInviteUser Role + | AttemptUpdateTrip TripPK Trip + -- Inbound network + | GotAccounts (WebData (List Account)) + | GotTrips (WebData (List Trip)) + | GotSignUp (Result Http.Error Session) + | GotLogin (Result Http.Error Session) + | GotLogout (Result Http.Error String) + | GotDeleteAccount (Result Http.Error String) + | GotCreateTrip (Result Http.Error ()) + | GotDeleteTrip (Result Http.Error ()) + | GotInviteUser (Result Http.Error ()) + | GotUpdateTrip (Result Http.Error ()) + + +type Route + = Login + | UserHome + | ManagerHome + | AdminHome + + +type Role + = User + | Manager + | Admin + + +type alias Account = + { username : String + , role : Role + } + + +type alias Session = + { role : Role + , username : String + } + + +type alias Review = + { rowid : Int + , content : String + , rating : Int + , user : String + , dateOfVisit : String + } + + +type AdminTab + = Accounts + | Trips + + +type LoginTab + = LoginForm + | SignUpForm + + +type alias Trip = + { username : String + , destination : String + , startDate : Date.Date + , endDate : Date.Date + , comment : String + } + + +type alias TripPK = + { username : String + , destination : String + , startDate : Date.Date + } + + +type alias Model = + { route : Maybe Route + , url : Url.Url + , key : Nav.Key + , session : Maybe Session + , todaysDate : Maybe Date.Date + , username : String + , email : String + , password : String + , role : Maybe Role + , accounts : WebData (List Account) + , startDatePicker : DatePicker.DatePicker + , endDatePicker : DatePicker.DatePicker + , tripDestination : String + , tripStartDate : Maybe Date.Date + , tripEndDate : Maybe Date.Date + , tripComment : String + , trips : WebData (List Trip) + , editingTrip : Maybe Trip + , editTripDestination : String + , editTripComment : String + , adminTab : AdminTab + , loginTab : LoginTab + , inviteEmail : String + , inviteRole : Maybe Role + , inviteResponseStatus : WebData () + , updateTripStatus : WebData () + , loginError : Maybe Http.Error + , logoutError : Maybe Http.Error + , signUpError : Maybe Http.Error + , deleteUserError : Maybe Http.Error + , createTripError : Maybe Http.Error + , deleteTripError : Maybe Http.Error + , inviteUserError : Maybe Http.Error + } + + +allErrors : Model -> List ( Maybe Http.Error, String ) +allErrors model = + [ ( model.loginError, "Error attempting to authenticate" ) + , ( model.logoutError, "Error attempting to log out" ) + , ( model.signUpError, "Error attempting to create your account" ) + , ( model.deleteUserError, "Error attempting to delete a user" ) + , ( model.createTripError, "Error attempting to create a trip" ) + , ( model.inviteUserError, "Error attempting to invite a user" ) + ] + + + +-------------------------------------------------------------------------------- +-- Functions +-------------------------------------------------------------------------------- + + +roleToString : Role -> String +roleToString role = + case role of + User -> + "user" + + Manager -> + "manager" + + Admin -> + "admin" + + +endpoint : List String -> List UrlBuilder.QueryParameter -> String +endpoint = + UrlBuilder.crossOrigin Shared.serverOrigin + + +encodeRole : Role -> JE.Value +encodeRole x = + case x of + User -> + JE.string "user" + + Manager -> + JE.string "manager" + + Admin -> + JE.string "admin" + + +decodeRole : JD.Decoder Role +decodeRole = + let + toRole : String -> JD.Decoder Role + toRole s = + case s of + "user" -> + JD.succeed User + + "manager" -> + JD.succeed Manager + + "admin" -> + JD.succeed Admin + + x -> + JD.fail ("Invalid input: " ++ x) + in + JD.string |> JD.andThen toRole + + +decodeSession : JD.Decoder Session +decodeSession = + JD.map2 + Session + (JD.field "role" decodeRole) + (JD.field "username" JD.string) + + +encodeLoginRequest : String -> String -> JE.Value +encodeLoginRequest username password = + JE.object + [ ( "username", JE.string username ) + , ( "password", JE.string password ) + ] + + +login : String -> String -> Cmd Msg +login username password = + Utils.postWithCredentials + { url = endpoint [ "login" ] [] + , body = Http.jsonBody (encodeLoginRequest username password) + , expect = Http.expectJson GotLogin decodeSession + } + + +logout : Cmd Msg +logout = + Utils.getWithCredentials + { url = endpoint [ "logout" ] [] + , expect = Http.expectString GotLogout + } + + +signUp : + { username : String + , email : String + , password : String + } + -> Cmd Msg +signUp { username, email, password } = + Utils.postWithCredentials + { url = endpoint [ "accounts" ] [] + , body = + Http.jsonBody + (JE.object + [ ( "username", JE.string username ) + , ( "email", JE.string username ) + , ( "password", JE.string password ) + , ( "role", JE.string "user" ) + ] + ) + , expect = Http.expectJson GotSignUp decodeSession + } + + +updateTrip : TripPK -> Trip -> Cmd Msg +updateTrip tripKey trip = + Utils.putWithCredentials + { url = endpoint [ "trips" ] [] + , body = + Http.jsonBody + (JE.object + [ ( "tripKey", encodeTripKey tripKey ) + , ( "destination", JE.string trip.destination ) + , ( "startDate", encodeDate trip.startDate ) + , ( "endDate", encodeDate trip.endDate ) + , ( "comment", JE.string trip.comment ) + ] + ) + , expect = Http.expectWhatever GotUpdateTrip + } + + +inviteUser : { email : String, role : Role } -> Cmd Msg +inviteUser { email, role } = + Utils.postWithCredentials + { url = endpoint [ "invite" ] [] + , body = + Http.jsonBody + (JE.object + [ ( "email", JE.string email ) + , ( "role", encodeRole role ) + ] + ) + , expect = Http.expectWhatever GotInviteUser + } + + +createTrip : + { username : String + , destination : String + , startDate : Date.Date + , endDate : Date.Date + , comment : String + } + -> Cmd Msg +createTrip { username, destination, startDate, endDate, comment } = + Utils.postWithCredentials + { url = endpoint [ "trips" ] [] + , body = + Http.jsonBody + (JE.object + [ ( "username", JE.string username ) + , ( "destination", JE.string destination ) + , ( "startDate", encodeDate startDate ) + , ( "endDate", encodeDate endDate ) + , ( "comment", JE.string comment ) + ] + ) + , expect = Http.expectWhatever GotCreateTrip + } + + +deleteTrip : + { username : String + , destination : String + , startDate : Date.Date + } + -> Cmd Msg +deleteTrip { username, destination, startDate } = + Utils.deleteWithCredentials + { url = endpoint [ "trips" ] [] + , body = + Http.jsonBody + (JE.object + [ ( "username", JE.string username ) + , ( "destination", JE.string destination ) + , ( "startDate", encodeDate startDate ) + ] + ) + , expect = Http.expectWhatever GotDeleteTrip + } + + +deleteAccount : String -> Cmd Msg +deleteAccount username = + Utils.deleteWithCredentials + { url = endpoint [ "accounts" ] [ UrlBuilder.string "username" username ] + , body = Http.emptyBody + , expect = Http.expectString GotDeleteAccount + } + + +decodeReview : JD.Decoder Review +decodeReview = + JD.map5 + Review + (JD.field "rowid" JD.int) + (JD.field "content" JD.string) + (JD.field "rating" JD.int) + (JD.field "user" JD.string) + (JD.field "timestamp" JD.string) + + +encodeTripKey : TripPK -> JE.Value +encodeTripKey tripKey = + JE.object + [ ( "username", JE.string tripKey.username ) + , ( "destination", JE.string tripKey.destination ) + , ( "startDate", encodeDate tripKey.startDate ) + ] + + +encodeDate : Date.Date -> JE.Value +encodeDate date = + date |> Date.toIsoString |> JE.string + + +decodeDate : JD.Decoder Date.Date +decodeDate = + JD.string |> JD.andThen (Date.fromIsoString >> JDE.fromResult) + + +fetchTrips : Cmd Msg +fetchTrips = + Utils.getWithCredentials + { url = endpoint [ "trips" ] [] + , expect = + Http.expectJson + (RemoteData.fromResult >> GotTrips) + (JD.list + (JD.map5 + Trip + (JD.field "username" JD.string) + (JD.field "destination" JD.string) + (JD.field "startDate" decodeDate) + (JD.field "endDate" decodeDate) + (JD.field "comment" JD.string) + ) + ) + } + + +fetchAccounts : Cmd Msg +fetchAccounts = + Utils.getWithCredentials + { url = endpoint [ "accounts" ] [] + , expect = + Http.expectJson + (RemoteData.fromResult >> GotAccounts) + (JD.list + (JD.map2 + Account + (JD.field "username" JD.string) + (JD.field "role" decodeRole) + ) + ) + } + + +sleepAndClearErrors : Cmd Msg +sleepAndClearErrors = + Process.sleep 4000 + |> Task.perform (\_ -> ClearErrors) + + +isAuthorized : Role -> Route -> Bool +isAuthorized role route = + case ( role, route ) of + ( User, _ ) -> + True + + ( Manager, _ ) -> + True + + ( Admin, _ ) -> + True + + +homeRouteForRole : Role -> String +homeRouteForRole role = + case role of + User -> + "/user" + + Manager -> + "/manager" + + Admin -> + "/admin" + + +routeParser : Parser (Route -> a) a +routeParser = + oneOf + [ map Login (s "topic") + , map UserHome (s "user") + , map ManagerHome (s "manager") + , map AdminHome (s "admin") + ] + + +{-| Set init to `prod` when going live. +-} +prod : () -> Url.Url -> Nav.Key -> ( Model, Cmd Msg ) +prod _ url key = + let + ( startDatePicker, startDatePickerCmd ) = + DatePicker.init + + ( endDatePicker, endDatePickerCmd ) = + DatePicker.init + in + ( { route = Nothing + , url = url + , key = key + , session = Nothing + , todaysDate = Nothing + , username = "" + , email = "" + , password = "" + , role = Nothing + , accounts = RemoteData.NotAsked + , tripDestination = "" + , tripStartDate = Nothing + , tripEndDate = Nothing + , tripComment = "" + , trips = RemoteData.NotAsked + , editingTrip = Nothing + , editTripDestination = "" + , editTripComment = "" + , startDatePicker = startDatePicker + , endDatePicker = endDatePicker + , adminTab = Accounts + , loginTab = LoginForm + , inviteEmail = "" + , inviteRole = Nothing + , inviteResponseStatus = RemoteData.NotAsked + , updateTripStatus = RemoteData.NotAsked + , loginError = Nothing + , logoutError = Nothing + , signUpError = Nothing + , deleteUserError = Nothing + , createTripError = Nothing + , deleteTripError = Nothing + , inviteUserError = Nothing + } + , Cmd.batch + [ Cmd.map UpdateTripStartDate startDatePickerCmd + , Cmd.map UpdateTripEndDate endDatePickerCmd + , Date.today |> Task.perform ReceiveTodaysDate + ] + ) + + +{-| When working on a feature for the UserHome, use this. +-} +userHome : () -> Url.Url -> Nav.Key -> ( Model, Cmd Msg ) +userHome flags url key = + let + ( model, cmd ) = + prod flags url key + in + ( { model + | route = Just UserHome + , session = Just { username = "mimi", role = User } + , trips = + RemoteData.Success + [ { username = "mimi" + , destination = "Barcelona" + , startDate = Date.fromCalendarDate 2020 Time.Sep 25 + , endDate = Date.fromCalendarDate 2020 Time.Oct 5 + , comment = "Blah" + } + , { username = "mimi" + , destination = "Paris" + , startDate = Date.fromCalendarDate 2021 Time.Jan 1 + , endDate = Date.fromCalendarDate 2021 Time.Feb 1 + , comment = "Bon voyage!" + } + ] + } + , cmd + ) + + +managerHome : () -> Url.Url -> Nav.Key -> ( Model, Cmd Msg ) +managerHome flags url key = + let + ( model, cmd ) = + prod flags url key + in + ( { model + | route = Just ManagerHome + , session = Just { username = "bill", role = Manager } + } + , cmd + ) + + +adminHome : () -> Url.Url -> Nav.Key -> ( Model, Cmd Msg ) +adminHome flags url key = + let + ( model, cmd ) = + prod flags url key + in + ( { model + | route = Just AdminHome + , session = Just { username = "wpcarro", role = Admin } + } + , cmd + ) + + +port printPage : () -> Cmd msg + + +port googleSignIn : () -> Cmd msg + + +port googleSignOut : () -> Cmd msg + + +{-| The initial state for the application. +-} +init : () -> Url.Url -> Nav.Key -> ( Model, Cmd Msg ) +init flags url key = + prod flags url key + + +{-| Now that we have state, we need a function to change the state. +-} +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + DoNothing -> + ( model, Cmd.none ) + + UpdateUsername x -> + ( { model | username = x }, Cmd.none ) + + UpdatePassword x -> + ( { model | password = x }, Cmd.none ) + + UpdateEmail x -> + ( { model | email = x }, Cmd.none ) + + UpdateAdminTab x -> + ( { model | adminTab = x }, Cmd.none ) + + UpdateRole x -> + let + maybeRole = + case x of + "user" -> + Just User + + "manager" -> + Just Manager + + "admin" -> + Just Admin + + _ -> + Nothing + in + ( { model | role = maybeRole }, Cmd.none ) + + UpdateTripDestination x -> + ( { model | tripDestination = x }, Cmd.none ) + + UpdateTripStartDate dpMsg -> + let + ( newDatePicker, dateEvent ) = + DatePicker.update DatePicker.defaultSettings dpMsg model.startDatePicker + + newDate = + case dateEvent of + DatePicker.Picked changedDate -> + Just changedDate + + _ -> + model.tripStartDate + in + ( { model + | tripStartDate = newDate + , startDatePicker = newDatePicker + } + , Cmd.none + ) + + UpdateTripEndDate dpMsg -> + let + ( newDatePicker, dateEvent ) = + DatePicker.update DatePicker.defaultSettings dpMsg model.endDatePicker + + newDate = + case dateEvent of + DatePicker.Picked changedDate -> + Just changedDate + + _ -> + model.tripEndDate + in + ( { model + | tripEndDate = newDate + , endDatePicker = newDatePicker + } + , Cmd.none + ) + + UpdateTripComment x -> + ( { model | tripComment = x }, Cmd.none ) + + UpdateEditTripDestination x -> + ( { model | editTripDestination = x }, Cmd.none ) + + UpdateEditTripComment x -> + ( { model | editTripComment = x }, Cmd.none ) + + ClearErrors -> + ( { model + | loginError = Nothing + , logoutError = Nothing + , signUpError = Nothing + , deleteUserError = Nothing + , createTripError = Nothing + } + , Cmd.none + ) + + ToggleLoginForm -> + ( { model + | loginTab = + case model.loginTab of + LoginForm -> + SignUpForm + + SignUpForm -> + LoginForm + } + , Cmd.none + ) + + PrintPage -> + ( model, printPage () ) + + GoogleSignIn -> + ( model, googleSignIn () ) + + GoogleSignOut -> + ( model, googleSignOut () ) + + UpdateInviteEmail x -> + ( { model | inviteEmail = x }, Cmd.none ) + + UpdateInviteRole mRole -> + ( { model | inviteRole = mRole }, Cmd.none ) + + ReceiveTodaysDate date -> + ( { model | todaysDate = Just date }, Cmd.none ) + + EditTrip trip -> + ( { model + | editingTrip = Just trip + , editTripDestination = trip.destination + , editTripComment = trip.comment + } + , Cmd.none + ) + + CancelEditTrip -> + ( { model + | editingTrip = Nothing + , editTripDestination = "" + , editTripComment = "" + } + , Cmd.none + ) + + LinkClicked urlRequest -> + case urlRequest of + Browser.Internal url -> + ( model, Nav.pushUrl model.key (Url.toString url) ) + + Browser.External href -> + ( model, Nav.load href ) + + UrlChanged url -> + let + route = + Url.Parser.parse routeParser url + in + case route of + Just UserHome -> + ( { model + | url = url + , route = route + , trips = RemoteData.Loading + } + , fetchTrips + ) + + Just ManagerHome -> + ( { model + | url = url + , route = route + , accounts = RemoteData.Loading + } + , fetchAccounts + ) + + Just AdminHome -> + ( { model + | url = url + , route = route + , accounts = RemoteData.Loading + , trips = RemoteData.Loading + } + , Cmd.batch + [ fetchAccounts + , fetchTrips + ] + ) + + _ -> + ( { model + | url = url + , route = route + } + , Cmd.none + ) + + -- GET /accounts + AttemptGetAccounts -> + ( { model | accounts = RemoteData.Loading }, fetchAccounts ) + + GotAccounts xs -> + ( { model | accounts = xs }, Cmd.none ) + + -- DELETE /accounts + AttemptDeleteAccount username -> + ( model, deleteAccount username ) + + GotDeleteAccount result -> + case result of + Ok _ -> + ( model, fetchAccounts ) + + Err e -> + ( { model | deleteUserError = Just e } + , sleepAndClearErrors + ) + + -- POST /trips + AttemptCreateTrip startDate endDate -> + ( model + , case model.session of + Nothing -> + Cmd.none + + Just session -> + createTrip + { username = session.username + , destination = model.tripDestination + , startDate = startDate + , endDate = endDate + , comment = model.tripComment + } + ) + + GotCreateTrip result -> + case result of + Ok _ -> + ( { model + | tripDestination = "" + , tripStartDate = Nothing + , tripEndDate = Nothing + , tripComment = "" + } + , fetchTrips + ) + + Err e -> + ( { model + | createTripError = Just e + , tripDestination = "" + , tripStartDate = Nothing + , tripEndDate = Nothing + , tripComment = "" + } + , sleepAndClearErrors + ) + + -- DELETE /trips + AttemptDeleteTrip trip -> + ( model + , deleteTrip + { username = trip.username + , destination = trip.destination + , startDate = trip.startDate + } + ) + + GotDeleteTrip result -> + case result of + Ok _ -> + ( model, fetchTrips ) + + Err e -> + ( { model | deleteTripError = Just e } + , sleepAndClearErrors + ) + + AttemptInviteUser role -> + ( { model | inviteResponseStatus = RemoteData.Loading } + , inviteUser + { email = model.inviteEmail + , role = role + } + ) + + GotInviteUser result -> + case result of + Ok _ -> + ( { model + | inviteEmail = "" + , inviteRole = Nothing + , inviteResponseStatus = RemoteData.Success () + } + , Cmd.none + ) + + Err e -> + ( { model + | inviteUserError = Just e + , inviteResponseStatus = RemoteData.Failure e + } + , sleepAndClearErrors + ) + + -- PATCH /trips + AttemptUpdateTrip tripKey trip -> + ( { model | updateTripStatus = RemoteData.Loading } + , updateTrip tripKey trip + ) + + GotUpdateTrip result -> + case result of + Ok _ -> + ( { model | updateTripStatus = RemoteData.Success () } + , fetchTrips + ) + + Err e -> + ( { model | updateTripStatus = RemoteData.Failure e } + , Cmd.none + ) + + -- POST /accounts + AttemptSignUp -> + ( model + , signUp + { username = model.username + , email = model.email + , password = model.password + } + ) + + GotSignUp result -> + case result of + Ok session -> + ( { model | session = Just session } + , Nav.pushUrl model.key (homeRouteForRole session.role) + ) + + Err x -> + ( { model | signUpError = Just x } + , sleepAndClearErrors + ) + + -- GET /trips + AttemptGetTrips -> + ( { model | trips = RemoteData.Loading }, fetchTrips ) + + GotTrips xs -> + ( { model | trips = xs }, Cmd.none ) + + -- POST /login + AttemptLogin -> + ( model, login model.username model.password ) + + GotLogin result -> + case result of + Ok session -> + ( { model | session = Just session } + , Nav.pushUrl model.key (homeRouteForRole session.role) + ) + + Err x -> + ( { model | loginError = Just x } + , sleepAndClearErrors + ) + + -- GET /logout + AttemptLogout -> + ( model, logout ) + + GotLogout result -> + case result of + Ok _ -> + ( { model | session = Nothing } + , Nav.pushUrl model.key "/login" + ) + + Err e -> + ( { model | logoutError = Just e } + , sleepAndClearErrors + ) diff --git a/users/wpcarro/assessments/tt/client/src/Tailwind.elm b/users/wpcarro/assessments/tt/client/src/Tailwind.elm new file mode 100644 index 000000000000..57d419db5a82 --- /dev/null +++ b/users/wpcarro/assessments/tt/client/src/Tailwind.elm @@ -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 diff --git a/users/wpcarro/assessments/tt/client/src/UI.elm b/users/wpcarro/assessments/tt/client/src/UI.elm new file mode 100644 index 000000000000..7f8f379795f7 --- /dev/null +++ b/users/wpcarro/assessments/tt/client/src/UI.elm @@ -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 ] diff --git a/users/wpcarro/assessments/tt/client/src/User.elm b/users/wpcarro/assessments/tt/client/src/User.elm new file mode 100644 index 000000000000..87871b78dbc4 --- /dev/null +++ b/users/wpcarro/assessments/tt/client/src/User.elm @@ -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 + ] + ) diff --git a/users/wpcarro/assessments/tt/client/src/Utils.elm b/users/wpcarro/assessments/tt/client/src/Utils.elm new file mode 100644 index 000000000000..60343cd87018 --- /dev/null +++ b/users/wpcarro/assessments/tt/client/src/Utils.elm @@ -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 diff --git a/users/wpcarro/assessments/tt/data/accounts.csv b/users/wpcarro/assessments/tt/data/accounts.csv new file mode 100644 index 000000000000..f5fc77b6d77f --- /dev/null +++ b/users/wpcarro/assessments/tt/data/accounts.csv @@ -0,0 +1,2 @@ +mimi,$2b$12$LynoGCNbe2RA1WWSiBEMVudJKs5dxnssY16rYmUyiwlSBIhHBOLbu,miriamwright@google.com,user, +wpcarro,$2b$12$3wbi4xfQmksLsu6GOKTbj.5WHywESATnXB4R8FJ55RSRLy6X9xA7u,wpcarro@google.com,admin, \ No newline at end of file diff --git a/users/wpcarro/assessments/tt/data/trips.csv b/users/wpcarro/assessments/tt/data/trips.csv new file mode 100644 index 000000000000..a583c750f77c --- /dev/null +++ b/users/wpcarro/assessments/tt/data/trips.csv @@ -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... \ No newline at end of file diff --git a/users/wpcarro/assessments/tt/populate.sqlite3 b/users/wpcarro/assessments/tt/populate.sqlite3 new file mode 100644 index 000000000000..e200d2b49c02 --- /dev/null +++ b/users/wpcarro/assessments/tt/populate.sqlite3 @@ -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 \ No newline at end of file diff --git a/users/wpcarro/assessments/tt/shell.nix b/users/wpcarro/assessments/tt/shell.nix new file mode 100644 index 000000000000..567b71060b7b --- /dev/null +++ b/users/wpcarro/assessments/tt/shell.nix @@ -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 + ])) + ]; +} diff --git a/users/wpcarro/assessments/tt/src/.ghci b/users/wpcarro/assessments/tt/src/.ghci new file mode 100644 index 000000000000..efc88e630ccb --- /dev/null +++ b/users/wpcarro/assessments/tt/src/.ghci @@ -0,0 +1,2 @@ +:set prompt "> " +:set -Wall diff --git a/users/wpcarro/assessments/tt/src/API.hs b/users/wpcarro/assessments/tt/src/API.hs new file mode 100644 index 000000000000..471fa761e0f4 --- /dev/null +++ b/users/wpcarro/assessments/tt/src/API.hs @@ -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 diff --git a/users/wpcarro/assessments/tt/src/Accounts.hs b/users/wpcarro/assessments/tt/src/Accounts.hs new file mode 100644 index 000000000000..c7ab7a2f135f --- /dev/null +++ b/users/wpcarro/assessments/tt/src/Accounts.hs @@ -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 diff --git a/users/wpcarro/assessments/tt/src/App.hs b/users/wpcarro/assessments/tt/src/App.hs new file mode 100644 index 000000000000..742bc962dc55 --- /dev/null +++ b/users/wpcarro/assessments/tt/src/App.hs @@ -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"] + } diff --git a/users/wpcarro/assessments/tt/src/Auth.hs b/users/wpcarro/assessments/tt/src/Auth.hs new file mode 100644 index 000000000000..f1bff23257e0 --- /dev/null +++ b/users/wpcarro/assessments/tt/src/Auth.hs @@ -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" } diff --git a/users/wpcarro/assessments/tt/src/Email.hs b/users/wpcarro/assessments/tt/src/Email.hs new file mode 100644 index 000000000000..2dac0973ba6d --- /dev/null +++ b/users/wpcarro/assessments/tt/src/Email.hs @@ -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 = [] + }) + [] diff --git a/users/wpcarro/assessments/tt/src/Invitations.hs b/users/wpcarro/assessments/tt/src/Invitations.hs new file mode 100644 index 000000000000..0c700470f3e2 --- /dev/null +++ b/users/wpcarro/assessments/tt/src/Invitations.hs @@ -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 diff --git a/users/wpcarro/assessments/tt/src/LoginAttempts.hs b/users/wpcarro/assessments/tt/src/LoginAttempts.hs new file mode 100644 index 000000000000..d78e12e3fd8a --- /dev/null +++ b/users/wpcarro/assessments/tt/src/LoginAttempts.hs @@ -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) diff --git a/users/wpcarro/assessments/tt/src/Main.hs b/users/wpcarro/assessments/tt/src/Main.hs new file mode 100644 index 000000000000..9df4232066bb --- /dev/null +++ b/users/wpcarro/assessments/tt/src/Main.hs @@ -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 diff --git a/users/wpcarro/assessments/tt/src/PendingAccounts.hs b/users/wpcarro/assessments/tt/src/PendingAccounts.hs new file mode 100644 index 000000000000..a555185fa717 --- /dev/null +++ b/users/wpcarro/assessments/tt/src/PendingAccounts.hs @@ -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) diff --git a/users/wpcarro/assessments/tt/src/Sessions.hs b/users/wpcarro/assessments/tt/src/Sessions.hs new file mode 100644 index 000000000000..713059a38383 --- /dev/null +++ b/users/wpcarro/assessments/tt/src/Sessions.hs @@ -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" diff --git a/users/wpcarro/assessments/tt/src/Trips.hs b/users/wpcarro/assessments/tt/src/Trips.hs new file mode 100644 index 000000000000..f90740363c52 --- /dev/null +++ b/users/wpcarro/assessments/tt/src/Trips.hs @@ -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) diff --git a/users/wpcarro/assessments/tt/src/Types.hs b/users/wpcarro/assessments/tt/src/Types.hs new file mode 100644 index 000000000000..6b06a39694fc --- /dev/null +++ b/users/wpcarro/assessments/tt/src/Types.hs @@ -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{..} diff --git a/users/wpcarro/assessments/tt/src/Utils.hs b/users/wpcarro/assessments/tt/src/Utils.hs new file mode 100644 index 000000000000..48c33af0796d --- /dev/null +++ b/users/wpcarro/assessments/tt/src/Utils.hs @@ -0,0 +1,9 @@ +-------------------------------------------------------------------------------- +module Utils where +-------------------------------------------------------------------------------- +import Data.Function ((&)) +-------------------------------------------------------------------------------- + +-- | Prefer this operator to the ampersand for stylistic reasons. +(|>) :: a -> (a -> b) -> b +(|>) = (&) diff --git a/users/wpcarro/assessments/tt/src/init.sql b/users/wpcarro/assessments/tt/src/init.sql new file mode 100644 index 000000000000..b42753ae5d01 --- /dev/null +++ b/users/wpcarro/assessments/tt/src/init.sql @@ -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; diff --git a/users/wpcarro/assessments/tt/tests/create-accounts.sh b/users/wpcarro/assessments/tt/tests/create-accounts.sh new file mode 100755 index 000000000000..8c2a66bc8bd7 --- /dev/null +++ b/users/wpcarro/assessments/tt/tests/create-accounts.sh @@ -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 diff --git a/users/wpcarro/assessments/tt/todo.org b/users/wpcarro/assessments/tt/todo.org new file mode 100644 index 000000000000..39592d04826b --- /dev/null +++ b/users/wpcarro/assessments/tt/todo.org @@ -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 |