Start formatting with stylish-haskell. Start refactoring for clearer types.

Purr.cabal

@@ -32,7 +32,6 @@ library
       Feature.Sharing.HTTP
       Feature.Sharing.SQLite
       Feature.Sharing.Templates
-      Feature.Sharing.Types
       Lib
   other-modules:
       Paths_Purr

src/Core/HTTP.hs

@@ -3,8 +3,8 @@ module Core.HTTP ( app ) where
 import           Core.Types
 
 import           Core.Templates                       (renderIndex, renderStyle)
-import Feature.Sharing.HTTP    as Sharing
 import           Feature.Generation.HTTP              as Generation
+import           Feature.Sharing.HTTP                 as Sharing
 
 import           Control.Monad.Reader                 (ask, lift)
 import           Data.Maybe                           (Maybe (Nothing))

src/Core/Templates.hs

@@ -3,8 +3,8 @@
 
 module Core.Templates ( renderIndex, renderStyle, hxVals ) where
 
-import Text.Blaze.Html.Renderer.Text (renderHtml)
 import           Text.Blaze.Html
+import           Text.Blaze.Html.Renderer.Text (renderHtml)
 import           Text.Cassius                  (cassiusFile, renderCss)
 import           Text.Hamlet                   (shamletFile)
 

src/Core/Types.hs

@@ -1,20 +1,34 @@
 module Core.Types where
 
+import qualified Data.Text                      as T
 import qualified Data.Text.Lazy                 as LT
 
 import           Control.Monad.Reader           (MonadIO, MonadReader, ReaderT)
 import           Data.Text
+import           Database.SQLite.Simple         (ToRow)
+import           Database.SQLite.Simple.FromRow (FromRow)
 import           GHC.Generics                   (Generic)
 import           Numeric.Natural                (Natural)
-import Web.Scotty.Trans     (ScottyT, ActionT)
+import           Text.Blaze.Html
+import           Web.Scotty.Trans               (ActionT, ScottyT)
 
 type PurrApp    a = ScottyT LT.Text ConfigM a
 type PurrAction a = ActionT LT.Text ConfigM a
+type Random     a = IO a
 
 newtype ConfigM a = ConfigM
   { runConfigM :: ReaderT DhallConfig IO a
   } deriving (Applicative, Functor, Monad, MonadIO, MonadReader DhallConfig)
 
+newtype Password = Password' String
+  deriving (Eq, Ord)
+
+newtype UserSecret = UserSecret' String
+  deriving (Eq, Ord)
+
+newtype GenLink = GenLink' String
+  deriving (Eq, Ord)
+
 data DhallConfig = DhallConfig
   { environment     :: String
   , applicationHost :: String
@@ -24,3 +38,36 @@ data DhallConfig = DhallConfig
   , linkLength      :: Int
   , adminEmail      :: String
   } deriving (Generic, Show)
