module Web.Rails.Session.Types where

import Data.ByteString (ByteString)

-- TYPES

newtype Secret = Secret ByteString

-- | Wrapper around data after it has been decrypted.
newtype DecryptedData =
  DecryptedData ByteString
  deriving (Int -> DecryptedData -> ShowS
[DecryptedData] -> ShowS
DecryptedData -> String
(Int -> DecryptedData -> ShowS)
-> (DecryptedData -> String)
-> ([DecryptedData] -> ShowS)
-> Show DecryptedData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DecryptedData -> ShowS
showsPrec :: Int -> DecryptedData -> ShowS
$cshow :: DecryptedData -> String
show :: DecryptedData -> String
$cshowList :: [DecryptedData] -> ShowS
showList :: [DecryptedData] -> ShowS
Show, Eq DecryptedData
Eq DecryptedData =>
(DecryptedData -> DecryptedData -> Ordering)
-> (DecryptedData -> DecryptedData -> Bool)
-> (DecryptedData -> DecryptedData -> Bool)
-> (DecryptedData -> DecryptedData -> Bool)
-> (DecryptedData -> DecryptedData -> Bool)
-> (DecryptedData -> DecryptedData -> DecryptedData)
-> (DecryptedData -> DecryptedData -> DecryptedData)
-> Ord DecryptedData
DecryptedData -> DecryptedData -> Bool
DecryptedData -> DecryptedData -> Ordering
DecryptedData -> DecryptedData -> DecryptedData
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 :: DecryptedData -> DecryptedData -> Ordering
compare :: DecryptedData -> DecryptedData -> Ordering
$c< :: DecryptedData -> DecryptedData -> Bool
< :: DecryptedData -> DecryptedData -> Bool
$c<= :: DecryptedData -> DecryptedData -> Bool
<= :: DecryptedData -> DecryptedData -> Bool
$c> :: DecryptedData -> DecryptedData -> Bool
> :: DecryptedData -> DecryptedData -> Bool
$c>= :: DecryptedData -> DecryptedData -> Bool
>= :: DecryptedData -> DecryptedData -> Bool
$cmax :: DecryptedData -> DecryptedData -> DecryptedData
max :: DecryptedData -> DecryptedData -> DecryptedData
$cmin :: DecryptedData -> DecryptedData -> DecryptedData
min :: DecryptedData -> DecryptedData -> DecryptedData
Ord, DecryptedData -> DecryptedData -> Bool
(DecryptedData -> DecryptedData -> Bool)
-> (DecryptedData -> DecryptedData -> Bool) -> Eq DecryptedData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DecryptedData -> DecryptedData -> Bool
== :: DecryptedData -> DecryptedData -> Bool
$c/= :: DecryptedData -> DecryptedData -> Bool
/= :: DecryptedData -> DecryptedData -> Bool
Eq)

-- | Wrapper around data before it has been decrypted.
newtype EncryptedData =
  EncryptedData ByteString
  deriving (Int -> EncryptedData -> ShowS
[EncryptedData] -> ShowS
EncryptedData -> String
(Int -> EncryptedData -> ShowS)
-> (EncryptedData -> String)
-> ([EncryptedData] -> ShowS)
-> Show EncryptedData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EncryptedData -> ShowS
showsPrec :: Int -> EncryptedData -> ShowS
$cshow :: EncryptedData -> String
show :: EncryptedData -> String
$cshowList :: [EncryptedData] -> ShowS
showList :: [EncryptedData] -> ShowS
Show, Eq EncryptedData
Eq EncryptedData =>
(EncryptedData -> EncryptedData -> Ordering)
-> (EncryptedData -> EncryptedData -> Bool)
-> (EncryptedData -> EncryptedData -> Bool)
-> (EncryptedData -> EncryptedData -> Bool)
-> (EncryptedData -> EncryptedData -> Bool)
-> (EncryptedData -> EncryptedData -> EncryptedData)
-> (EncryptedData -> EncryptedData -> EncryptedData)
-> Ord EncryptedData
EncryptedData -> EncryptedData -> Bool
EncryptedData -> EncryptedData -> Ordering
EncryptedData -> EncryptedData -> EncryptedData
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 :: EncryptedData -> EncryptedData -> Ordering
compare :: EncryptedData -> EncryptedData -> Ordering
$c< :: EncryptedData -> EncryptedData -> Bool
< :: EncryptedData -> EncryptedData -> Bool
$c<= :: EncryptedData -> EncryptedData -> Bool
<= :: EncryptedData -> EncryptedData -> Bool
$c> :: EncryptedData -> EncryptedData -> Bool
> :: EncryptedData -> EncryptedData -> Bool
$c>= :: EncryptedData -> EncryptedData -> Bool
>= :: EncryptedData -> EncryptedData -> Bool
$cmax :: EncryptedData -> EncryptedData -> EncryptedData
max :: EncryptedData -> EncryptedData -> EncryptedData
$cmin :: EncryptedData -> EncryptedData -> EncryptedData
min :: EncryptedData -> EncryptedData -> EncryptedData
Ord, EncryptedData -> EncryptedData -> Bool
(EncryptedData -> EncryptedData -> Bool)
-> (EncryptedData -> EncryptedData -> Bool) -> Eq EncryptedData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EncryptedData -> EncryptedData -> Bool
== :: EncryptedData -> EncryptedData -> Bool
$c/= :: EncryptedData -> EncryptedData -> Bool
/= :: EncryptedData -> EncryptedData -> Bool
Eq)

