From b1a4251d95ae778f461e9f400acc186c7b2e2622 Mon Sep 17 00:00:00 2001 From: James Eversole Date: Fri, 22 Jul 2022 12:27:35 -0500 Subject: [PATCH] Started building generation functionality, added useful haddock-style comments for several functions --- Purr.cabal | 1 + src/Core/HTTP.hs | 2 +- src/Core/SQLite.hs | 2 +- src/Core/Templates.hs | 9 +- src/Core/Types.hs | 1 + src/Feature/Generation/Links.hs | 43 +- src/Feature/Generation/Passwords.hs | 25 + src/Feature/Sharing/HTTP.hs | 5 +- src/wordlist | 1618 +++++++++++++++++++++++++++ views/index.hamlet | 27 +- views/pw.hamlet | 4 +- 11 files changed, 1703 insertions(+), 34 deletions(-) create mode 100644 src/Feature/Generation/Passwords.hs create mode 100644 src/wordlist diff --git a/Purr.cabal b/Purr.cabal index 416b8b3..1b6492e 100644 --- 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 index 6993178..a231fcf 100644 --- 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 index 3db483f..5ce0bf5 100644 --- 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 index 59d5e70..092c829 100644 --- 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 index 0f36716..394d904 100644 --- 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 index a8d6ed5..dd4981d 100644 --- 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 new file mode 100644 index 0000000..fc726f4 --- /dev/null +++ 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 index a6f8245..bba9711 100644 --- 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 new file mode 100644 index 0000000..3beab81 --- /dev/null +++ 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 index d2d5cec..ba78d5a 100644 --- a/views/index.hamlet +++ b/views/index.hamlet @@ -1,5 +1,6 @@ $doctype 5 + 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 index 670314f..5e10a18 100644 --- 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>