+
+data SecretEntry = SecretEntry
+  { link     :: T.Text
+  , secret   :: T.Text
+  , date     :: Integer
+  , life     :: Integer
+  , views    :: Integer
+  , maxViews :: Integer
+  } deriving (Show, Generic)
+
+data Secret = Password | UserSecret
+    deriving (Show, Generic)
+
+instance Show GenLink where
+  show (GenLink' a) = a
+
+instance Show Password where
+  show (Password' a) = a
+
+instance Show UserSecret where
+  show (UserSecret' a) = a
+
+instance ToMarkup Password where
+  toMarkup = toMarkup . show
+
+instance ToMarkup UserSecret where
+  toMarkup = toMarkup . show
+
+instance ToMarkup Secret where
+  toMarkup = toMarkup . show
+
+instance FromRow  SecretEntry where
+instance ToRow    SecretEntry where

src/Feature/Generation/HTTP.hs

@@ -1,13 +1,10 @@
 module Feature.Generation.HTTP ( routes ) where
 
-import Core.Types
 import           Core.Templates               (renderIndex)
+import           Core.Types
 
-import Feature.Generation.Passwords 
+import           Feature.Generation.Passwords (gibberish, oldschool,
-  ( suggestedScheme
+                                               suggestedScheme, xkcd)
-  , xkcd
-  , oldschool
-  , gibberish )
 import           Feature.Generation.Templates (renderGen)
 
 import qualified Data.Text                    as T
@@ -15,8 +12,8 @@ import qualified Data.Text.Lazy as LT
 
 import           Control.Monad.Reader         (ask, lift, liftIO)
 import           Data.Maybe                   (listToMaybe)
-import Web.Scotty.Trans 
 import           Prelude
+import           Web.Scotty.Trans
 
 routes :: PurrApp ()
 routes = do

src/Feature/Generation/Links.hs

@@ -1,17 +1,11 @@
 module Feature.Generation.Links ( genLink ) where
 
 import           Core.Types
-import Feature.Generation.Shared (rIndex, rChar, validChars)
+import           Feature.Generation.Shared (rChar, rIndex, validChars)
 
 import           Control.Monad.Reader      (ask, lift)
 import           Data.List                 (singleton)
 
-newtype GenLink = GenLink' String
-  deriving (Eq, Ord)
-
-instance Show GenLink where
-  show (GenLink' a) = a
-
 -- Generates a string containing romly generated and capitalized
 -- characters. The number of characters used is defined in the global config.dhall.
 genLink :: Int -> IO GenLink

src/Feature/Generation/Passwords.hs

@@ -1,5 +1,6 @@
 module Feature.Generation.Passwords
   ( Password
+  , Random
   , suggestedScheme
   , xkcd
   , oldschool
@@ -7,30 +8,19 @@ module Feature.Generation.Passwords
   ) where
 
 import           Core.Types
-import Feature.Generation.Shared 
+import           Feature.Generation.Shared (camelCase, rCharSym, rIndex,
-  ( camelCase
+                                            validChars, validNumbers,
-  , rCharSym
+                                            validSymbols)
-  , rIndex
-  , validChars
-  , validNumbers
-  , validSymbols 
-  )
 
 import           Data.List                 (singleton)
 
-newtype Password = Password' String
+suggestedScheme :: Int -> Random Password
-  deriving (Eq, Ord)
-
-instance Show Password where 
-  show (Password' a) = a
-
-suggestedScheme :: Int -> IO Password
 suggestedScheme i
   | i > 17    = xkcd
   | i > 12    = oldschool
   | otherwise = gibberish i
 
-xkcd :: IO Password
+xkcd :: Random Password
 xkcd = do
   wOne   <- rCamel
   wTwo   <- rCamel
@@ -38,7 +28,7 @@ xkcd = do
   wFour  <- rCamel
   return  $ Password' (wOne <> wTwo <> wThree <> wFour)
 
-oldschool :: IO Password
+oldschool :: Random Password
 oldschool = do
   wOne <- rCamel
   wTwo <- rCamel
@@ -52,24 +42,24 @@ oldschool = do
    <> show nOne <> show nTwo <> show nThr <> show nFou
    <> pure sOne)
 
-gibberish :: Int -> IO Password
+gibberish :: Int -> Random Password
 gibberish i = go i (return "")
   where
-    go :: Int -> IO String -> IO Password
+    go :: Int -> Random String -> Random Password
     go 0 s = Password' <$> s
     go i s = go (i - 1) (s <> (singleton <$> rCharSym))
 
-rNum :: IO Int
+rNum :: Random Int
 rNum = rIndex validNumbers
 
-rWord :: IO String
+rWord :: Random String
 rWord = wordList >>= rIndex
 
-rSym :: IO Char
+rSym :: Random Char
 rSym = rIndex validSymbols
 
-rCamel :: IO String
+rCamel :: Random String
 rCamel = camelCase <$> rWord
 
-wordList :: IO [String]
+wordList :: Random [String]
 wordList = fmap lines (readFile "./src/Feature/Generation/wordlist.txt")

src/Feature/Generation/Templates.hs

@@ -9,8 +9,8 @@ import Feature.Generation.Passwords (Password)
 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.Blaze.Html.Renderer.Text (renderHtml)
 import           Text.Hamlet                   (shamletFile)
 
 import           Prelude

src/Feature/Sharing/HTTP.hs

@@ -1,19 +1,18 @@
 module Feature.Sharing.HTTP ( routes ) where
 
 import           Core.SQLite               (confLinkLength)
-import Core.Types
 import           Core.Templates            (renderIndex)
+import           Core.Types
 
 import           Feature.Generation.Links  (genLink)
 import           Feature.Sharing.SQLite    (findByLink, insertNewSecret)
 import           Feature.Sharing.Templates (renderPw)
-import Feature.Sharing.Types
 
 import           Control.Monad.Reader      (ask, lift, liftIO)
-import Data.Maybe           (listToMaybe)
 import           Data.List.Split           (splitOn)
-import Web.Scotty.Trans 
+import           Data.Maybe                (listToMaybe)
 import           Prelude
+import           Web.Scotty.Trans
 
 import qualified Data.Text                 as T
 import qualified Data.Text.Lazy            as LT

src/Feature/Sharing/SQLite.hs

@@ -1,15 +1,14 @@
 module Feature.Sharing.SQLite where
 
-import Core.Types
 import           Core.SQLite
+import           Core.Types
 import           Feature.Generation.Passwords (Password)
-import Feature.Sharing.Types
 
 import           Control.Monad.Reader         (ask, lift, liftIO)
-import Crypto.Simple.CBC              (encrypt, decrypt)
+import           Crypto.Simple.CBC            (decrypt, encrypt)
+import           Data.List.Split              (splitOn)
 import           Data.Maybe                   (listToMaybe)
 import           Data.Time.Clock.POSIX        (getPOSIXTime)
-import Data.List.Split                (splitOn)
 import           Database.SQLite.Simple
 
 import qualified Data.ByteString.Base64       as B64

src/Feature/Sharing/Templates.hs

@@ -3,11 +3,13 @@
 
 module Feature.Sharing.Templates ( renderPw ) where
 
+import           Core.Types
+
 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.Blaze.Html.Renderer.Text (renderHtml)
 import           Text.Hamlet                   (shamletFile)
 
 import           Prelude

src/Feature/Sharing/Types.hs

@@ -1,22 +0,0 @@
-module Feature.Sharing.Types where
-
-import Data.Map.Strict (Map)
-import Data.Typeable   (Typeable)
-import GHC.Generics
-
-import Database.SQLite.Simple
-import Database.SQLite.Simple.FromRow
-
-import qualified Data.Text as T
-
-data SecretEntry = SecretEntry 
- { link     :: T.Text 
- , secret   :: T.Text 
- , date     :: Integer
- , life     :: Integer
- , views    :: Integer
- , maxViews :: Integer
- } deriving (Show, Generic)
-
-instance FromRow SecretEntry where
-instance ToRow SecretEntry where