module ModelCustom where import Prelude import Crypto.BCrypt as Import hiding (hashPassword) import Database.Persist.Sql import Safe (fromJustNote) import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Data.Aeson as A import System.Entropy (getEntropy) import qualified Data.ByteString.Builder as BB import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Base64.URL as Base64Url import qualified Crypto.Hash.SHA256 as SHA256 mkSlug :: Int -> IO T.Text mkSlug size = TE.decodeUtf8 . LBS.toStrict . BB.toLazyByteString . BB.byteStringHex <$> getEntropy size -- * Bookmark Slug newtype BmSlug = BmSlug { unBmSlug :: T.Text } deriving (Eq, PersistField, PersistFieldSql, Show, Read, Ord, A.FromJSON, A.ToJSON) mkBmSlug :: IO BmSlug mkBmSlug = BmSlug <$> mkSlug 6 -- * Note Slug newtype NtSlug = NtSlug { unNtSlug :: T.Text } deriving (Eq, PersistField, PersistFieldSql, Show, Read, Ord, A.FromJSON, A.ToJSON) mkNtSlug :: IO NtSlug mkNtSlug = NtSlug <$> mkSlug 10 -- * Model Crypto policy :: HashingPolicy policy = HashingPolicy { preferredHashCost = 12 , preferredHashAlgorithm = "$2a$" } newtype BCrypt = BCrypt { unBCrypt :: T.Text } deriving (Eq, PersistField, PersistFieldSql, Show, Ord, A.FromJSON, A.ToJSON) hashPassword :: T.Text -> IO BCrypt hashPassword rawPassword = do mPassword <- hashPasswordUsingPolicy policy (TE.encodeUtf8 rawPassword) return (BCrypt (TE.decodeUtf8 (fromJustNote "Invalid hashing policy" mPassword))) validatePasswordHash :: BCrypt -> T.Text -> Bool validatePasswordHash hash' pass = do validatePassword (TE.encodeUtf8 (unBCrypt hash')) (TE.encodeUtf8 pass) newtype ApiKey = ApiKey { unApiKey :: T.Text } newtype HashedApiKey = HashedApiKey T.Text deriving stock (Eq, Ord, Show) deriving newtype (PersistField, PersistFieldSql, A.FromJSON, A.ToJSON) generateApiKey :: IO ApiKey generateApiKey = do bytes <- getEntropy 32 pure $ ApiKey $ Base64Url.encodeBase64 bytes hashApiKey :: ApiKey -> HashedApiKey hashApiKey = HashedApiKey . TE.decodeUtf8 . Base64Url.encodeBase64' . SHA256.hash . TE.encodeUtf8 . unApiKey