-- | Wrapper around initialisation vector.
newtype InitVector =
  InitVector ByteString
  deriving (Int -> InitVector -> ShowS
[InitVector] -> ShowS
InitVector -> String
(Int -> InitVector -> ShowS)
-> (InitVector -> String)
-> ([InitVector] -> ShowS)
-> Show InitVector
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InitVector -> ShowS
showsPrec :: Int -> InitVector -> ShowS
$cshow :: InitVector -> String
show :: InitVector -> String
$cshowList :: [InitVector] -> ShowS
showList :: [InitVector] -> ShowS
Show, Eq InitVector
Eq InitVector =>
(InitVector -> InitVector -> Ordering)
-> (InitVector -> InitVector -> Bool)
-> (InitVector -> InitVector -> Bool)
-> (InitVector -> InitVector -> Bool)
-> (InitVector -> InitVector -> Bool)
-> (InitVector -> InitVector -> InitVector)
-> (InitVector -> InitVector -> InitVector)
-> Ord InitVector
InitVector -> InitVector -> Bool
InitVector -> InitVector -> Ordering
InitVector -> InitVector -> InitVector
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 :: InitVector -> InitVector -> Ordering
compare :: InitVector -> InitVector -> Ordering
$c< :: InitVector -> InitVector -> Bool
< :: InitVector -> InitVector -> Bool
$c<= :: InitVector -> InitVector -> Bool
<= :: InitVector -> InitVector -> Bool
$c> :: InitVector -> InitVector -> Bool
> :: InitVector -> InitVector -> Bool
$c>= :: InitVector -> InitVector -> Bool
>= :: InitVector -> InitVector -> Bool
$cmax :: InitVector -> InitVector -> InitVector
max :: InitVector -> InitVector -> InitVector
$cmin :: InitVector -> InitVector -> InitVector
min :: InitVector -> InitVector -> InitVector
Ord, InitVector -> InitVector -> Bool
(InitVector -> InitVector -> Bool)
-> (InitVector -> InitVector -> Bool) -> Eq InitVector
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InitVector -> InitVector -> Bool
== :: InitVector -> InitVector -> Bool
$c/= :: InitVector -> InitVector -> Bool
/= :: InitVector -> InitVector -> Bool
Eq)

-- | Wrapper around raw cookie.
newtype Cookie =
  Cookie ByteString
  deriving (Int -> Cookie -> ShowS
[Cookie] -> ShowS
Cookie -> String
(Int -> Cookie -> ShowS)
-> (Cookie -> String) -> ([Cookie] -> ShowS) -> Show Cookie
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cookie -> ShowS
showsPrec :: Int -> Cookie -> ShowS
$cshow :: Cookie -> String
show :: Cookie -> String
$cshowList :: [Cookie] -> ShowS
showList :: [Cookie] -> ShowS
Show, Eq Cookie
Eq Cookie =>
(Cookie -> Cookie -> Ordering)
-> (Cookie -> Cookie -> Bool)
-> (Cookie -> Cookie -> Bool)
-> (Cookie -> Cookie -> Bool)
-> (Cookie -> Cookie -> Bool)
-> (Cookie -> Cookie -> Cookie)
-> (Cookie -> Cookie -> Cookie)
-> Ord Cookie
Cookie -> Cookie -> Bool
Cookie -> Cookie -> Ordering
Cookie -> Cookie -> Cookie
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 :: Cookie -> Cookie -> Ordering
compare :: Cookie -> Cookie -> Ordering
$c< :: Cookie -> Cookie -> Bool
< :: Cookie -> Cookie -> Bool
$c<= :: Cookie -> Cookie -> Bool
<= :: Cookie -> Cookie -> Bool
$c> :: Cookie -> Cookie -> Bool
> :: Cookie -> Cookie -> Bool
$c>= :: Cookie -> Cookie -> Bool
>= :: Cookie -> Cookie -> Bool
$cmax :: Cookie -> Cookie -> Cookie
max :: Cookie -> Cookie -> Cookie
$cmin :: Cookie -> Cookie -> Cookie
min :: Cookie -> Cookie -> Cookie
Ord, Cookie -> Cookie -> Bool
(Cookie -> Cookie -> Bool)
-> (Cookie -> Cookie -> Bool) -> Eq Cookie
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cookie -> Cookie -> Bool
== :: Cookie -> Cookie -> Bool
$c/= :: Cookie -> Cookie -> Bool
/= :: Cookie -> Cookie -> Bool
Eq)

