diff --git a/Purr.cabal b/Purr.cabal index 1b6492e..528c24a 100644 --- a/Purr.cabal +++ b/Purr.cabal @@ -24,9 +24,11 @@ library Core.SQLite Core.Templates Core.Types + Feature.Generation.HTTP Feature.Generation.Links Feature.Generation.Passwords Feature.Generation.Shared + Feature.Generation.Templates Feature.Sharing.HTTP Feature.Sharing.SQLite Feature.Sharing.Templates diff --git a/examples/config.dhall b/examples/config.dhall index 1cc4259..385c1e6 100644 --- a/examples/config.dhall +++ b/examples/config.dhall @@ -10,4 +10,6 @@ , applicationHost = "REPLACEME" , applicationPort = +3000 , dbFile = "data/Purr.sqlite" +, dbSalt = "REPLACEME!!!!!" +, linkLength = +24 } diff --git a/src/Core/HTTP.hs b/src/Core/HTTP.hs index a231fcf..a7eba7d 100644 --- a/src/Core/HTTP.hs +++ b/src/Core/HTTP.hs @@ -2,8 +2,9 @@ module Core.HTTP ( app ) where import Core.Types -import Core.Templates (renderIndex, renderStyle) -import Feature.Sharing.HTTP as Sharing +import Core.Templates (renderIndex, renderStyle) +import Feature.Sharing.HTTP as Sharing +import Feature.Generation.HTTP as Generation import Data.Maybe (Maybe (Nothing)) import Network.Wai.Middleware.RequestLogger (logStdoutDev) @@ -26,3 +27,4 @@ app = do -- Feature Routes Sharing.routes + Generation.routes diff --git a/src/Core/Templates.hs b/src/Core/Templates.hs index 092c829..859d7f9 100644 --- a/src/Core/Templates.hs +++ b/src/Core/Templates.hs @@ -1,7 +1,7 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} -module Core.Templates ( renderIndex, renderStyle ) where +module Core.Templates ( renderIndex, renderStyle, hxVals ) where import Text.Blaze.Html.Renderer.Text (renderHtml) import Text.Blaze.Html @@ -16,10 +16,10 @@ import Prelude renderIndex :: String -> LT.Text renderIndex link = renderHtml ( $(shamletFile "./views/index.hamlet") ) where - hsUserLink = userLinkAttr link + hsUserLink = hxVals "userLink" link renderStyle :: LT.Text renderStyle = renderCss ( $(cassiusFile "./views/cassius/style.cassius") "/style.css" ) -userLinkAttr :: String -> (String, String) -userLinkAttr str = ("hx-vals", "{\"userLink\": \"" <> str <> "\"}") +hxVals :: String -> String -> (String, String) +hxVals attr str = ("hx-vals", "{\"" <> attr <> "\": \"" <> str <> "\"}") diff --git a/src/Core/Types.hs b/src/Core/Types.hs index 394d904..de6b03e 100644 --- a/src/Core/Types.hs +++ b/src/Core/Types.hs @@ -20,5 +20,6 @@ data DhallConfig = DhallConfig , applicationHost :: String , applicationPort :: Int , dbFile :: String + , dbSalt :: String , linkLength :: Int } deriving (Generic, Show) diff --git a/src/Feature/Generation/HTTP.hs b/src/Feature/Generation/HTTP.hs new file mode 100644 index 0000000..74ddd0d --- /dev/null +++ b/src/Feature/Generation/HTTP.hs @@ -0,0 +1,22 @@ +module Feature.Generation.HTTP ( routes ) where + +import Core.Types +import Core.Templates (renderIndex) + +import Feature.Generation.Passwords (suggestedScheme) +import Feature.Generation.Templates (renderGen) + +import qualified Data.Text as T +import qualified Data.Text.Lazy as LT + +import Control.Monad.Reader (ask, lift, liftIO) +import Data.Maybe (listToMaybe) +import Web.Scotty.Trans +import Prelude + +routes :: PurrApp () +routes = do + + get "/gen" $ do + genPw <- liftIO $ suggestedScheme 24 + html $ renderGen genPw diff --git a/src/Feature/Generation/Links.hs b/src/Feature/Generation/Links.hs index dd4981d..359bfa4 100644 --- a/src/Feature/Generation/Links.hs +++ b/src/Feature/Generation/Links.hs @@ -1,7 +1,7 @@ module Feature.Generation.Links ( genLink ) where import Core.Types -import Feature.Generation.Shared (rIndex) +import Feature.Generation.Shared (rIndex, validChars) import Control.Monad.Reader (ask, lift, liftIO) import Data.Char (toLower, toUpper) @@ -21,12 +21,6 @@ genLink = do 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'] - randChar :: IO Char randChar = rIndex validChars diff --git a/src/Feature/Generation/Passwords.hs b/src/Feature/Generation/Passwords.hs index fc726f4..d160682 100644 --- a/src/Feature/Generation/Passwords.hs +++ b/src/Feature/Generation/Passwords.hs @@ -1,25 +1,47 @@ module Feature.Generation.Passwords where import Core.Types -import Feature.Generation.Shared (rIndex) +import Feature.Generation.Shared (rIndex, validChars) import Control.Monad.Reader (ask, lift, liftIO) import Data.Char (toLower, toUpper) +import Data.List (singleton) import System.IO import System.Random +camelCase :: [Char] -> [Char] +camelCase [] = [] +camelCase x = toUpper (head x) : map toLower (tail x) + -- suggestedScheme and its helpers xkcd, oldschool, and gibberish are TODO. -suggestedScheme :: Int -> String +suggestedScheme :: Int -> IO String suggestedScheme i | i > 23 = xkcd i | i > 12 = oldschool i | otherwise = gibberish i -xkcd :: Int -> String -xkcd i = take i "correcthorsebatterystaple" +xkcd :: Int -> IO String +xkcd i = do + wOne <- randomCamel + wTwo <- randomCamel + wThree <- randomCamel + wFour <- randomCamel + return $ wOne <> wTwo <> wThree <> wFour -oldschool :: Int -> String -oldschool i = take i "PowerProlonger2974!" +oldschool :: Int -> IO String +oldschool i = do + wOne <- randomWord + wTwo <- randomWord + return $ wOne <> wTwo -gibberish :: Int -> String -gibberish i = take i "TCYx#@z5zlgw1o" +gibberish :: Int -> IO String +gibberish i = return "mf98sgs7bgg%#" + +wordList :: IO [String] +wordList = fmap lines (readFile "./src/Feature/Generation/wordlist.txt") + +randomWord :: IO String +randomWord = wordList >>= rIndex + +randomCamel :: IO String +randomCamel = camelCase <$> randomWord diff --git a/src/Feature/Generation/Shared.hs b/src/Feature/Generation/Shared.hs index c46b3e3..cb9cc9f 100644 --- a/src/Feature/Generation/Shared.hs +++ b/src/Feature/Generation/Shared.hs @@ -6,3 +6,15 @@ rIndex :: [a] -> IO a rIndex arr = do i <- randomRIO (0, length arr - 1) return $ arr !! i + +-- Defines the valid range of characters to be used when generating. +-- This consists of all lowercase Latin alphabet characters and the +-- numbers 1 through 9. +validChars :: [Char] +validChars = validLetters <> validNumbers + +validNumbers :: [Char] +validNumbers = ['1'..'9'] + +validLetters :: [Char] +validLetters = ['a'..'z'] diff --git a/src/Feature/Generation/Templates.hs b/src/Feature/Generation/Templates.hs new file mode 100644 index 0000000..5d23be9 --- /dev/null +++ b/src/Feature/Generation/Templates.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} + +module Feature.Generation.Templates ( renderGen ) where + +import Core.Templates (hxVals) + +import qualified Data.Text as T +import qualified Data.Text.Lazy as LT + +import Text.Blaze.Html.Renderer.Text (renderHtml) +import Text.Blaze.Html +import Text.Hamlet (shamletFile) + +import Prelude + +renderGen :: String -> LT.Text +renderGen genPw = renderHtml ( $(shamletFile "./views/gen.hamlet") ) + where + hsGeneratedSharing = hxVals "newSec" genPw diff --git a/src/wordlist b/src/Feature/Generation/wordlist.txt similarity index 99% rename from src/wordlist rename to src/Feature/Generation/wordlist.txt index 3beab81..b1dafc2 100644 --- a/src/wordlist +++ b/src/Feature/Generation/wordlist.txt @@ -195,6 +195,7 @@ bury bush busy butter +butterfly button buyer cable @@ -605,7 +606,6 @@ hall hammer hand handle -hang happen happy hard @@ -614,7 +614,6 @@ harm hate hatred have -head heal health hear @@ -628,7 +627,6 @@ help hence here hero -hers hide high highly diff --git a/views/cassius/style.cassius b/views/cassius/style.cassius index e073cdb..f0d894c 100644 --- a/views/cassius/style.cassius +++ b/views/cassius/style.cassius @@ -4,14 +4,18 @@ @colorFour: #435F5D html + font-family: Courier background-color: #{colorTwo} color: #{colorOne} body - font-family: Courier font-size: 20px text-align: left +h2 + font-family: monaco, Consolas, monospace + text-transform: uppercase + p margin: 0.4em 0 0.4em 0 @@ -38,6 +42,7 @@ a height: 1% .mainButton + margin: 0 0 0.25em 0 padding: 0.75em 1.75em background-color: #{colorThree} color: #{colorTwo} @@ -51,8 +56,8 @@ a outline: none color: #{colorOne} background: #{colorTwo} - margin: 1em 0 - border-style: none none none none + margin: 0.5em 0 + border-style: none none solid none padding: 0.4em 0 box-sizing: border-box -webkit-box-sizing: border-box @@ -77,6 +82,9 @@ a .pwUtils width: 75% +.generators + margin: 5% 0 0 0 + .shareNew margin-bottom: 2em diff --git a/views/gen.hamlet b/views/gen.hamlet new file mode 100644 index 0000000..ad06b58 --- /dev/null +++ b/views/gen.hamlet @@ -0,0 +1,19 @@ +
+

Generators +

Generated password: +

#{genPw} +