commit b1a4251d95ae778f461e9f400acc186c7b2e2622
parent 10e3724a1aa7c4dbf86ef6fc9a7dd2a288c789da
Author: James Eversole <james@eversole.co>
Date: Fri, 22 Jul 2022 12:27:35 -0500
Started building generation functionality, added useful haddock-style comments for several functions
Diffstat:
11 files changed, 1703 insertions(+), 34 deletions(-)
diff --git a/Purr.cabal b/Purr.cabal
@@ -25,6 +25,7 @@ library
Core.Templates
Core.Types
Feature.Generation.Links
+ Feature.Generation.Passwords
Feature.Generation.Shared
Feature.Sharing.HTTP
Feature.Sharing.SQLite
diff --git a/src/Core/HTTP.hs b/src/Core/HTTP.hs
@@ -18,7 +18,7 @@ app = do
-- Core Routes
get "/" $ do
- html $ renderIndex "/" Nothing
+ html $ renderIndex "/"
get "/style.css" $ do
setHeader "Content-Type" "text/css"
diff --git a/src/Core/SQLite.hs b/src/Core/SQLite.hs
@@ -20,5 +20,5 @@ main db = do
dbPath :: PurrAction String
dbPath = do
- conf <- lift ask
+ conf <- lift ask
return $ dbFile conf
diff --git a/src/Core/Templates.hs b/src/Core/Templates.hs
@@ -13,8 +13,13 @@ import qualified Data.Text.Lazy as LT
import Prelude
-renderIndex :: String -> Maybe T.Text -> LT.Text
-renderIndex link password = renderHtml ( $(shamletFile "./views/index.hamlet") )
+renderIndex :: String -> LT.Text
+renderIndex link = renderHtml ( $(shamletFile "./views/index.hamlet") )
+ where
+ hsUserLink = userLinkAttr link
renderStyle :: LT.Text
renderStyle = renderCss ( $(cassiusFile "./views/cassius/style.cassius") "/style.css" )
+
+userLinkAttr :: String -> (String, String)
+userLinkAttr str = ("hx-vals", "{\"userLink\": \"" <> str <> "\"}")
diff --git a/src/Core/Types.hs b/src/Core/Types.hs
@@ -20,4 +20,5 @@ data DhallConfig = DhallConfig
, applicationHost :: String
, applicationPort :: Int
, dbFile :: String
+ , linkLength :: Int
} deriving (Generic, Show)
diff --git a/src/Feature/Generation/Links.hs b/src/Feature/Generation/Links.hs
@@ -5,30 +5,45 @@ import Feature.Generation.Shared (rIndex)
import Control.Monad.Reader (ask, lift, liftIO)
import Data.Char (toLower, toUpper)
-import Data.List (foldl')
import System.IO
import System.Random
-genLink :: Int -> [Char] -> IO [Char]
-genLink 0 cs = return cs
-genLink d cs = do
- res <- rChar
- fin <- rCap res
- genLink (d - 1) (cs <> (fin:[]))
+-- Generates a string containing randomly generated and capitalized
+-- characters. The number of characters used is defined in the global config.dhall.
+genLink :: PurrAction String
+genLink = do
+ linkLength <- confLinkLength
+ genLink' linkLength ""
+ where
+ genLink' 0 cs = return cs
+ genLink' d cs = do
+ res <- liftIO $ randChar
+ fin <- liftIO $ randCapitalization res
+ genLink' (d - 1) (cs <> (fin:[]))
+-- Defines the valid range of characters to be used when generating links.
+-- This consists of all lowercase Latin alphabet characters and the
+-- numbers 1 through 9.
validChars :: [Char]
validChars = ['a'..'z'] <> ['1'..'9']
-rChar :: IO Char
-rChar = rIndex validChars
+randChar :: IO Char
+randChar = rIndex validChars
-rCap :: Char -> IO Char -- rCap takes a single character and returns it
-rCap c = do -- capitalized or lowercased at random.
+randCapitalization :: Char -> IO Char
+randCapitalization c = do
capRand <- randomRIO (0,1)
- return $ checkRand capRand c
+ return $ go capRand c
where
- checkRand :: Int -> Char -> Char
- checkRand r c
+ go :: Int -> Char -> Char
+ go r c
| r == 0 = toLower c
| r == 1 = toUpper c
| otherwise = c
+
+-- Helper function in our PurrAction monad transformer stack to read
+-- the desired length for generated links.
+confLinkLength :: PurrAction Int
+confLinkLength = do
+ conf <- lift ask
+ return $ linkLength conf
diff --git a/src/Feature/Generation/Passwords.hs b/src/Feature/Generation/Passwords.hs
@@ -0,0 +1,25 @@
+module Feature.Generation.Passwords where
+
+import Core.Types
+import Feature.Generation.Shared (rIndex)
+
+import Control.Monad.Reader (ask, lift, liftIO)
+import Data.Char (toLower, toUpper)
+import System.IO
+import System.Random
+
+-- suggestedScheme and its helpers xkcd, oldschool, and gibberish are TODO.
+suggestedScheme :: Int -> String
+suggestedScheme i
+ | i > 23 = xkcd i
+ | i > 12 = oldschool i
+ | otherwise = gibberish i
+
+xkcd :: Int -> String
+xkcd i = take i "correcthorsebatterystaple"
+
+oldschool :: Int -> String
+oldschool i = take i "PowerProlonger2974!"
+
+gibberish :: Int -> String
+gibberish i = take i "TCYx#@z5zlgw1o"
diff --git a/src/Feature/Sharing/HTTP.hs b/src/Feature/Sharing/HTTP.hs
@@ -21,8 +21,7 @@ routes = do
get "/pw/:id" $ do
reqId <- param "id"
- res <- findByLink reqId
- html $ renderIndex reqId (secret <$> res)
+ html $ renderIndex reqId
post "/pw" $ do
reqId <- param "userLink"
@@ -31,6 +30,6 @@ routes = do
post "/new" $ do
reqSecret <- param "newSec"
- link <- liftIO $ genLink 24 ""
+ link <- genLink
insertNewSecret reqSecret (T.pack link)
html $ renderPw link (Just reqSecret)
diff --git a/src/wordlist b/src/wordlist
@@ -0,0 +1,1618 @@
+able
+about
+above
+abroad
+absent
+absorb
+accent
+accept
+access
+accuse
+acid
+across
+action
+active
+actor
+actual
+adapt
+adjust
+admire
+admit
+adopt
+adult
+advice
+advise
+affair
+affect
+afford
+afraid
+after
+again
+aged
+agency
+agent
+agree
+ahead
+alarm
+alive
+allied
+allow
+ally
+almost
+alone
+along
+aloud
+also
+alter
+always
+amaze
+amazed
+among
+amount
+amuse
+amused
+anger
+angle
+angry
+animal
+ankle
+annoy
+annual
+answer
+anyone
+anyway
+apart
+appeal
+appear
+apple
+apply
+area
+argue
+arise
+armed
+arms
+army
+around
+arrest
+arrive
+arrow
+artist
+aside
+asleep
+aspect
+assist
+assume
+assure
+atom
+attach
+attack
+attend
+aunt
+author
+autumn
+avoid
+awake
+award
+aware
+away
+awful
+baby
+back
+badly
+bake
+ball
+band
+bank
+base
+based
+basic
+basis
+bath
+battle
+beach
+beak
+bear
+beard
+beat
+beauty
+become
+beef
+beer
+before
+begin
+behalf
+behave
+behind
+belief
+bell
+belong
+below
+belt
+bend
+bent
+beside
+best
+better
+beyond
+bill
+bird
+birth
+bite
+bitter
+blame
+blank
+blind
+block
+blood
+blow
+blue
+board
+boat
+body
+boil
+bomb
+bone
+book
+boot
+border
+bore
+bored
+boring
+born
+borrow
+boss
+both
+bother
+bottle
+bottom
+bound
+bowl
+brain
+branch
+brand
+brave
+bread
+break
+breast
+breath
+breed
+brick
+bridge
+brief
+bright
+bring
+broad
+broken
+brush
+bubble
+budget
+build
+bunch
+burn
+burnt
+burst
+bury
+bush
+busy
+butter
+button
+buyer
+cable
+cake
+call
+called
+calm
+calmly
+camera
+camp
+cancel
+cancer
+candy
+cannot
+card
+care
+career
+carpet
+carrot
+carry
+case
+cash
+cast
+castle
+catch
+cause
+cease
+cell
+cent
+centre
+chain
+chair
+chance
+change
+charge
+chart
+chase
+chat
+cheap
+cheat
+check
+cheek
+cheese
+cheque
+chest
+chew
+chief
+child
+chin
+chip
+choice
+choose
+chop
+cinema
+circle
+city
+civil
+claim
+clap
+class
+clean
+clear
+clerk
+clever
+click
+client
+climb
+clock
+close
+closed
+closet
+cloth
+cloud
+club
+coach
+coal
+coast
+coat
+code
+coffee
+coin
+cold
+coldly
+colour
+column
+come
+comedy
+commit
+common
+cook
+cooker
+cookie
+cool
+cope
+copy
+core
+corner
+cost
+cotton
+cough
+could
+count
+county
+couple
+course
+court
+cousin
+cover
+crack
+craft
+crash
+crazy
+cream
+create
+credit
+crime
+crisis
+crisp
+crop
+cross
+crowd
+crown
+cruel
+crush
+curb
+cure
+curl
+curly
+curve
+curved
+custom
+cycle
+daily
+damage
+damp
+dance
+dancer
+danger
+dare
+dark
+data
+date
+dead
+deaf
+deal
+dear
+death
+debate
+debt
+decade
+decay
+decide
+deep
+deeply
+defeat
+defend
+define
+degree
+delay
+demand
+deny
+depend
+depth
+derive
+desert
+design
+desire
+desk
+detail
+device
+devote
+diary
+diet
+dinner
+direct
+dirt
+dirty
+disc
+dish
+disk
+divide
+doctor
+doing
+dollar
+door
+double
+doubt
+down
+dozen
+draft
+drag
+drama
+draw
+drawer
+dream
+dress
+drink
+drive
+driver
+drop
+drug
+drum
+drunk
+dull
+dump
+during
+dust
+duty
+dying
+each
+early
+earn
+earth
+ease
+easily
+east
+easy
+edge
+editor
+effect
+effort
+either
+elbow
+elect
+else
+email
+emerge
+empire
+employ
+empty
+enable
+ending
+enemy
+energy
+engage
+engine
+enjoy
+enough
+ensure
+enter
+entire
+entry
+equal
+error
+escape
+essay
+estate
+euro
+even
+event
+ever
+every
+evil
+exact
+exam
+except
+excite
+excuse
+exist
+exit
+expand
+expect
+expert
+export
+expose
+extend
+extent
+extra
+face
+fact
+factor
+fail
+faint
+fair
+fairly
+faith
+fall
+false
+fame
+family
+famous
+fancy
+farm
+farmer
+fast
+fasten
+faucet
+fault
+favour
+fear
+feed
+feel
+fellow
+fence
+fetch
+fever
+field
+fight
+figure
+file
+fill
+film
+final
+find
+fine
+finely
+finger
+finish
+fire
+firm
+firmly
+first
+fish
+fixed
+flag
+flame
+flash
+flat
+flesh
+flight
+float
+flood
+floor
+flour
+flow
+flower
+flying
+focus
+fold
+follow
+food
+foot
+force
+forest
+forget
+fork
+form
+formal
+former
+found
+frame
+free
+freely
+freeze
+fresh
+fridge
+friend
+from
+front
+frozen
+fruit
+fuel
+fully
+fund
+funny
+future
+gain
+gallon
+gamble
+game
+garage
+garden
+gate
+gather
+gear
+gentle
+gently
+giant
+gift
+girl
+give
+glad
+glass
+global
+glove
+glue
+goal
+going
+gold
+good
+goods
+govern
+grab
+grade
+grain
+gram
+grand
+grant
+grass
+grave
+gray
+great
+green
+grey
+ground
+group
+grow
+growth
+guard
+guess
+guest
+guide
+guilty
+habit
+hair
+half
+hall
+hammer
+hand
+handle
+hang
+happen
+happy
+hard
+hardly
+harm
+hate
+hatred
+have
+head
+heal
+health
+hear
+heart
+heat
+heavy
+heel
+height
+hello
+help
+hence
+here
+hero
+hers
+hide
+high
+highly
+hill
+hire
+hobby
+hold
+hole
+hollow
+holy
+home
+honest
+honour
+hook
+hope
+horn
+horror
+horse
+host
+hotel
+hour
+house
+huge
+human
+humour
+hungry
+hunt
+hurry
+hurt
+idea
+ideal
+ignore
+image
+impact
+imply
+import
+impose
+inch
+income
+indeed
+index
+indoor
+infect
+inform
+injure
+injury
+inner
+insect
+insert
+inside
+insist
+insult
+intend
+into
+invent
+invest
+invite
+iron
+island
+issue
+item
+itself
+jacket
+jeans
+jelly
+join
+joint
+joke
+judge
+juice
+jump
+junior
+just
+keen
+keep
+kick
+kind
+kindly
+king
+kiss
+knee
+knife
+knit
+knock
+knot
+know
+known
+label
+labour
+lack
+lady
+lake
+lamp
+land
+lane
+large
+last
+late
+later
+latest
+latter
+laugh
+launch
+lawyer
+layer
+lazy
+lead
+leader
+leaf
+league
+lean
+learn
+least
+leave
+left
+legal
+lemon
+lend
+length
+less
+lesson
+letter
+level
+life
+lift
+light
+like
+likely
+limit
+line
+link
+liquid
+list
+listen
+litre
+little
+live
+lively
+living
+load
+loan
+local
+locate
+lock
+logic
+lonely
+long
+look
+loose
+lord
+lose
+loss
+lost
+lots
+loud
+loudly
+loyal
+luck
+lucky
+lunch
+lung
+magic
+mail
+main
+mainly
+major
+make
+mall
+manage
+manner
+many
+march
+mark
+marker
+market
+marry
+mass
+master
+match
+mate
+math
+maths
+matter
+maybe
+mayor
+meal
+mean
+means
+meat
+media
+medium
+meet
+melt
+member
+memory
+mental
+menu
+mere
+merely
+mess
+metal
+method
+metre
+midday
+middle
+might
+mild
+mile
+milk
+mind
+mine
+minor
+minute
+mirror
+miss
+mixed
+mobile
+modal
+model
+modern
+moment
+money
+month
+mood
+moon
+moral
+more
+most
+mostly
+motion
+motor
+mount
+mouse
+mouth
+move
+movie
+moving
+much
+murder
+muscle
+museum
+music
+must
+myself
+nail
+naked
+name
+narrow
+nation
+nature
+navy
+near
+nearby
+nearly
+neat
+neatly
+neck
+need
+needle
+nerve
+nest
+never
+newly
+news
+next
+nice
+nicely
+night
+nobody
+noise
+noisy
+none
+normal
+north
+nose
+note
+notice
+novel
+number
+nurse
+obey
+object
+obtain
+occupy
+occur
+ocean
+oddly
+offend
+offer
+office
+often
+once
+onion
+only
+onto
+open
+openly
+oppose
+option
+orange
+order
+organ
+origin
+other
+ought
+ours
+outer
+output
+oven
+over
+pace
+pack
+packet
+page
+pain
+paint
+pair
+palace
+pale
+panel
+pants
+paper
+parent
+park
+part
+partly
+party
+pass
+past
+path
+pause
+peace
+peak
+pence
+pencil
+penny
+people
+pepper
+period
+permit
+person
+petrol
+phase
+phone
+photo
+phrase
+piano
+pick
+piece
+pile
+pill
+pilot
+pink
+pint
+pipe
+pitch
+pity
+place
+plain
+plan
+plane
+planet
+plant
+plate
+play
+player
+please
+plenty
+plot
+plug
+plus
+pocket
+poem
+poetry
+point
+poison
+pole
+police
+policy
+polish
+polite
+pool
+poor
+port
+pose
+post
+potato
+pound
+pour
+powder
+power
+praise
+prayer
+prefer
+prefix
+press
+pretty
+price
+pride
+prime
+prince
+print
+prior
+prize
+profit
+prompt
+proof
+proper
+proud
+prove
+public
+pull
+punch
+punish
+pupil
+pure
+purely
+purple
+pursue
+push
+quick
+quiet
+quit
+quite
+quote
+race
+racing
+radio
+rail
+rain
+raise
+range
+rank
+rapid
+rare
+rarely
+rate
+rather
+reach
+react
+read
+reader
+ready
+real
+really
+rear
+reason
+recall
+recent
+reckon
+record
+reduce
+refer
+reform
+refuse
+regard
+region
+regret
+reject
+relate
+relax
+relief
+rely
+remain
+remark
+remind
+remote
+remove
+rent
+rented
+repair
+repeat
+reply
+report
+rescue
+resist
+resort
+rest
+result
+retain
+retire
+return
+reveal
+review
+revise
+reward
+rhythm
+rice
+rich
+ride
+rider
+riding
+right
+ring
+rise
+risk
+rival
+river
+road
+rock
+role
+roll
+roof
+room
+root
+rope
+rough
+round
+route
+royal
+rubber
+rude
+rudely
+ruin
+ruined
+rule
+ruler
+rumour
+runner
+rural
+rush
+sack
+sadly
+safe
+safely
+safety
+sail
+sailor
+salad
+salary
+sale
+salt
+salty
+same
+sample
+sand
+sauce
+save
+saving
+scale
+scare
+scared
+scene
+scheme
+school
+score
+scream
+screen
+screw
+seal
+search
+season
+seat
+second
+secret
+sector
+secure
+seed
+seek
+seem
+select
+self
+sell
+senate
+send
+senior
+sense
+series
+serve
+settle
+severe
+sewing
+shade
+shadow
+shake
+shall
+shame
+shape
+shaped
+share
+sharp
+shave
+sheep
+sheet
+shelf
+shell
+shift
+shine
+shiny
+ship
+shirt
+shock
+shoe
+shop
+short
+shot
+should
+shout
+show
+shower
+shut
+sick
+side
+sight
+sign
+signal
+silent
+silk
+silly
+silver
+simple
+simply
+since
+sing
+singer
+single
+sink
+site
+size
+skill
+skin
+skirt
+sleep
+sleeve
+slice
+slide
+slight
+slip
+slope
+slow
+slowly
+small
+smart
+smash
+smell
+smile
+smoke
+smooth
+snake
+snow
+soap
+social
+sock
+soft
+softly
+soil
+solid
+solve
+some
+song
+soon
+sore
+sorry
+sort
+soul
+sound
+soup
+sour
+source
+south
+space
+spare
+speak
+speech
+speed
+spell
+spend
+spice
+spicy
+spider
+spin
+spirit
+spite
+split
+spoil
+spoken
+spoon
+sport
+spot
+spray
+spread
+spring
+square
+stable
+staff
+stage
+stair
+stamp
+stand
+star
+stare
+start
+state
+statue
+status
+stay
+steady
+steal
+steam
+steel
+steep
+steer
+step
+stick
+sticky
+stiff
+still
+sting
+stir
+stock
+stone
+stop
+store
+storm
+story
+stove
+strain
+stream
+street
+stress
+strict
+strike
+string
+strip
+stripe
+stroke
+strong
+studio
+study
+stuff
+stupid
+style
+such
+suck
+sudden
+suffer
+suffix
+sugar
+suit
+suited
+summer
+supply
+sure
+surely
+survey
+swear
+sweat
+sweep
+sweet
+swell
+swim
+swing
+switch
+symbol
+system
+table
+tablet
+tackle
+tail
+take
+talk
+tall
+tank
+tape
+target
+task
+taste
+taxi
+teach
+team
+tear
+tell
+tend
+tent
+term
+test
+text
+than
+thank
+thanks
+that
+their
+theirs
+them
+theme
+then
+theory
+there
+they
+thick
+thief
+thin
+thing
+think
+this
+though
+thread
+threat
+throat
+throw
+thumb
+thus
+ticket
+tidy
+tight
+till
+time
+tiny
+tire
+tired
+tiring
+title
+today
+toilet
+tomato
+tone
+tongue
+tonne
+tool
+tooth
+topic
+total
+touch
+tough
+tour
+toward
+towel
+tower
+town
+trace
+track
+trade
+train
+trap
+travel
+treat
+tree
+trend
+trial
+trick
+trip
+truck
+true
+truly
+trust
+truth
+tube
+tune
+tunnel
+turn
+twice
+twin
+twist
+type
+tyre
+ugly
+unable
+uncle
+under
+undo
+unfair
+union
+unique
+unit
+unite
+united
+unkind
+unless
+unlike
+unload
+untidy
+until
+upon
+upper
+upset
+upside
+upward
+urban
+urge
+urgent
+used
+useful
+user
+usual
+valid
+valley
+value
+varied
+vary
+vast
+very
+victim
+video
+view
+virus
+vision
+visit
+vital
+voice
+volume
+vote
+wage
+waist
+wait
+waiter
+wake
+walk
+wall
+wallet
+wander
+want
+warm
+warmth
+warn
+wash
+waste
+watch
+water
+wave
+weak
+wealth
+weapon
+wear
+week
+weekly
+weigh
+weight
+well
+west
+what
+wheel
+when
+where
+which
+while
+whilst
+whole
+whom
+whose
+wide
+widely
+width
+wife
+wild
+wildly
+will
+wind
+window
+wine
+wing
+winner
+winter
+wire
+wise
+wish
+with
+within
+woman
+wonder
+wood
+wooden
+wool
+word
+work
+worker
+world
+worry
+worse
+worst
+worth
+would
+wound
+wrap
+wrist
+write
+writer
+wrong
+yard
+yawn
+yeah
+year
+young
+your
+yours
+youth
+zero
+zone
diff --git a/views/index.hamlet b/views/index.hamlet
@@ -1,5 +1,6 @@
$doctype 5
<html>
+
<head>
<title>Purr
<meta name="viewport" content="width=device-width, initial-scale=1.0">
@@ -7,24 +8,28 @@ $doctype 5
<link rel="stylesheet" href="/style.css">
<body>
+
<div #logo .logo>
<img src="/purrlogo.png">
+
<div #content .content>
<div #title .title>
<h1>
<a #titleLink .titleLink href="/">Purr
+
<div #pwUtils .pwUtils>
- $# Below needs to be replaced with an HTMX onload request to /pw/#{link} to DRY
- <div #requestedPw .requestedPw>
- $maybe pw <- password
- <p>Here's the secret for <a href="/pw/#{link}">/pw/#{link}</a>:
- <h2 .pwResult>#{pw}
- $nothing
- $if (link == "/")
- <p .emptyReq>
- $else
- <p>No secret available at <a href="/pw/#{link}">/pw/#{link}</a>
- $# Above needs to be replaced with an HTMX onload request to /pw/#{link} to DRY
+ $if (link == "/")
+ <div #requestedPw .requestedPw>
+ <p .emptyReq>
+ $else
+ <div #requestedPw .requestedPw
+ hx-trigger="load"
+ hx-post="/pw"
+ hx-target="#requestedPw"
+ hx-swap="outerHTML"
+ *{hsUserLink}
+ >
+ Loading... <img class="htmx-indicator" src="/loading.svg" />
<div #shareNew .shareNew>
<p>
diff --git a/views/pw.hamlet b/views/pw.hamlet
@@ -1,6 +1,6 @@
<div #requestedPw .requestedPw>
$maybe pw <- password
- <p>Here's the secret for <a href="/pw/#{link}">/pw/#{link}</a>:
+ <p>Here's the secret found at <a href="/pw/#{link}">/pw/#{link}</a>:
<h2 .pwResult>#{pw}
$nothing
- <p>No secret available at <a href="/pw/#{link}">/pw/#{link}</a>
+ <p>No secret found at <a href="/pw/#{link}">/pw/#{link}</a>