-- | Wrapper around salt.
newtype Salt =
  Salt ByteString
  deriving (Int -> Salt -> ShowS
[Salt] -> ShowS
Salt -> String
(Int -> Salt -> ShowS)
-> (Salt -> String) -> ([Salt] -> ShowS) -> Show Salt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Salt -> ShowS
showsPrec :: Int -> Salt -> ShowS
$cshow :: Salt -> String
show :: Salt -> String
$cshowList :: [Salt] -> ShowS
showList :: [Salt] -> ShowS
Show, Eq Salt
Eq Salt =>
(Salt -> Salt -> Ordering)
-> (Salt -> Salt -> Bool)
-> (Salt -> Salt -> Bool)
-> (Salt -> Salt -> Bool)
-> (Salt -> Salt -> Bool)
-> (Salt -> Salt -> Salt)
-> (Salt -> Salt -> Salt)
-> Ord Salt
Salt -> Salt -> Bool
Salt -> Salt -> Ordering
Salt -> Salt -> Salt
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 :: Salt -> Salt -> Ordering
compare :: Salt -> Salt -> Ordering
$c< :: Salt -> Salt -> Bool
< :: Salt -> Salt -> Bool
$c<= :: Salt -> Salt -> Bool
<= :: Salt -> Salt -> Bool
$c> :: Salt -> Salt -> Bool
> :: Salt -> Salt -> Bool
$c>= :: Salt -> Salt -> Bool
>= :: Salt -> Salt -> Bool
$cmax :: Salt -> Salt -> Salt
max :: Salt -> Salt -> Salt
$cmin :: Salt -> Salt -> Salt
min :: Salt -> Salt -> Salt
Ord, Salt -> Salt -> Bool
(Salt -> Salt -> Bool) -> (Salt -> Salt -> Bool) -> Eq Salt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Salt -> Salt -> Bool
== :: Salt -> Salt -> Bool
$c/= :: Salt -> Salt -> Bool
/= :: Salt -> Salt -> Bool
Eq)

-- | Wrapper around secret.
newtype SecretKey =
  SecretKey ByteString
  deriving (Int -> SecretKey -> ShowS
[SecretKey] -> ShowS
SecretKey -> String
(Int -> SecretKey -> ShowS)
-> (SecretKey -> String)
-> ([SecretKey] -> ShowS)
-> Show SecretKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SecretKey -> ShowS
showsPrec :: Int -> SecretKey -> ShowS
$cshow :: SecretKey -> String
show :: SecretKey -> String
$cshowList :: [SecretKey] -> ShowS
showList :: [SecretKey] -> ShowS
Show, Eq SecretKey
Eq SecretKey =>
(SecretKey -> SecretKey -> Ordering)
-> (SecretKey -> SecretKey -> Bool)
-> (SecretKey -> SecretKey -> Bool)
-> (SecretKey -> SecretKey -> Bool)
-> (SecretKey -> SecretKey -> Bool)
-> (SecretKey -> SecretKey -> SecretKey)
-> (SecretKey -> SecretKey -> SecretKey)
-> Ord SecretKey
SecretKey -> SecretKey -> Bool
SecretKey -> SecretKey -> Ordering
SecretKey -> SecretKey -> SecretKey
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 :: SecretKey -> SecretKey -> Ordering
compare :: SecretKey -> SecretKey -> Ordering
$c< :: SecretKey -> SecretKey -> Bool
< :: SecretKey -> SecretKey -> Bool
$c<= :: SecretKey -> SecretKey -> Bool
<= :: SecretKey -> SecretKey -> Bool
$c> :: SecretKey -> SecretKey -> Bool
> :: SecretKey -> SecretKey -> Bool
$c>= :: SecretKey -> SecretKey -> Bool
>= :: SecretKey -> SecretKey -> Bool
$cmax :: SecretKey -> SecretKey -> SecretKey
max :: SecretKey -> SecretKey -> SecretKey
$cmin :: SecretKey -> SecretKey -> SecretKey
min :: SecretKey -> SecretKey -> SecretKey
Ord, SecretKey -> SecretKey -> Bool
(SecretKey -> SecretKey -> Bool)
-> (SecretKey -> SecretKey -> Bool) -> Eq SecretKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SecretKey -> SecretKey -> Bool
== :: SecretKey -> SecretKey -> Bool
$c/= :: SecretKey -> SecretKey -> Bool
/= :: SecretKey -> SecretKey -> Bool
Eq)

