HAppSHelpers 0.4 → 0.5

raw patch · 4 files changed

+117/−4 lines, 4 filesdep +Cryptodep +HAppS-Datadep +HAppS-IxSet

Dependencies added: Crypto, HAppS-Data, HAppS-IxSet, PBKDF2, haskell98, random

Files

HAppS/Data/IxSet/Helpers.hs +26/−0
HAppS/Data/User/Password.hs +84/−0
HAppS/Helpers.hs +2/−0
HAppSHelpers.cabal +5/−4

+ HAppS/Data/IxSet/Helpers.hs view

@@ -0,0 +1,26 @@++module HAppS.Data.IxSet.Helpers where+import HAppS.Data.IxSet+import Data.Typeable+import Data.Generics++{- | +Sort of like a foreign key constraint, if macid were a normal rdbms.++Eg, say you have a table called RepoUsers. When a user (or repo) is deleted , all the RepoUsers that match it should also be deleted+-}+deleteWhere :: (Typeable k, Indexable a b, Ord a, Data a) => k -> IxSet a -> IxSet a+deleteWhere val ixset = +  let elems = toList $ getEQ val ixset+      f elem ixs = delete elem ixs+  in  foldr f ixset elems++---------------------------------------------------------+-- Candidate for test case patch into happs sources.+---------------------------------------------------------+instance (Ord a) => Eq (IxSet a) where+  a == b = (toList a) == (toList b)+{-+tDupe = ( insert t1 . insert t1 $ empty ) == ( insert t1 empty )+  where t1 = RepoUser (RepoName (B.pack "repmee" )) (UserName (B.pack "usermee" ) )+-}

+ HAppS/Data/User/Password.hs view

@@ -0,0 +1,84 @@+{-# LANGUAGE TemplateHaskell,DeriveDataTypeable,FlexibleInstances,MultiParamTypeClasses,FlexibleContexts,UndecidableInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  HAppS.Data.User.Password+-- Copyright   :  (c) 2008 Jeremy Shaw <jeremy@n-heptane.com>, +-- modified by Thomas Hartman to use PBKDF2, and uploaded to hackage+-- License     :  BSD3-style+-- +-- Maintainer  :  Thomas Hartman, thomashartman1@gmail.com+-- Stability   :  experimental+-- Portability :  requires all sorts of crazy GHC extensions+--+-- Data types and functions for handling salted passwords.+-----------------------------------------------------------------------------+module HAppS.Data.User.Password where++import Control.Monad+--import HAppS.Crypto.SHA1+import HAppS.Data+import System.Random+import qualified Crypto.PBKDF2 as PBKDF2+import qualified Data.ByteString.Char8 as B+import Data.Word+import Control.Monad.Trans++$( deriveAll [''Ord,''Eq,''Read,''Show,''Default] +   [d|+       data    Password     = Password Salt PasswordHash+       newtype PasswordHash = PasswordHash [Word8]+       newtype Salt         = Salt String+    |] )++$(deriveSerialize ''Password)+instance Version Password+$(deriveSerialize ''PasswordHash)+instance Version PasswordHash+$(deriveSerialize ''Salt)+instance Version Salt++-- |check if the submitted password matches the stored password+checkPassword :: Password -- ^ stored salt and password hash+              -> String  -- ^ password to test (unhashed)+              -> Bool -- ^ did it match+checkPassword (Password salt hash) password = doHash salt password == hash++t = doHash ( Salt "fooie" ) "blee"++{- |hash a password using the supplied salt+Originally implemented using SHA1. By switching to pbkdf2, we don't rely on implementation of randomIO being cryptographically secure.+-}+doHash :: Salt -> String -> PasswordHash+doHash (Salt salt) password =+    case PBKDF2.pbkdf2 (PBKDF2.Password . PBKDF2.toOctets $ password) (PBKDF2.Salt . PBKDF2.toOctets $ salt) +      of (PBKDF2.HashedPass hp) -> PasswordHash hp+    -- PasswordHash (sha1 (salt ++ password))++++changepass :: (Monad m) => String -> String -> Password -> m Password+changepass oldpassTryString newpassString p@(Password salt hash) =+    if checkPassword p oldpassTryString +      then return $ mkP salt newpassString+      else fail "incorrect old password"++-- |generate some random salt+ -- returns 4 'Char' of salt.+genSalt :: MonadIO m => m Salt+genSalt = liftIO . liftM Salt $ ( replicateM 4 randomIO :: IO String)++-- |generate a new salted/hashed 'Password' from the given input string+newPassword :: MonadIO m => String -> m Password+newPassword password =+    do salt <- genSalt+       return $ mkP salt password++mkP salt password = Password salt $ doHash salt password++--t = putStrLn . show =<< newPassword "blee"++++++

HAppS/Helpers.hs view

@@ -3,9 +3,11 @@   , module HAppS.Helpers.HtmlOutput   , module HAppS.Helpers.ParseRequest   , module HAppS.Helpers.Redirect+  , module HAppS.Data.User.Password ) where  import HAppS.Helpers.DirBrowse import HAppS.Helpers.HtmlOutput import HAppS.Helpers.ParseRequest import HAppS.Helpers.Redirect+import HAppS.Data.User.Password

HAppSHelpers.cabal view

@@ -1,20 +1,21 @@ Name: HAppSHelpers-Version: 0.4+Version: 0.5 License: BSD3 License-file: bsd3.txt Description: Functions I found I was using repeatedly when programming HAppS based web-apps.    I'll deprecate whatever bits of this make their way into the HAppS core on hackage. Synopsis: Convenience functions for HAppS.  Maintainer: Thomas Hartman <thomashartman1 at gmail>-Author: Thomas Hartman & Eelco Lempsink+Author: Thomas Hartman & Eelco Lempsink & Jeremy Shaw Stability: Beta Copyright: Copyright (c) 2008 Thomas Hartman Exposed-Modules: HAppS.Helpers,HAppS.Helpers.DirBrowse, HAppS.Helpers.HtmlOutput, HAppS.Helpers.HtmlOutput.Common,                   HAppS.Helpers.HtmlOutput.Menu, HAppS.Helpers.ParseRequest,HAppS.Helpers.Redirect, -                 HAppS.Server.CookieFixer+                 HAppS.Data.User.Password, HAppS.Server.CookieFixer, HAppS.Data.IxSet.Helpers                   Build-Depends: base, mtl, HAppS-Server, hscolour, filepath, directory, bytestring,-               HStringTemplate, HStringTemplateHelpers, safe, MissingH, containers, parsec+               HStringTemplate, HStringTemplateHelpers, safe, MissingH, containers, parsec, Crypto, haskell98,+               HAppS-IxSet, PBKDF2, random, HAppS-Data Category: Distributed Computing Build-type: Simple