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 :: Int -> IO Text
mkSlug Int
size =
  ByteString -> Text
TE.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString)
-> (ByteString -> Builder) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
BB.byteStringHex (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  Int -> IO ByteString
getEntropy Int
size

-- * Bookmark Slug

newtype BmSlug = BmSlug
  { BmSlug -> Text
unBmSlug :: T.Text
  } deriving (BmSlug -> BmSlug -> Bool
(BmSlug -> BmSlug -> Bool)
-> (BmSlug -> BmSlug -> Bool) -> Eq BmSlug
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BmSlug -> BmSlug -> Bool
== :: BmSlug -> BmSlug -> Bool
$c/= :: BmSlug -> BmSlug -> Bool
/= :: BmSlug -> BmSlug -> Bool
Eq, PersistValue -> Either Text BmSlug
BmSlug -> PersistValue
(BmSlug -> PersistValue)
-> (PersistValue -> Either Text BmSlug) -> PersistField BmSlug
forall a.
(a -> PersistValue)
-> (PersistValue -> Either Text a) -> PersistField a
$ctoPersistValue :: BmSlug -> PersistValue
toPersistValue :: BmSlug -> PersistValue
$cfromPersistValue :: PersistValue -> Either Text BmSlug
fromPersistValue :: PersistValue -> Either Text BmSlug
PersistField, PersistField BmSlug
Proxy BmSlug -> SqlType
PersistField BmSlug =>
(Proxy BmSlug -> SqlType) -> PersistFieldSql BmSlug
forall a.
PersistField a =>
(Proxy a -> SqlType) -> PersistFieldSql a
$csqlType :: Proxy BmSlug -> SqlType
sqlType :: Proxy BmSlug -> SqlType
PersistFieldSql, Int -> BmSlug -> ShowS
[BmSlug] -> ShowS
BmSlug -> String
(Int -> BmSlug -> ShowS)
-> (BmSlug -> String) -> ([BmSlug] -> ShowS) -> Show BmSlug
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BmSlug -> ShowS
showsPrec :: Int -> BmSlug -> ShowS
$cshow :: BmSlug -> String
show :: BmSlug -> String
$cshowList :: [BmSlug] -> ShowS
showList :: [BmSlug] -> ShowS
Show, ReadPrec [BmSlug]
ReadPrec BmSlug
Int -> ReadS BmSlug
ReadS [BmSlug]
(Int -> ReadS BmSlug)
-> ReadS [BmSlug]
-> ReadPrec BmSlug
-> ReadPrec [BmSlug]
-> Read BmSlug
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS BmSlug
readsPrec :: Int -> ReadS BmSlug
$creadList :: ReadS [BmSlug]
readList :: ReadS [BmSlug]
$creadPrec :: ReadPrec BmSlug
readPrec :: ReadPrec BmSlug
$creadListPrec :: ReadPrec [BmSlug]
readListPrec :: ReadPrec [BmSlug]
Read, Eq BmSlug
Eq BmSlug =>
(BmSlug -> BmSlug -> Ordering)
-> (BmSlug -> BmSlug -> Bool)
-> (BmSlug -> BmSlug -> Bool)
-> (BmSlug -> BmSlug -> Bool)
-> (BmSlug -> BmSlug -> Bool)
-> (BmSlug -> BmSlug -> BmSlug)
-> (BmSlug -> BmSlug -> BmSlug)
-> Ord BmSlug
BmSlug -> BmSlug -> Bool
BmSlug -> BmSlug -> Ordering
BmSlug -> BmSlug -> BmSlug
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BmSlug -> BmSlug -> Ordering
compare :: BmSlug -> BmSlug -> Ordering
$c< :: BmSlug -> BmSlug -> Bool
< :: BmSlug -> BmSlug -> Bool
$c<= :: BmSlug -> BmSlug -> Bool
<= :: BmSlug -> BmSlug -> Bool
$c> :: BmSlug -> BmSlug -> Bool
> :: BmSlug -> BmSlug -> Bool
$c>= :: BmSlug -> BmSlug -> Bool
>= :: BmSlug -> BmSlug -> Bool
$cmax :: BmSlug -> BmSlug -> BmSlug
max :: BmSlug -> BmSlug -> BmSlug
$cmin :: BmSlug -> BmSlug -> BmSlug
min :: BmSlug -> BmSlug -> BmSlug
Ord, Maybe BmSlug
Value -> Parser [BmSlug]
Value -> Parser BmSlug
(Value -> Parser BmSlug)
-> (Value -> Parser [BmSlug]) -> Maybe BmSlug -> FromJSON BmSlug
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser BmSlug
parseJSON :: Value -> Parser BmSlug
$cparseJSONList :: Value -> Parser [BmSlug]
parseJSONList :: Value -> Parser [BmSlug]
$comittedField :: Maybe BmSlug
omittedField :: Maybe BmSlug
A.FromJSON, [BmSlug] -> Value
[BmSlug] -> Encoding
BmSlug -> Bool
BmSlug -> Value
BmSlug -> Encoding
(BmSlug -> Value)
-> (BmSlug -> Encoding)
-> ([BmSlug] -> Value)
-> ([BmSlug] -> Encoding)
-> (BmSlug -> Bool)
-> ToJSON BmSlug
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: BmSlug -> Value
toJSON :: BmSlug -> Value
$ctoEncoding :: BmSlug -> Encoding
toEncoding :: BmSlug -> Encoding
$ctoJSONList :: [BmSlug] -> Value
toJSONList :: [BmSlug] -> Value
$ctoEncodingList :: [BmSlug] -> Encoding
toEncodingList :: [BmSlug] -> Encoding
$comitField :: BmSlug -> Bool
omitField :: BmSlug -> Bool
A.ToJSON)

mkBmSlug :: IO BmSlug
mkBmSlug :: IO BmSlug
mkBmSlug = Text -> BmSlug
BmSlug (Text -> BmSlug) -> IO Text -> IO BmSlug
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO Text
mkSlug Int
6

-- * Note Slug

newtype NtSlug = NtSlug
  { NtSlug -> Text
unNtSlug :: T.Text
  } deriving (NtSlug -> NtSlug -> Bool
(NtSlug -> NtSlug -> Bool)
-> (NtSlug -> NtSlug -> Bool) -> Eq NtSlug
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NtSlug -> NtSlug -> Bool
== :: NtSlug -> NtSlug -> Bool
$c/= :: NtSlug -> NtSlug -> Bool
/= :: NtSlug -> NtSlug -> Bool
Eq, PersistValue -> Either Text NtSlug
NtSlug -> PersistValue
(NtSlug -> PersistValue)
-> (PersistValue -> Either Text NtSlug) -> PersistField NtSlug
forall a.
(a -> PersistValue)
-> (PersistValue -> Either Text a) -> PersistField a
$ctoPersistValue :: NtSlug -> PersistValue
toPersistValue :: NtSlug -> PersistValue
$cfromPersistValue :: PersistValue -> Either Text NtSlug
fromPersistValue :: PersistValue -> Either Text NtSlug
PersistField, PersistField NtSlug
Proxy NtSlug -> SqlType
PersistField NtSlug =>
(Proxy NtSlug -> SqlType) -> PersistFieldSql NtSlug
forall a.
PersistField a =>
(Proxy a -> SqlType) -> PersistFieldSql a
$csqlType :: Proxy NtSlug -> SqlType
sqlType :: Proxy NtSlug -> SqlType
PersistFieldSql, Int -> NtSlug -> ShowS
[NtSlug] -> ShowS
NtSlug -> String
(Int -> NtSlug -> ShowS)
-> (NtSlug -> String) -> ([NtSlug] -> ShowS) -> Show NtSlug
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NtSlug -> ShowS
showsPrec :: Int -> NtSlug -> ShowS
$cshow :: NtSlug -> String
show :: NtSlug -> String
$cshowList :: [NtSlug] -> ShowS
showList :: [NtSlug] -> ShowS
Show, ReadPrec [NtSlug]
ReadPrec NtSlug
Int -> ReadS NtSlug
ReadS [NtSlug]
(Int -> ReadS NtSlug)
-> ReadS [NtSlug]
-> ReadPrec NtSlug
-> ReadPrec [NtSlug]
-> Read NtSlug
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS NtSlug
readsPrec :: Int -> ReadS NtSlug
$creadList :: ReadS [NtSlug]
readList :: ReadS [NtSlug]
$creadPrec :: ReadPrec NtSlug
readPrec :: ReadPrec NtSlug
$creadListPrec :: ReadPrec [NtSlug]
readListPrec :: ReadPrec [NtSlug]
Read, Eq NtSlug
Eq NtSlug =>
(NtSlug -> NtSlug -> Ordering)
-> (NtSlug -> NtSlug -> Bool)
-> (NtSlug -> NtSlug -> Bool)
-> (NtSlug -> NtSlug -> Bool)
-> (NtSlug -> NtSlug -> Bool)
-> (NtSlug -> NtSlug -> NtSlug)
-> (NtSlug -> NtSlug -> NtSlug)
-> Ord NtSlug
NtSlug -> NtSlug -> Bool
NtSlug -> NtSlug -> Ordering
NtSlug -> NtSlug -> NtSlug
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: NtSlug -> NtSlug -> Ordering
compare :: NtSlug -> NtSlug -> Ordering
$c< :: NtSlug -> NtSlug -> Bool
< :: NtSlug -> NtSlug -> Bool
$c<= :: NtSlug -> NtSlug -> Bool
<= :: NtSlug -> NtSlug -> Bool
$c> :: NtSlug -> NtSlug -> Bool
> :: NtSlug -> NtSlug -> Bool
$c>= :: NtSlug -> NtSlug -> Bool
>= :: NtSlug -> NtSlug -> Bool
$cmax :: NtSlug -> NtSlug -> NtSlug
max :: NtSlug -> NtSlug -> NtSlug
$cmin :: NtSlug -> NtSlug -> NtSlug
min :: NtSlug -> NtSlug -> NtSlug
Ord, Maybe NtSlug
Value -> Parser [NtSlug]
Value -> Parser NtSlug
(Value -> Parser NtSlug)
-> (Value -> Parser [NtSlug]) -> Maybe NtSlug -> FromJSON NtSlug
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser NtSlug
parseJSON :: Value -> Parser NtSlug
$cparseJSONList :: Value -> Parser [NtSlug]
parseJSONList :: Value -> Parser [NtSlug]
$comittedField :: Maybe NtSlug
omittedField :: Maybe NtSlug
A.FromJSON, [NtSlug] -> Value
[NtSlug] -> Encoding
NtSlug -> Bool
NtSlug -> Value
NtSlug -> Encoding
(NtSlug -> Value)
-> (NtSlug -> Encoding)
-> ([NtSlug] -> Value)
-> ([NtSlug] -> Encoding)
-> (NtSlug -> Bool)
-> ToJSON NtSlug
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: NtSlug -> Value
toJSON :: NtSlug -> Value
$ctoEncoding :: NtSlug -> Encoding
toEncoding :: NtSlug -> Encoding
$ctoJSONList :: [NtSlug] -> Value
toJSONList :: [NtSlug] -> Value
$ctoEncodingList :: [NtSlug] -> Encoding
toEncodingList :: [NtSlug] -> Encoding
$comitField :: NtSlug -> Bool
omitField :: NtSlug -> Bool
A.ToJSON)

mkNtSlug :: IO NtSlug
mkNtSlug :: IO NtSlug
mkNtSlug = Text -> NtSlug
NtSlug (Text -> NtSlug) -> IO Text -> IO NtSlug
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO Text
mkSlug Int
10

-- * Model Crypto

policy :: HashingPolicy
policy :: HashingPolicy
policy =
  HashingPolicy
  { preferredHashCost :: Int
preferredHashCost = Int
12
  , preferredHashAlgorithm :: ByteString
preferredHashAlgorithm = ByteString
"$2a$"
  }

newtype BCrypt = BCrypt
  { BCrypt -> Text
unBCrypt :: T.Text
  } deriving (BCrypt -> BCrypt -> Bool
(BCrypt -> BCrypt -> Bool)
-> (BCrypt -> BCrypt -> Bool) -> Eq BCrypt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BCrypt -> BCrypt -> Bool
== :: BCrypt -> BCrypt -> Bool
$c/= :: BCrypt -> BCrypt -> Bool
/= :: BCrypt -> BCrypt -> Bool
Eq, PersistValue -> Either Text BCrypt
BCrypt -> PersistValue
(BCrypt -> PersistValue)
-> (PersistValue -> Either Text BCrypt) -> PersistField BCrypt
forall a.
(a -> PersistValue)
-> (PersistValue -> Either Text a) -> PersistField a
$ctoPersistValue :: BCrypt -> PersistValue
toPersistValue :: BCrypt -> PersistValue
$cfromPersistValue :: PersistValue -> Either Text BCrypt
fromPersistValue :: PersistValue -> Either Text BCrypt
PersistField, PersistField BCrypt
Proxy BCrypt -> SqlType
PersistField BCrypt =>
(Proxy BCrypt -> SqlType) -> PersistFieldSql BCrypt
forall a.
PersistField a =>
(Proxy a -> SqlType) -> PersistFieldSql a
$csqlType :: Proxy BCrypt -> SqlType
sqlType :: Proxy BCrypt -> SqlType
PersistFieldSql, Int -> BCrypt -> ShowS
[BCrypt] -> ShowS
BCrypt -> String
(Int -> BCrypt -> ShowS)
-> (BCrypt -> String) -> ([BCrypt] -> ShowS) -> Show BCrypt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BCrypt -> ShowS
showsPrec :: Int -> BCrypt -> ShowS
$cshow :: BCrypt -> String
show :: BCrypt -> String
$cshowList :: [BCrypt] -> ShowS
showList :: [BCrypt] -> ShowS
Show, Eq BCrypt
Eq BCrypt =>
(BCrypt -> BCrypt -> Ordering)
-> (BCrypt -> BCrypt -> Bool)
-> (BCrypt -> BCrypt -> Bool)
-> (BCrypt -> BCrypt -> Bool)
-> (BCrypt -> BCrypt -> Bool)
-> (BCrypt -> BCrypt -> BCrypt)
-> (BCrypt -> BCrypt -> BCrypt)
-> Ord BCrypt
BCrypt -> BCrypt -> Bool
BCrypt -> BCrypt -> Ordering
BCrypt -> BCrypt -> BCrypt
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BCrypt -> BCrypt -> Ordering
compare :: BCrypt -> BCrypt -> Ordering
$c< :: BCrypt -> BCrypt -> Bool
< :: BCrypt -> BCrypt -> Bool
$c<= :: BCrypt -> BCrypt -> Bool
<= :: BCrypt -> BCrypt -> Bool
$c> :: BCrypt -> BCrypt -> Bool
> :: BCrypt -> BCrypt -> Bool
$c>= :: BCrypt -> BCrypt -> Bool
>= :: BCrypt -> BCrypt -> Bool
$cmax :: BCrypt -> BCrypt -> BCrypt
max :: BCrypt -> BCrypt -> BCrypt
$cmin :: BCrypt -> BCrypt -> BCrypt
min :: BCrypt -> BCrypt -> BCrypt
Ord, Maybe BCrypt
Value -> Parser [BCrypt]
Value -> Parser BCrypt
(Value -> Parser BCrypt)
-> (Value -> Parser [BCrypt]) -> Maybe BCrypt -> FromJSON BCrypt
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser BCrypt
parseJSON :: Value -> Parser BCrypt
$cparseJSONList :: Value -> Parser [BCrypt]
parseJSONList :: Value -> Parser [BCrypt]
$comittedField :: Maybe BCrypt
omittedField :: Maybe BCrypt
A.FromJSON, [BCrypt] -> Value
[BCrypt] -> Encoding
BCrypt -> Bool
BCrypt -> Value
BCrypt -> Encoding
(BCrypt -> Value)
-> (BCrypt -> Encoding)
-> ([BCrypt] -> Value)
-> ([BCrypt] -> Encoding)
-> (BCrypt -> Bool)
-> ToJSON BCrypt
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: BCrypt -> Value
toJSON :: BCrypt -> Value
$ctoEncoding :: BCrypt -> Encoding
toEncoding :: BCrypt -> Encoding
$ctoJSONList :: [BCrypt] -> Value
toJSONList :: [BCrypt] -> Value
$ctoEncodingList :: [BCrypt] -> Encoding
toEncodingList :: [BCrypt] -> Encoding
$comitField :: BCrypt -> Bool
omitField :: BCrypt -> Bool
A.ToJSON)

hashPassword :: T.Text -> IO BCrypt
hashPassword :: Text -> IO BCrypt
hashPassword Text
rawPassword = do
  Maybe ByteString
mPassword <- HashingPolicy -> ByteString -> IO (Maybe ByteString)
hashPasswordUsingPolicy HashingPolicy
policy (Text -> ByteString
TE.encodeUtf8 Text
rawPassword)
  BCrypt -> IO BCrypt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
    (Text -> BCrypt
BCrypt (ByteString -> Text
TE.decodeUtf8 (String -> Maybe ByteString -> ByteString
forall a. Partial => String -> Maybe a -> a
fromJustNote String
"Invalid hashing policy" Maybe ByteString
mPassword)))

validatePasswordHash :: BCrypt -> T.Text -> Bool
validatePasswordHash :: BCrypt -> Text -> Bool
validatePasswordHash BCrypt
hash' Text
pass = do
  ByteString -> ByteString -> Bool
validatePassword (Text -> ByteString
TE.encodeUtf8 (BCrypt -> Text
unBCrypt BCrypt
hash')) (Text -> ByteString
TE.encodeUtf8 Text
pass)

newtype ApiKey = ApiKey { ApiKey -> Text
unApiKey :: T.Text }

newtype HashedApiKey
  = HashedApiKey T.Text
  deriving stock (HashedApiKey -> HashedApiKey -> Bool
(HashedApiKey -> HashedApiKey -> Bool)
-> (HashedApiKey -> HashedApiKey -> Bool) -> Eq HashedApiKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HashedApiKey -> HashedApiKey -> Bool
== :: HashedApiKey -> HashedApiKey -> Bool
$c/= :: HashedApiKey -> HashedApiKey -> Bool
/= :: HashedApiKey -> HashedApiKey -> Bool
Eq, Eq HashedApiKey
Eq HashedApiKey =>
(HashedApiKey -> HashedApiKey -> Ordering)
-> (HashedApiKey -> HashedApiKey -> Bool)
-> (HashedApiKey -> HashedApiKey -> Bool)
-> (HashedApiKey -> HashedApiKey -> Bool)
-> (HashedApiKey -> HashedApiKey -> Bool)
-> (HashedApiKey -> HashedApiKey -> HashedApiKey)
-> (HashedApiKey -> HashedApiKey -> HashedApiKey)
-> Ord HashedApiKey
HashedApiKey -> HashedApiKey -> Bool
HashedApiKey -> HashedApiKey -> Ordering
HashedApiKey -> HashedApiKey -> HashedApiKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: HashedApiKey -> HashedApiKey -> Ordering
compare :: HashedApiKey -> HashedApiKey -> Ordering
$c< :: HashedApiKey -> HashedApiKey -> Bool
< :: HashedApiKey -> HashedApiKey -> Bool
$c<= :: HashedApiKey -> HashedApiKey -> Bool
<= :: HashedApiKey -> HashedApiKey -> Bool
$c> :: HashedApiKey -> HashedApiKey -> Bool
> :: HashedApiKey -> HashedApiKey -> Bool
$c>= :: HashedApiKey -> HashedApiKey -> Bool
>= :: HashedApiKey -> HashedApiKey -> Bool
$cmax :: HashedApiKey -> HashedApiKey -> HashedApiKey
max :: HashedApiKey -> HashedApiKey -> HashedApiKey
$cmin :: HashedApiKey -> HashedApiKey -> HashedApiKey
min :: HashedApiKey -> HashedApiKey -> HashedApiKey
Ord, Int -> HashedApiKey -> ShowS
[HashedApiKey] -> ShowS
HashedApiKey -> String
(Int -> HashedApiKey -> ShowS)
-> (HashedApiKey -> String)
-> ([HashedApiKey] -> ShowS)
-> Show HashedApiKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HashedApiKey -> ShowS
showsPrec :: Int -> HashedApiKey -> ShowS
$cshow :: HashedApiKey -> String
show :: HashedApiKey -> String
$cshowList :: [HashedApiKey] -> ShowS
showList :: [HashedApiKey] -> ShowS
Show)
  deriving newtype (PersistValue -> Either Text HashedApiKey
HashedApiKey -> PersistValue
(HashedApiKey -> PersistValue)
-> (PersistValue -> Either Text HashedApiKey)
-> PersistField HashedApiKey
forall a.
(a -> PersistValue)
-> (PersistValue -> Either Text a) -> PersistField a
$ctoPersistValue :: HashedApiKey -> PersistValue
toPersistValue :: HashedApiKey -> PersistValue
$cfromPersistValue :: PersistValue -> Either Text HashedApiKey
fromPersistValue :: PersistValue -> Either Text HashedApiKey
PersistField, PersistField HashedApiKey
Proxy HashedApiKey -> SqlType
PersistField HashedApiKey =>
(Proxy HashedApiKey -> SqlType) -> PersistFieldSql HashedApiKey
forall a.
PersistField a =>
(Proxy a -> SqlType) -> PersistFieldSql a
$csqlType :: Proxy HashedApiKey -> SqlType
sqlType :: Proxy HashedApiKey -> SqlType
PersistFieldSql, Maybe HashedApiKey
Value -> Parser [HashedApiKey]
Value -> Parser HashedApiKey
(Value -> Parser HashedApiKey)
-> (Value -> Parser [HashedApiKey])
-> Maybe HashedApiKey
-> FromJSON HashedApiKey
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser HashedApiKey
parseJSON :: Value -> Parser HashedApiKey
$cparseJSONList :: Value -> Parser [HashedApiKey]
parseJSONList :: Value -> Parser [HashedApiKey]
$comittedField :: Maybe HashedApiKey
omittedField :: Maybe HashedApiKey
A.FromJSON, [HashedApiKey] -> Value
[HashedApiKey] -> Encoding
HashedApiKey -> Bool
HashedApiKey -> Value
HashedApiKey -> Encoding
(HashedApiKey -> Value)
-> (HashedApiKey -> Encoding)
-> ([HashedApiKey] -> Value)
-> ([HashedApiKey] -> Encoding)
-> (HashedApiKey -> Bool)
-> ToJSON HashedApiKey
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: HashedApiKey -> Value
toJSON :: HashedApiKey -> Value
$ctoEncoding :: HashedApiKey -> Encoding
toEncoding :: HashedApiKey -> Encoding
$ctoJSONList :: [HashedApiKey] -> Value
toJSONList :: [HashedApiKey] -> Value
$ctoEncodingList :: [HashedApiKey] -> Encoding
toEncodingList :: [HashedApiKey] -> Encoding
$comitField :: HashedApiKey -> Bool
omitField :: HashedApiKey -> Bool
A.ToJSON)

generateApiKey :: IO ApiKey
generateApiKey :: IO ApiKey
generateApiKey = do
  ByteString
bytes <- Int -> IO ByteString
getEntropy Int
32
  ApiKey -> IO ApiKey
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApiKey -> IO ApiKey) -> ApiKey -> IO ApiKey
forall a b. (a -> b) -> a -> b
$ Text -> ApiKey
ApiKey (Text -> ApiKey) -> Text -> ApiKey
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
Base64Url.encodeBase64 ByteString
bytes

hashApiKey :: ApiKey -> HashedApiKey
hashApiKey :: ApiKey -> HashedApiKey
hashApiKey = Text -> HashedApiKey
HashedApiKey (Text -> HashedApiKey)
-> (ApiKey -> Text) -> ApiKey -> HashedApiKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> (ApiKey -> ByteString) -> ApiKey -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base64Url.encodeBase64' (ByteString -> ByteString)
-> (ApiKey -> ByteString) -> ApiKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
SHA256.hash (ByteString -> ByteString)
-> (ApiKey -> ByteString) -> ApiKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> (ApiKey -> Text) -> ApiKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiKey -> Text
unApiKey