-- | Wrapper around secret key base.
newtype SecretKeyBase =
  SecretKeyBase ByteString
  deriving (Int -> SecretKeyBase -> ShowS
[SecretKeyBase] -> ShowS
SecretKeyBase -> String
(Int -> SecretKeyBase -> ShowS)
-> (SecretKeyBase -> String)
-> ([SecretKeyBase] -> ShowS)
-> Show SecretKeyBase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SecretKeyBase -> ShowS
showsPrec :: Int -> SecretKeyBase -> ShowS
$cshow :: SecretKeyBase -> String
show :: SecretKeyBase -> String
$cshowList :: [SecretKeyBase] -> ShowS
showList :: [SecretKeyBase] -> ShowS
Show, Eq SecretKeyBase
Eq SecretKeyBase =>
(SecretKeyBase -> SecretKeyBase -> Ordering)
-> (SecretKeyBase -> SecretKeyBase -> Bool)
-> (SecretKeyBase -> SecretKeyBase -> Bool)
-> (SecretKeyBase -> SecretKeyBase -> Bool)
-> (SecretKeyBase -> SecretKeyBase -> Bool)
-> (SecretKeyBase -> SecretKeyBase -> SecretKeyBase)
-> (SecretKeyBase -> SecretKeyBase -> SecretKeyBase)
-> Ord SecretKeyBase
SecretKeyBase -> SecretKeyBase -> Bool
SecretKeyBase -> SecretKeyBase -> Ordering
SecretKeyBase -> SecretKeyBase -> SecretKeyBase
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 :: SecretKeyBase -> SecretKeyBase -> Ordering
compare :: SecretKeyBase -> SecretKeyBase -> Ordering
$c< :: SecretKeyBase -> SecretKeyBase -> Bool
< :: SecretKeyBase -> SecretKeyBase -> Bool
$c<= :: SecretKeyBase -> SecretKeyBase -> Bool
<= :: SecretKeyBase -> SecretKeyBase -> Bool
$c> :: SecretKeyBase -> SecretKeyBase -> Bool
> :: SecretKeyBase -> SecretKeyBase -> Bool
$c>= :: SecretKeyBase -> SecretKeyBase -> Bool
>= :: SecretKeyBase -> SecretKeyBase -> Bool
$cmax :: SecretKeyBase -> SecretKeyBase -> SecretKeyBase
max :: SecretKeyBase -> SecretKeyBase -> SecretKeyBase
$cmin :: SecretKeyBase -> SecretKeyBase -> SecretKeyBase
min :: SecretKeyBase -> SecretKeyBase -> SecretKeyBase
Ord, SecretKeyBase -> SecretKeyBase -> Bool
(SecretKeyBase -> SecretKeyBase -> Bool)
-> (SecretKeyBase -> SecretKeyBase -> Bool) -> Eq SecretKeyBase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SecretKeyBase -> SecretKeyBase -> Bool
== :: SecretKeyBase -> SecretKeyBase -> Bool
$c/= :: SecretKeyBase -> SecretKeyBase -> Bool
/= :: SecretKeyBase -> SecretKeyBase -> Bool
Eq)

-- SMART CONSTRUCTORS

-- | Lift a cookie into a richer type.
mkCookie :: ByteString -> Cookie
mkCookie :: ByteString -> Cookie
mkCookie = ByteString -> Cookie
Cookie

-- | Lift salt into a richer type.
mkSalt :: ByteString -> Salt
mkSalt :: ByteString -> Salt
mkSalt = ByteString -> Salt
Salt

-- | Lifts secret into a richer type.
mkSecretKeyBase :: ByteString -> SecretKeyBase
mkSecretKeyBase :: ByteString -> SecretKeyBase
mkSecretKeyBase = ByteString -> SecretKeyBase
SecretKeyBase

-- SMART DESTRUCTORS

unwrapDecryptedData :: DecryptedData -> ByteString
unwrapDecryptedData :: DecryptedData -> ByteString
unwrapDecryptedData (DecryptedData ByteString
deData) =
  ByteString
deData