-- | Internal module exposing the guts of the package.  Use at
-- your own risk.  No API stability guarantees apply.
module Web.ServerSession.Backend.Persistent.Internal.Impl
  ( PersistentSession(..)
  , PersistentSessionId
  , EntityField(..)
  , serverSessionDefsBySessionMap
  , PersistentSessionBySessionMap
  , mkServerSessionDefs
  , psKey
  , toPersistentSession
  , fromPersistentSession
  , SqlStorage(..)
  , throwSS
  ) where

import Control.Applicative as A
import Control.Monad (void)
import Control.Monad.IO.Class (liftIO)
import Data.Proxy (Proxy(..))
import Data.Time (UTCTime)
import Data.Typeable (Typeable)
import Database.Persist (PersistEntity(..))
import Web.PathPieces (PathPiece)
import Web.ServerSession.Core

import qualified Control.Exception as E
import qualified Data.Aeson as A
import qualified Data.Text as T
import qualified Database.Persist as P
import qualified Database.Persist.EntityDef.Internal as P (EntityDef(..)) -- I need EntityDef constructor.
import qualified Database.Persist.Quasi.Internal as P (UnboundEntityDef, unbindEntityDef)
import qualified Database.Persist.Sql as P

import Web.ServerSession.Backend.Persistent.Internal.Types

-- We can't use the Template Haskell since we want to generalize
-- some fields.
--
-- This is going to be a pain to upgrade when the next major
-- persistent version comes :(.

-- | Entity corresponding to a 'Session'.
--
-- We're bending @persistent@ in ways it wasn't expected to.  In
-- particular, this entity is parametrized over the session type.
data PersistentSession sess =
  PersistentSession
    { PersistentSession sess -> SessionId sess
persistentSessionKey        :: !(SessionId sess)    -- ^ Session ID, primary key.
    , PersistentSession sess -> Maybe ByteStringJ
persistentSessionAuthId     :: !(Maybe ByteStringJ) -- ^ Value of "_ID" session key.
    , PersistentSession sess -> Decomposed sess
persistentSessionSession    :: !(Decomposed sess)   -- ^ Rest of the session data.
    , PersistentSession sess -> UTCTime
persistentSessionCreatedAt  :: !UTCTime             -- ^ When this session was created.
    , PersistentSession sess -> UTCTime
persistentSessionAccessedAt :: !UTCTime             -- ^ When this session was last accessed.
    } deriving (Typeable)

deriving instance Eq   (Decomposed sess) => Eq   (PersistentSession sess)
deriving instance Ord  (Decomposed sess) => Ord  (PersistentSession sess)
deriving instance Show (Decomposed sess) => Show (PersistentSession sess)


type PersistentSessionId sess = Key (PersistentSession sess)

instance forall sess. P.PersistFieldSql (Decomposed sess) => P.PersistEntity (PersistentSession sess) where
  type PersistEntityBackend (PersistentSession sess) = P.SqlBackend

  data Unique (PersistentSession sess)

  newtype Key (PersistentSession sess) =
    PersistentSessionKey' {Key (PersistentSession sess) -> SessionId sess
unPersistentSessionKey :: SessionId sess}
    deriving ( Key (PersistentSession sess)
-> Key (PersistentSession sess) -> Bool
(Key (PersistentSession sess)
 -> Key (PersistentSession sess) -> Bool)
-> (Key (PersistentSession sess)
    -> Key (PersistentSession sess) -> Bool)
-> Eq (Key (PersistentSession sess))
forall sess.
Key (PersistentSession sess)
-> Key (PersistentSession sess) -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Key (PersistentSession sess)
-> Key (PersistentSession sess) -> Bool
$c/= :: forall sess.
Key (PersistentSession sess)
-> Key (PersistentSession sess) -> Bool
== :: Key (PersistentSession sess)
-> Key (PersistentSession sess) -> Bool
$c== :: forall sess.
Key (PersistentSession sess)
-> Key (PersistentSession sess) -> Bool
Eq, Eq (Key (PersistentSession sess))
Eq (Key (PersistentSession sess))
-> (Key (PersistentSession sess)
    -> Key (PersistentSession sess) -> Ordering)
-> (Key (PersistentSession sess)
    -> Key (PersistentSession sess) -> Bool)
-> (Key (PersistentSession sess)
    -> Key (PersistentSession sess) -> Bool)
-> (Key (PersistentSession sess)
    -> Key (PersistentSession sess) -> Bool)
-> (Key (PersistentSession sess)
    -> Key (PersistentSession sess) -> Bool)
-> (Key (PersistentSession sess)
    -> Key (PersistentSession sess) -> Key (PersistentSession sess))
-> (Key (PersistentSession sess)
    -> Key (PersistentSession sess) -> Key (PersistentSession sess))
-> Ord (Key (PersistentSession sess))
Key (PersistentSession sess)
-> Key (PersistentSession sess) -> Bool
Key (PersistentSession sess)
-> Key (PersistentSession sess) -> Ordering
Key (PersistentSession sess)
-> Key (PersistentSession sess) -> Key (PersistentSession sess)
forall sess. Eq (Key (PersistentSession sess))
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
forall sess.
Key (PersistentSession sess)
-> Key (PersistentSession sess) -> Bool
forall sess.
Key (PersistentSession sess)
-> Key (PersistentSession sess) -> Ordering
forall sess.
Key (PersistentSession sess)
-> Key (PersistentSession sess) -> Key (PersistentSession sess)
min :: Key (PersistentSession sess)
-> Key (PersistentSession sess) -> Key (PersistentSession sess)
$cmin :: forall sess.
Key (PersistentSession sess)
-> Key (PersistentSession sess) -> Key (PersistentSession sess)
max :: Key (PersistentSession sess)
-> Key (PersistentSession sess) -> Key (PersistentSession sess)
$cmax :: forall sess.
Key (PersistentSession sess)
-> Key (PersistentSession sess) -> Key (PersistentSession sess)
>= :: Key (PersistentSession sess)
-> Key (PersistentSession sess) -> Bool
$c>= :: forall sess.
Key (PersistentSession sess)
-> Key (PersistentSession sess) -> Bool
> :: Key (PersistentSession sess)
-> Key (PersistentSession sess) -> Bool
$c> :: forall sess.
Key (PersistentSession sess)
-> Key (PersistentSession sess) -> Bool
<= :: Key (PersistentSession sess)
-> Key (PersistentSession sess) -> Bool
$c<= :: forall sess.
Key (PersistentSession sess)
-> Key (PersistentSession sess) -> Bool
< :: Key (PersistentSession sess)
-> Key (PersistentSession sess) -> Bool
$c< :: forall sess.
Key (PersistentSession sess)
-> Key (PersistentSession sess) -> Bool
compare :: Key (PersistentSession sess)
-> Key (PersistentSession sess) -> Ordering
$ccompare :: forall sess.
Key (PersistentSession sess)
-> Key (PersistentSession sess) -> Ordering
$cp1Ord :: forall sess. Eq (Key (PersistentSession sess))
Ord, Int -> Key (PersistentSession sess) -> ShowS
[Key (PersistentSession sess)] -> ShowS
Key (PersistentSession sess) -> String
(Int -> Key (PersistentSession sess) -> ShowS)
-> (Key (PersistentSession sess) -> String)
-> ([Key (PersistentSession sess)] -> ShowS)
-> Show (Key (PersistentSession sess))
forall sess. Int -> Key (PersistentSession sess) -> ShowS
forall sess. [Key (PersistentSession sess)] -> ShowS
forall sess. Key (PersistentSession sess) -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Key (PersistentSession sess)] -> ShowS
$cshowList :: forall sess. [Key (PersistentSession sess)] -> ShowS
show :: Key (PersistentSession sess) -> String
$cshow :: forall sess. Key (PersistentSession sess) -> String
showsPrec :: Int -> Key (PersistentSession sess) -> ShowS
$cshowsPrec :: forall sess. Int -> Key (PersistentSession sess) -> ShowS
Show, ReadPrec [Key (PersistentSession sess)]
ReadPrec (Key (PersistentSession sess))
Int -> ReadS (Key (PersistentSession sess))
ReadS [Key (PersistentSession sess)]
(Int -> ReadS (Key (PersistentSession sess)))
-> ReadS [Key (PersistentSession sess)]
-> ReadPrec (Key (PersistentSession sess))
-> ReadPrec [Key (PersistentSession sess)]
-> Read (Key (PersistentSession sess))
forall sess. ReadPrec [Key (PersistentSession sess)]
forall sess. ReadPrec (Key (PersistentSession sess))
forall sess. Int -> ReadS (Key (PersistentSession sess))
forall sess. ReadS [Key (PersistentSession sess)]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Key (PersistentSession sess)]
$creadListPrec :: forall sess. ReadPrec [Key (PersistentSession sess)]
readPrec :: ReadPrec (Key (PersistentSession sess))
$creadPrec :: forall sess. ReadPrec (Key (PersistentSession sess))
readList :: ReadS [Key (PersistentSession sess)]
$creadList :: forall sess. ReadS [Key (PersistentSession sess)]
readsPrec :: Int -> ReadS (Key (PersistentSession sess))
$creadsPrec :: forall sess. Int -> ReadS (Key (PersistentSession sess))
Read, Text -> Maybe (Key (PersistentSession sess))
Key (PersistentSession sess) -> Text
(Text -> Maybe (Key (PersistentSession sess)))
-> (Key (PersistentSession sess) -> Text)
-> PathPiece (Key (PersistentSession sess))
forall sess. Text -> Maybe (Key (PersistentSession sess))
forall sess. Key (PersistentSession sess) -> Text
forall s. (Text -> Maybe s) -> (s -> Text) -> PathPiece s
toPathPiece :: Key (PersistentSession sess) -> Text
$ctoPathPiece :: forall sess. Key (PersistentSession sess) -> Text
fromPathPiece :: Text -> Maybe (Key (PersistentSession sess))
$cfromPathPiece :: forall sess. Text -> Maybe (Key (PersistentSession sess))
PathPiece
             , Key (PersistentSession sess) -> PersistValue
PersistValue -> Either Text (Key (PersistentSession sess))
(Key (PersistentSession sess) -> PersistValue)
-> (PersistValue -> Either Text (Key (PersistentSession sess)))
-> PersistField (Key (PersistentSession sess))
forall sess. Key (PersistentSession sess) -> PersistValue
forall sess.
PersistValue -> Either Text (Key (PersistentSession sess))
forall a.
(a -> PersistValue)
-> (PersistValue -> Either Text a) -> PersistField a
fromPersistValue :: PersistValue -> Either Text (Key (PersistentSession sess))
$cfromPersistValue :: forall sess.
PersistValue -> Either Text (Key (PersistentSession sess))
toPersistValue :: Key (PersistentSession sess) -> PersistValue
$ctoPersistValue :: forall sess. Key (PersistentSession sess) -> PersistValue
P.PersistField, PersistField (Key (PersistentSession sess))
Proxy (Key (PersistentSession sess)) -> SqlType
PersistField (Key (PersistentSession sess))
-> (Proxy (Key (PersistentSession sess)) -> SqlType)
-> PersistFieldSql (Key (PersistentSession sess))
forall sess. PersistField (Key (PersistentSession sess))
forall sess. Proxy (Key (PersistentSession sess)) -> SqlType
forall a.
PersistField a -> (Proxy a -> SqlType) -> PersistFieldSql a
sqlType :: Proxy (Key (PersistentSession sess)) -> SqlType
$csqlType :: forall sess. Proxy (Key (PersistentSession sess)) -> SqlType
$cp1PersistFieldSql :: forall sess. PersistField (Key (PersistentSession sess))
P.PersistFieldSql, [Key (PersistentSession sess)] -> Encoding
[Key (PersistentSession sess)] -> Value
Key (PersistentSession sess) -> Encoding
Key (PersistentSession sess) -> Value
(Key (PersistentSession sess) -> Value)
-> (Key (PersistentSession sess) -> Encoding)
-> ([Key (PersistentSession sess)] -> Value)
-> ([Key (PersistentSession sess)] -> Encoding)
-> ToJSON (Key (PersistentSession sess))
forall sess. [Key (PersistentSession sess)] -> Encoding
forall sess. [Key (PersistentSession sess)] -> Value
forall sess. Key (PersistentSession sess) -> Encoding
forall sess. Key (PersistentSession sess) -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Key (PersistentSession sess)] -> Encoding
$ctoEncodingList :: forall sess. [Key (PersistentSession sess)] -> Encoding
toJSONList :: [Key (PersistentSession sess)] -> Value
$ctoJSONList :: forall sess. [Key (PersistentSession sess)] -> Value
toEncoding :: Key (PersistentSession sess) -> Encoding
$ctoEncoding :: forall sess. Key (PersistentSession sess) -> Encoding
toJSON :: Key (PersistentSession sess) -> Value
$ctoJSON :: forall sess. Key (PersistentSession sess) -> Value
A.ToJSON, Value -> Parser [Key (PersistentSession sess)]
Value -> Parser (Key (PersistentSession sess))
(Value -> Parser (Key (PersistentSession sess)))
-> (Value -> Parser [Key (PersistentSession sess)])
-> FromJSON (Key (PersistentSession sess))
forall sess. Value -> Parser [Key (PersistentSession sess)]
forall sess. Value -> Parser (Key (PersistentSession sess))
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Key (PersistentSession sess)]
$cparseJSONList :: forall sess. Value -> Parser [Key (PersistentSession sess)]
parseJSON :: Value -> Parser (Key (PersistentSession sess))
$cparseJSON :: forall sess. Value -> Parser (Key (PersistentSession sess))
A.FromJSON )

  data EntityField (PersistentSession sess) typ
    = typ ~ PersistentSessionId sess => PersistentSessionId
    | typ ~ SessionId sess           => PersistentSessionKey
    | typ ~ Maybe ByteStringJ        => PersistentSessionAuthId
    | typ ~ Decomposed sess          => PersistentSessionSession
    | typ ~ UTCTime                  => PersistentSessionCreatedAt
    | typ ~ UTCTime                  => PersistentSessionAccessedAt

  keyToValues :: Key (PersistentSession sess) -> [PersistValue]
keyToValues = (PersistValue -> [PersistValue] -> [PersistValue]
forall a. a -> [a] -> [a]
:[]) (PersistValue -> [PersistValue])
-> (Key (PersistentSession sess) -> PersistValue)
-> Key (PersistentSession sess)
-> [PersistValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionId sess -> PersistValue
forall a. PersistField a => a -> PersistValue
P.toPersistValue (SessionId sess -> PersistValue)
-> (Key (PersistentSession sess) -> SessionId sess)
-> Key (PersistentSession sess)
-> PersistValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key (PersistentSession sess) -> SessionId sess
forall sess. Key (PersistentSession sess) -> SessionId sess
unPersistentSessionKey
  keyFromValues :: [PersistValue] -> Either Text (Key (PersistentSession sess))
keyFromValues [PersistValue
x] | Right SessionId sess
v <- PersistValue -> Either Text (SessionId sess)
forall a. PersistField a => PersistValue -> Either Text a
P.fromPersistValue PersistValue
x = Key (PersistentSession sess)
-> Either Text (Key (PersistentSession sess))
forall a b. b -> Either a b
Right (Key (PersistentSession sess)
 -> Either Text (Key (PersistentSession sess)))
-> Key (PersistentSession sess)
-> Either Text (Key (PersistentSession sess))
forall a b. (a -> b) -> a -> b
$ SessionId sess -> Key (PersistentSession sess)
forall sess. SessionId sess -> Key (PersistentSession sess)
PersistentSessionKey' SessionId sess
v
  keyFromValues [PersistValue]
xs  = Text -> Either Text (Key (PersistentSession sess))
forall a b. a -> Either a b
Left (Text -> Either Text (Key (PersistentSession sess)))
-> Text -> Either Text (Key (PersistentSession sess))
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"PersistentSession/keyFromValues: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [PersistValue] -> String
forall a. Show a => a -> String
show [PersistValue]
xs

  entityDef :: proxy (PersistentSession sess) -> EntityDef
entityDef proxy (PersistentSession sess)
_
    = EntityDef :: EntityNameHS
-> EntityNameDB
-> EntityIdDef
-> [Text]
-> [FieldDef]
-> [UniqueDef]
-> [ForeignDef]
-> [Text]
-> Map Text [[Text]]
-> Bool
-> Maybe Text
-> EntityDef
P.EntityDef
    { entityHaskell :: EntityNameHS
entityHaskell = Text -> EntityNameHS
P.EntityNameHS Text
"PersistentSession" -- it's dummy.
    , entityDB :: EntityNameDB
entityDB = Text -> EntityNameDB
P.EntityNameDB Text
"persistent_session"
      -- Since backend is not only persistent, we use the natural key here.
    , entityId :: EntityIdDef
entityId = CompositeDef -> EntityIdDef
P.EntityIdNaturalKey (CompositeDef -> EntityIdDef) -> CompositeDef -> EntityIdDef
forall a b. (a -> b) -> a -> b
$ NonEmpty FieldDef -> [Text] -> CompositeDef
P.CompositeDef (FieldDef -> NonEmpty FieldDef
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldDef -> NonEmpty FieldDef) -> FieldDef -> NonEmpty FieldDef
forall a b. (a -> b) -> a -> b
$ EntityField (PersistentSession sess) (SessionId sess) -> FieldDef
forall typ. EntityField (PersistentSession sess) typ -> FieldDef
pfd EntityField (PersistentSession sess) (SessionId sess)
forall sess typ.
(typ ~ SessionId sess) =>
EntityField (PersistentSession sess) typ
PersistentSessionKey) []
    , entityAttrs :: [Text]
entityAttrs = [Text
"json"]
    , entityFields :: [FieldDef]
entityFields =
      [ EntityField (PersistentSession sess) (SessionId sess) -> FieldDef
forall typ. EntityField (PersistentSession sess) typ -> FieldDef
pfd EntityField (PersistentSession sess) (SessionId sess)
forall sess typ.
(typ ~ SessionId sess) =>
EntityField (PersistentSession sess) typ
PersistentSessionKey
      , EntityField (PersistentSession sess) (Maybe ByteStringJ)
-> FieldDef
forall typ. EntityField (PersistentSession sess) typ -> FieldDef
pfd EntityField (PersistentSession sess) (Maybe ByteStringJ)
forall sess typ.
(typ ~ Maybe ByteStringJ) =>
EntityField (PersistentSession sess) typ
PersistentSessionAuthId
      , EntityField (PersistentSession sess) (Decomposed sess) -> FieldDef
forall typ. EntityField (PersistentSession sess) typ -> FieldDef
pfd EntityField (PersistentSession sess) (Decomposed sess)
forall sess typ.
(typ ~ Decomposed sess) =>
EntityField (PersistentSession sess) typ
PersistentSessionSession
      , EntityField (PersistentSession sess) UTCTime -> FieldDef
forall typ. EntityField (PersistentSession sess) typ -> FieldDef
pfd EntityField (PersistentSession sess) UTCTime
forall sess typ.
(typ ~ UTCTime) =>
EntityField (PersistentSession sess) typ
PersistentSessionCreatedAt
      , EntityField (PersistentSession sess) UTCTime -> FieldDef
forall typ. EntityField (PersistentSession sess) typ -> FieldDef
pfd EntityField (PersistentSession sess) UTCTime
forall sess typ.
(typ ~ UTCTime) =>
EntityField (PersistentSession sess) typ
PersistentSessionAccessedAt ]
    , entityUniques :: [UniqueDef]
entityUniques = []
    , entityForeigns :: [ForeignDef]
entityForeigns = []
    , entityDerives :: [Text]
entityDerives = [Text
"Eq", Text
"Ord", Text
"Show", Text
"Typeable"]
    , entityExtra :: Map Text [[Text]]
entityExtra = Map Text [[Text]]
forall a. Monoid a => a
mempty
    , entitySum :: Bool
entitySum = Bool
False
    , entityComments :: Maybe Text
entityComments = Maybe Text
forall a. Maybe a
Nothing
    }
    where pfd :: P.EntityField (PersistentSession sess) typ -> P.FieldDef
          pfd :: EntityField (PersistentSession sess) typ -> FieldDef
pfd = EntityField (PersistentSession sess) typ -> FieldDef
forall record typ.
PersistEntity record =>
EntityField record typ -> FieldDef
P.persistFieldDef

  toPersistFields :: PersistentSession sess -> [SomePersistField]
toPersistFields (PersistentSession SessionId sess
a Maybe ByteStringJ
b Decomposed sess
c UTCTime
d UTCTime
e) =
    [ SessionId sess -> SomePersistField
forall a. PersistField a => a -> SomePersistField
P.SomePersistField SessionId sess
a
    , Maybe ByteStringJ -> SomePersistField
forall a. PersistField a => a -> SomePersistField
P.SomePersistField Maybe ByteStringJ
b
    , Decomposed sess -> SomePersistField
forall a. PersistField a => a -> SomePersistField
P.SomePersistField Decomposed sess
c
    , UTCTime -> SomePersistField
forall a. PersistField a => a -> SomePersistField
P.SomePersistField UTCTime
d
    , UTCTime -> SomePersistField
forall a. PersistField a => a -> SomePersistField
P.SomePersistField UTCTime
e ]

  fromPersistValues :: [PersistValue] -> Either Text (PersistentSession sess)
fromPersistValues [PersistValue
a, PersistValue
b, PersistValue
c, PersistValue
d, PersistValue
e] =
    SessionId sess
-> Maybe ByteStringJ
-> Decomposed sess
-> UTCTime
-> UTCTime
-> PersistentSession sess
forall sess.
SessionId sess
-> Maybe ByteStringJ
-> Decomposed sess
-> UTCTime
-> UTCTime
-> PersistentSession sess
PersistentSession
      (SessionId sess
 -> Maybe ByteStringJ
 -> Decomposed sess
 -> UTCTime
 -> UTCTime
 -> PersistentSession sess)
-> Either Text (SessionId sess)
-> Either
     Text
     (Maybe ByteStringJ
      -> Decomposed sess -> UTCTime -> UTCTime -> PersistentSession sess)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
A.<$> Text
-> Either Text (SessionId sess) -> Either Text (SessionId sess)
forall a. Text -> Either Text a -> Either Text a
err Text
"key"      (PersistValue -> Either Text (SessionId sess)
forall a. PersistField a => PersistValue -> Either Text a
P.fromPersistValue PersistValue
a)
      Either
  Text
  (Maybe ByteStringJ
   -> Decomposed sess -> UTCTime -> UTCTime -> PersistentSession sess)
-> Either Text (Maybe ByteStringJ)
-> Either
     Text
     (Decomposed sess -> UTCTime -> UTCTime -> PersistentSession sess)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Either Text (Maybe ByteStringJ)
-> Either Text (Maybe ByteStringJ)
forall a. Text -> Either Text a -> Either Text a
err Text
"authId"     (PersistValue -> Either Text (Maybe ByteStringJ)
forall a. PersistField a => PersistValue -> Either Text a
P.fromPersistValue PersistValue
b)
      Either
  Text
  (Decomposed sess -> UTCTime -> UTCTime -> PersistentSession sess)
-> Either Text (Decomposed sess)
-> Either Text (UTCTime -> UTCTime -> PersistentSession sess)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Either Text (Decomposed sess) -> Either Text (Decomposed sess)
forall a. Text -> Either Text a -> Either Text a
err Text
"session"    (PersistValue -> Either Text (Decomposed sess)
forall a. PersistField a => PersistValue -> Either Text a
P.fromPersistValue PersistValue
c)
      Either Text (UTCTime -> UTCTime -> PersistentSession sess)
-> Either Text UTCTime
-> Either Text (UTCTime -> PersistentSession sess)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Either Text UTCTime -> Either Text UTCTime
forall a. Text -> Either Text a -> Either Text a
err Text
"createdAt"  (PersistValue -> Either Text UTCTime
forall a. PersistField a => PersistValue -> Either Text a
P.fromPersistValue PersistValue
d)
      Either Text (UTCTime -> PersistentSession sess)
-> Either Text UTCTime -> Either Text (PersistentSession sess)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Either Text UTCTime -> Either Text UTCTime
forall a. Text -> Either Text a -> Either Text a
err Text
"accessedAt" (PersistValue -> Either Text UTCTime
forall a. PersistField a => PersistValue -> Either Text a
P.fromPersistValue PersistValue
e)
    where
      err :: T.Text -> Either T.Text a -> Either T.Text a
      err :: Text -> Either Text a -> Either Text a
err Text
s (Left Text
r)  = Text -> Either Text a
forall a b. a -> Either a b
Left (Text -> Either Text a) -> Text -> Either Text a
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
"PersistentSession/fromPersistValues/", Text
s, Text
": ", Text
r]
      err Text
_ (Right a
v) = a -> Either Text a
forall a b. b -> Either a b
Right a
v
  fromPersistValues [PersistValue]
x = Text -> Either Text (PersistentSession sess)
forall a b. a -> Either a b
Left (Text -> Either Text (PersistentSession sess))
-> Text -> Either Text (PersistentSession sess)
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"PersistentSession/fromPersistValues: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [PersistValue] -> String
forall a. Show a => a -> String
show [PersistValue]
x

  persistUniqueToFieldNames :: Unique (PersistentSession sess)
-> NonEmpty (FieldNameHS, FieldNameDB)
persistUniqueToFieldNames Unique (PersistentSession sess)
_ = String -> NonEmpty (FieldNameHS, FieldNameDB)
forall a. HasCallStack => String -> a
error String
"Degenerate case, should never happen"
  persistUniqueToValues :: Unique (PersistentSession sess) -> [PersistValue]
persistUniqueToValues Unique (PersistentSession sess)
_     = String -> [PersistValue]
forall a. HasCallStack => String -> a
error String
"Degenerate case, should never happen"
  persistUniqueKeys :: PersistentSession sess -> [Unique (PersistentSession sess)]
persistUniqueKeys PersistentSession sess
_         = []

  persistFieldDef :: EntityField (PersistentSession sess) typ -> FieldDef
persistFieldDef EntityField (PersistentSession sess) typ
PersistentSessionId
    = FieldDef
persistFieldDefPersistentSessionKey
  persistFieldDef EntityField (PersistentSession sess) typ
PersistentSessionKey
    = FieldDef
persistFieldDefPersistentSessionKey
  persistFieldDef EntityField (PersistentSession sess) typ
PersistentSessionAuthId
    = FieldNameHS
-> FieldNameDB
-> FieldType
-> SqlType
-> [FieldAttr]
-> Bool
-> ReferenceDef
-> FieldCascade
-> Maybe Text
-> Maybe Text
-> Bool
-> FieldDef
P.FieldDef
        (Text -> FieldNameHS
P.FieldNameHS Text
"authId")
        (Text -> FieldNameDB
P.FieldNameDB Text
"auth_id")
        (Maybe Text -> Text -> FieldType
P.FTTypeCon Maybe Text
forall a. Maybe a
Nothing Text
"ByteStringJ")
        (Proxy ByteStringJ -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
P.sqlType (Proxy ByteStringJ
forall k (t :: k). Proxy t
Proxy :: Proxy ByteStringJ))
        [FieldAttr
P.FieldAttrMaybe, Text -> FieldAttr
P.FieldAttrDefault Text
"NULL"]
        Bool
True
        ReferenceDef
P.NoReference
        (FieldCascade :: Maybe CascadeAction -> Maybe CascadeAction -> FieldCascade
P.FieldCascade {fcOnUpdate :: Maybe CascadeAction
fcOnUpdate = Maybe CascadeAction
forall a. Maybe a
Nothing, fcOnDelete :: Maybe CascadeAction
fcOnDelete = Maybe CascadeAction
forall a. Maybe a
Nothing})
        Maybe Text
forall a. Maybe a
Nothing
        Maybe Text
forall a. Maybe a
Nothing
        Bool
False
  persistFieldDef EntityField (PersistentSession sess) typ
PersistentSessionSession
    = FieldNameHS
-> FieldNameDB
-> FieldType
-> SqlType
-> [FieldAttr]
-> Bool
-> ReferenceDef
-> FieldCascade
-> Maybe Text
-> Maybe Text
-> Bool
-> FieldDef
P.FieldDef
        (Text -> FieldNameHS
P.FieldNameHS Text
"session")
        (Text -> FieldNameDB
P.FieldNameDB Text
"session")
        (Maybe Text -> Text -> FieldType
P.FTTypeCon Maybe Text
forall a. Maybe a
Nothing Text
"Decomposed sess")
        (Proxy (Decomposed sess) -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
P.sqlType (Proxy (Decomposed sess)
forall k (t :: k). Proxy t
Proxy :: Proxy (Decomposed sess))) -- Important!
        []
        Bool
True
        ReferenceDef
P.NoReference
        (FieldCascade :: Maybe CascadeAction -> Maybe CascadeAction -> FieldCascade
P.FieldCascade {fcOnUpdate :: Maybe CascadeAction
fcOnUpdate = Maybe CascadeAction
forall a. Maybe a
Nothing, fcOnDelete :: Maybe CascadeAction
fcOnDelete = Maybe CascadeAction
forall a. Maybe a
Nothing})
        Maybe Text
forall a. Maybe a
Nothing
        Maybe Text
forall a. Maybe a
Nothing
        Bool
False
  persistFieldDef EntityField (PersistentSession sess) typ
PersistentSessionCreatedAt
    = FieldNameHS
-> FieldNameDB
-> FieldType
-> SqlType
-> [FieldAttr]
-> Bool
-> ReferenceDef
-> FieldCascade
-> Maybe Text
-> Maybe Text
-> Bool
-> FieldDef
P.FieldDef
        (Text -> FieldNameHS
P.FieldNameHS Text
"createdAt")
        (Text -> FieldNameDB
P.FieldNameDB Text
"created_at")
        (Maybe Text -> Text -> FieldType
P.FTTypeCon Maybe Text
forall a. Maybe a
Nothing Text
"UTCTime")
        (Proxy UTCTime -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
P.sqlType (Proxy UTCTime
forall k (t :: k). Proxy t
Proxy :: Proxy UTCTime))
        []
        Bool
True
        ReferenceDef
P.NoReference
        (FieldCascade :: Maybe CascadeAction -> Maybe CascadeAction -> FieldCascade
P.FieldCascade {fcOnUpdate :: Maybe CascadeAction
fcOnUpdate = Maybe CascadeAction
forall a. Maybe a
Nothing, fcOnDelete :: Maybe CascadeAction
fcOnDelete = Maybe CascadeAction
forall a. Maybe a
Nothing})
        Maybe Text
forall a. Maybe a
Nothing
        Maybe Text
forall a. Maybe a
Nothing
        Bool
False
  persistFieldDef EntityField (PersistentSession sess) typ
PersistentSessionAccessedAt
    = FieldNameHS
-> FieldNameDB
-> FieldType
-> SqlType
-> [FieldAttr]
-> Bool
-> ReferenceDef
-> FieldCascade
-> Maybe Text
-> Maybe Text
-> Bool
-> FieldDef
P.FieldDef
        (Text -> FieldNameHS
P.FieldNameHS Text
"accessedAt")
        (Text -> FieldNameDB
P.FieldNameDB Text
"accessed_at")
        (Maybe Text -> Text -> FieldType
P.FTTypeCon Maybe Text
forall a. Maybe a
Nothing Text
"UTCTime")
        (Proxy UTCTime -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
P.sqlType (Proxy UTCTime
forall k (t :: k). Proxy t
Proxy :: Proxy UTCTime))
        []
        Bool
True
        ReferenceDef
P.NoReference
        (FieldCascade :: Maybe CascadeAction -> Maybe CascadeAction -> FieldCascade
P.FieldCascade {fcOnUpdate :: Maybe CascadeAction
fcOnUpdate = Maybe CascadeAction
forall a. Maybe a
Nothing, fcOnDelete :: Maybe CascadeAction
fcOnDelete = Maybe CascadeAction
forall a. Maybe a
Nothing})
        Maybe Text
forall a. Maybe a
Nothing
        Maybe Text
forall a. Maybe a
Nothing
        Bool
False

  persistIdField :: EntityField (PersistentSession sess) (Key (PersistentSession sess))
persistIdField = EntityField (PersistentSession sess) (Key (PersistentSession sess))
forall sess typ.
(typ ~ Key (PersistentSession sess)) =>
EntityField (PersistentSession sess) typ
PersistentSessionId

  fieldLens :: EntityField (PersistentSession sess) field
-> forall (f :: * -> *).
   Functor f =>
   (field -> f field)
   -> Entity (PersistentSession sess)
   -> f (Entity (PersistentSession sess))
fieldLens EntityField (PersistentSession sess) field
PersistentSessionId = (Entity (PersistentSession sess) -> Key (PersistentSession sess))
-> (Entity (PersistentSession sess)
    -> Key (PersistentSession sess) -> Entity (PersistentSession sess))
-> (Key (PersistentSession sess)
    -> f (Key (PersistentSession sess)))
-> Entity (PersistentSession sess)
-> f (Entity (PersistentSession sess))
forall (f :: * -> *) s a b t.
Functor f =>
(s -> a) -> (s -> b -> t) -> (a -> f b) -> s -> f t
lensPTH
    Entity (PersistentSession sess) -> Key (PersistentSession sess)
forall record. Entity record -> Key record
P.entityKey
    (\(P.Entity Key (PersistentSession sess)
_ PersistentSession sess
v) Key (PersistentSession sess)
k -> Key (PersistentSession sess)
-> PersistentSession sess -> Entity (PersistentSession sess)
forall record. Key record -> record -> Entity record
P.Entity Key (PersistentSession sess)
k PersistentSession sess
v)
  fieldLens EntityField (PersistentSession sess) field
PersistentSessionKey = (Entity (PersistentSession sess) -> SessionId sess)
-> (Entity (PersistentSession sess)
    -> SessionId sess -> Entity (PersistentSession sess))
-> (SessionId sess -> f (SessionId sess))
-> Entity (PersistentSession sess)
-> f (Entity (PersistentSession sess))
forall (f :: * -> *) s a b t.
Functor f =>
(s -> a) -> (s -> b -> t) -> (a -> f b) -> s -> f t
lensPTH
    (PersistentSession sess -> SessionId sess
forall sess. PersistentSession sess -> SessionId sess
persistentSessionKey (PersistentSession sess -> SessionId sess)
-> (Entity (PersistentSession sess) -> PersistentSession sess)
-> Entity (PersistentSession sess)
-> SessionId sess
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity (PersistentSession sess) -> PersistentSession sess
forall record. Entity record -> record
P.entityVal)
    (\(P.Entity Key (PersistentSession sess)
k PersistentSession sess
v) SessionId sess
x -> Key (PersistentSession sess)
-> PersistentSession sess -> Entity (PersistentSession sess)
forall record. Key record -> record -> Entity record
P.Entity Key (PersistentSession sess)
k (PersistentSession sess
v {persistentSessionKey :: SessionId sess
persistentSessionKey = SessionId sess
x}))
  fieldLens EntityField (PersistentSession sess) field
PersistentSessionAuthId = (Entity (PersistentSession sess) -> Maybe ByteStringJ)
-> (Entity (PersistentSession sess)
    -> Maybe ByteStringJ -> Entity (PersistentSession sess))
-> (Maybe ByteStringJ -> f (Maybe ByteStringJ))
-> Entity (PersistentSession sess)
-> f (Entity (PersistentSession sess))
forall (f :: * -> *) s a b t.
Functor f =>
(s -> a) -> (s -> b -> t) -> (a -> f b) -> s -> f t
lensPTH
    (PersistentSession sess -> Maybe ByteStringJ
forall sess. PersistentSession sess -> Maybe ByteStringJ
persistentSessionAuthId (PersistentSession sess -> Maybe ByteStringJ)
-> (Entity (PersistentSession sess) -> PersistentSession sess)
-> Entity (PersistentSession sess)
-> Maybe ByteStringJ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity (PersistentSession sess) -> PersistentSession sess
forall record. Entity record -> record
P.entityVal)
    (\(P.Entity Key (PersistentSession sess)
k PersistentSession sess
v) Maybe ByteStringJ
x -> Key (PersistentSession sess)
-> PersistentSession sess -> Entity (PersistentSession sess)
forall record. Key record -> record -> Entity record
P.Entity Key (PersistentSession sess)
k (PersistentSession sess
v {persistentSessionAuthId :: Maybe ByteStringJ
persistentSessionAuthId = Maybe ByteStringJ
x}))
  fieldLens EntityField (PersistentSession sess) field
PersistentSessionSession = (Entity (PersistentSession sess) -> field)
-> (Entity (PersistentSession sess)
    -> field -> Entity (PersistentSession sess))
-> (field -> f field)
-> Entity (PersistentSession sess)
-> f (Entity (PersistentSession sess))
forall (f :: * -> *) s a b t.
Functor f =>
(s -> a) -> (s -> b -> t) -> (a -> f b) -> s -> f t
lensPTH
    (PersistentSession sess -> field
forall sess. PersistentSession sess -> Decomposed sess
persistentSessionSession (PersistentSession sess -> field)
-> (Entity (PersistentSession sess) -> PersistentSession sess)
-> Entity (PersistentSession sess)
-> field
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity (PersistentSession sess) -> PersistentSession sess
forall record. Entity record -> record
P.entityVal)
    (\(P.Entity Key (PersistentSession sess)
k PersistentSession sess
v) field
x -> Key (PersistentSession sess)
-> PersistentSession sess -> Entity (PersistentSession sess)
forall record. Key record -> record -> Entity record
P.Entity Key (PersistentSession sess)
k (PersistentSession sess
v {persistentSessionSession :: Decomposed sess
persistentSessionSession = field
Decomposed sess
x}))
  fieldLens EntityField (PersistentSession sess) field
PersistentSessionCreatedAt = (Entity (PersistentSession sess) -> UTCTime)
-> (Entity (PersistentSession sess)
    -> UTCTime -> Entity (PersistentSession sess))
-> (UTCTime -> f UTCTime)
-> Entity (PersistentSession sess)
-> f (Entity (PersistentSession sess))
forall (f :: * -> *) s a b t.
Functor f =>
(s -> a) -> (s -> b -> t) -> (a -> f b) -> s -> f t
lensPTH
    (PersistentSession sess -> UTCTime
forall sess. PersistentSession sess -> UTCTime
persistentSessionCreatedAt (PersistentSession sess -> UTCTime)
-> (Entity (PersistentSession sess) -> PersistentSession sess)
-> Entity (PersistentSession sess)
-> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity (PersistentSession sess) -> PersistentSession sess
forall record. Entity record -> record
P.entityVal)
    (\(P.Entity Key (PersistentSession sess)
k PersistentSession sess
v) UTCTime
x -> Key (PersistentSession sess)
-> PersistentSession sess -> Entity (PersistentSession sess)
forall record. Key record -> record -> Entity record
P.Entity Key (PersistentSession sess)
k (PersistentSession sess
v {persistentSessionCreatedAt :: UTCTime
persistentSessionCreatedAt = UTCTime
x}))
  fieldLens EntityField (PersistentSession sess) field
PersistentSessionAccessedAt = (Entity (PersistentSession sess) -> UTCTime)
-> (Entity (PersistentSession sess)
    -> UTCTime -> Entity (PersistentSession sess))
-> (UTCTime -> f UTCTime)
-> Entity (PersistentSession sess)
-> f (Entity (PersistentSession sess))
forall (f :: * -> *) s a b t.
Functor f =>
(s -> a) -> (s -> b -> t) -> (a -> f b) -> s -> f t
lensPTH
    (PersistentSession sess -> UTCTime
forall sess. PersistentSession sess -> UTCTime
persistentSessionAccessedAt (PersistentSession sess -> UTCTime)
-> (Entity (PersistentSession sess) -> PersistentSession sess)
-> Entity (PersistentSession sess)
-> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity (PersistentSession sess) -> PersistentSession sess
forall record. Entity record -> record
P.entityVal)
    (\(P.Entity Key (PersistentSession sess)
k PersistentSession sess
v) UTCTime
x -> Key (PersistentSession sess)
-> PersistentSession sess -> Entity (PersistentSession sess)
forall record. Key record -> record -> Entity record
P.Entity Key (PersistentSession sess)
k (PersistentSession sess
v {persistentSessionAccessedAt :: UTCTime
persistentSessionAccessedAt = UTCTime
x}))

-- | To avoid type argument mismatch, the definition is spit out and finalized.
persistFieldDefPersistentSessionKey :: P.FieldDef
persistFieldDefPersistentSessionKey :: FieldDef
persistFieldDefPersistentSessionKey =
  FieldNameHS
-> FieldNameDB
-> FieldType
-> SqlType
-> [FieldAttr]
-> Bool
-> ReferenceDef
-> FieldCascade
-> Maybe Text
-> Maybe Text
-> Bool
-> FieldDef
P.FieldDef
  (Text -> FieldNameHS
P.FieldNameHS Text
"key")
  (Text -> FieldNameDB
P.FieldNameDB Text
"key")
  (Maybe Text -> Text -> FieldType
P.FTTypeCon Maybe Text
forall a. Maybe a
Nothing Text
"SessionId sess")
  (Proxy (SessionId Any) -> SqlType
forall a. PersistFieldSql a => Proxy a -> SqlType
P.sqlType (forall sess. Proxy (SessionId sess)
forall k (t :: k). Proxy t
Proxy :: Proxy (SessionId sess)))
  [Integer -> FieldAttr
P.FieldAttrMaxlen Integer
30]
  Bool
True
  ReferenceDef
P.NoReference
  (FieldCascade :: Maybe CascadeAction -> Maybe CascadeAction -> FieldCascade
P.FieldCascade {fcOnUpdate :: Maybe CascadeAction
fcOnUpdate = Maybe CascadeAction
forall a. Maybe a
Nothing, fcOnDelete :: Maybe CascadeAction
fcOnDelete = Maybe CascadeAction
forall a. Maybe a
Nothing})
  Maybe Text
forall a. Maybe a
Nothing
  Maybe Text
forall a. Maybe a
Nothing
  Bool
False

-- | Copy-paste from @Database.Persist.TH@.  Who needs lens anyway...
lensPTH :: Functor f => (s -> a) -> (s -> b -> t) -> (a -> f b) -> s -> f t
lensPTH :: (s -> a) -> (s -> b -> t) -> (a -> f b) -> s -> f t
lensPTH s -> a
sa s -> b -> t
sbt a -> f b
afb s
s = (b -> t) -> f b -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (s -> b -> t
sbt s
s) (a -> f b
afb (a -> f b) -> a -> f b
forall a b. (a -> b) -> a -> b
$ s -> a
sa s
s)


instance A.ToJSON (Decomposed sess) => A.ToJSON (PersistentSession sess) where
  toJSON :: PersistentSession sess -> Value
toJSON (PersistentSession SessionId sess
key Maybe ByteStringJ
authId Decomposed sess
session UTCTime
createdAt UTCTime
accessedAt) =
    [Pair] -> Value
A.object
      [ Key
"key"        Key -> SessionId sess -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= SessionId sess
key
      , Key
"authId"     Key -> Maybe ByteStringJ -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Maybe ByteStringJ
authId
      , Key
"session"    Key -> Decomposed sess -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Decomposed sess
session
      , Key
"createdAt"  Key -> UTCTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= UTCTime
createdAt
      , Key
"accessedAt" Key -> UTCTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= UTCTime
accessedAt ]

instance A.FromJSON (Decomposed sess) => A.FromJSON (PersistentSession sess) where
  parseJSON :: Value -> Parser (PersistentSession sess)
parseJSON (A.Object Object
obj) =
    SessionId sess
-> Maybe ByteStringJ
-> Decomposed sess
-> UTCTime
-> UTCTime
-> PersistentSession sess
forall sess.
SessionId sess
-> Maybe ByteStringJ
-> Decomposed sess
-> UTCTime
-> UTCTime
-> PersistentSession sess
PersistentSession
      (SessionId sess
 -> Maybe ByteStringJ
 -> Decomposed sess
 -> UTCTime
 -> UTCTime
 -> PersistentSession sess)
-> Parser (SessionId sess)
-> Parser
     (Maybe ByteStringJ
      -> Decomposed sess -> UTCTime -> UTCTime -> PersistentSession sess)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser (SessionId sess)
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"key"
      Parser
  (Maybe ByteStringJ
   -> Decomposed sess -> UTCTime -> UTCTime -> PersistentSession sess)
-> Parser (Maybe ByteStringJ)
-> Parser
     (Decomposed sess -> UTCTime -> UTCTime -> PersistentSession sess)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe ByteStringJ)
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"authId"
      Parser
  (Decomposed sess -> UTCTime -> UTCTime -> PersistentSession sess)
-> Parser (Decomposed sess)
-> Parser (UTCTime -> UTCTime -> PersistentSession sess)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Decomposed sess)
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"session"
      Parser (UTCTime -> UTCTime -> PersistentSession sess)
-> Parser UTCTime -> Parser (UTCTime -> PersistentSession sess)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser UTCTime
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"createdAt"
      Parser (UTCTime -> PersistentSession sess)
-> Parser UTCTime -> Parser (PersistentSession sess)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser UTCTime
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"accessedAt"
  parseJSON Value
_ = Parser (PersistentSession sess)
forall a. Monoid a => a
mempty

instance ( A.ToJSON (Decomposed sess)
         , P.PersistFieldSql (Decomposed sess)
         ) => A.ToJSON (P.Entity (PersistentSession sess)) where
  toJSON :: Entity (PersistentSession sess) -> Value
toJSON = Entity (PersistentSession sess) -> Value
forall record.
(PersistEntity record, ToJSON record) =>
Entity record -> Value
P.entityIdToJSON

instance ( A.FromJSON (Decomposed sess)
         , P.PersistFieldSql (Decomposed sess)
         ) => A.FromJSON (P.Entity (PersistentSession sess)) where
  parseJSON :: Value -> Parser (Entity (PersistentSession sess))
parseJSON = Value -> Parser (Entity (PersistentSession sess))
forall record.
(PersistEntity record, FromJSON record) =>
Value -> Parser (Entity record)
P.entityIdFromJSON

type PersistentSessionBySessionMap = PersistentSession SessionMap

-- | Simple version.
-- Entity definitions needed to generate the SQL schema for 'SqlStorage'.
-- Example:
--
-- @
-- mkMigrate \"migrateAll\" serverSessionDefsBySessionMap
-- @
--
-- Note: Also import `PersistentSessionBySessionMap` in the same module.
serverSessionDefsBySessionMap :: [P.UnboundEntityDef]
serverSessionDefsBySessionMap :: [UnboundEntityDef]
serverSessionDefsBySessionMap = Proxy PersistentSessionBySessionMap -> Text -> [UnboundEntityDef]
forall sess.
PersistEntity sess =>
Proxy sess -> Text -> [UnboundEntityDef]
mkServerSessionDefs (Proxy PersistentSessionBySessionMap
forall k (t :: k). Proxy t
Proxy :: Proxy PersistentSessionBySessionMap) Text
"PersistentSessionBySessionMap"

-- | Entity definitions needed to generate the SQL schema for 'SqlStorage'.
-- Generate schema by specifying Haskell name in Text.
--
-- Example using 'SessionMap':
--
-- @
-- type PersistentSessionBySessionMap = PersistentSession SessionMap
-- mkMigrate \"migrateAll\" (mkServerSessionDefs (Proxy :: Proxy PersistentSessionBySessionMap) \"PersistentSessionBySessionMap\")
-- @
mkServerSessionDefs :: forall sess. PersistEntity sess => Proxy sess -> T.Text -> [P.UnboundEntityDef]
mkServerSessionDefs :: Proxy sess -> Text -> [UnboundEntityDef]
mkServerSessionDefs Proxy sess
_ Text
name =
  -- The name of a variable of type sess is no longer taken into account, so it is now necessary to pass it by Text.
  [EntityDef -> UnboundEntityDef
P.unbindEntityDef (EntityDef -> UnboundEntityDef) -> EntityDef -> UnboundEntityDef
forall a b. (a -> b) -> a -> b
$ (Proxy sess -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef (Proxy sess
forall k (t :: k). Proxy t
Proxy :: Proxy sess)) { entityHaskell :: EntityNameHS
P.entityHaskell = Text -> EntityNameHS
P.EntityNameHS Text
name }]

-- | Generate a key to the entity from the session ID.
psKey :: SessionId sess -> Key (PersistentSession sess)
psKey :: SessionId sess -> Key (PersistentSession sess)
psKey = SessionId sess -> Key (PersistentSession sess)
forall sess. SessionId sess -> Key (PersistentSession sess)
PersistentSessionKey'


-- | Convert from 'Session' to 'PersistentSession'.
toPersistentSession :: Session sess -> PersistentSession sess
toPersistentSession :: Session sess -> PersistentSession sess
toPersistentSession Session {Maybe AuthId
UTCTime
SessionId sess
Decomposed sess
sessionKey :: forall sess. Session sess -> SessionId sess
sessionAuthId :: forall sess. Session sess -> Maybe AuthId
sessionData :: forall sess. Session sess -> Decomposed sess
sessionCreatedAt :: forall sess. Session sess -> UTCTime
sessionAccessedAt :: forall sess. Session sess -> UTCTime
sessionAccessedAt :: UTCTime
sessionCreatedAt :: UTCTime
sessionData :: Decomposed sess
sessionAuthId :: Maybe AuthId
sessionKey :: SessionId sess
..} =
  PersistentSession :: forall sess.
SessionId sess
-> Maybe ByteStringJ
-> Decomposed sess
-> UTCTime
-> UTCTime
-> PersistentSession sess
PersistentSession
    { persistentSessionKey :: SessionId sess
persistentSessionKey        = SessionId sess
sessionKey
    , persistentSessionAuthId :: Maybe ByteStringJ
persistentSessionAuthId     = (AuthId -> ByteStringJ) -> Maybe AuthId -> Maybe ByteStringJ
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AuthId -> ByteStringJ
B Maybe AuthId
sessionAuthId
    , persistentSessionSession :: Decomposed sess
persistentSessionSession    = Decomposed sess
sessionData
    , persistentSessionCreatedAt :: UTCTime
persistentSessionCreatedAt  = UTCTime
sessionCreatedAt
    , persistentSessionAccessedAt :: UTCTime
persistentSessionAccessedAt = UTCTime
sessionAccessedAt
    }


-- | Convert from 'PersistentSession' to 'Session'.
fromPersistentSession :: PersistentSession sess -> Session sess
fromPersistentSession :: PersistentSession sess -> Session sess
fromPersistentSession PersistentSession {Maybe ByteStringJ
UTCTime
SessionId sess
Decomposed sess
persistentSessionAccessedAt :: UTCTime
persistentSessionCreatedAt :: UTCTime
persistentSessionSession :: Decomposed sess
persistentSessionAuthId :: Maybe ByteStringJ
persistentSessionKey :: SessionId sess
persistentSessionAccessedAt :: forall sess. PersistentSession sess -> UTCTime
persistentSessionCreatedAt :: forall sess. PersistentSession sess -> UTCTime
persistentSessionSession :: forall sess. PersistentSession sess -> Decomposed sess
persistentSessionAuthId :: forall sess. PersistentSession sess -> Maybe ByteStringJ
persistentSessionKey :: forall sess. PersistentSession sess -> SessionId sess
..} =
  Session :: forall sess.
SessionId sess
-> Maybe AuthId
-> Decomposed sess
-> UTCTime
-> UTCTime
-> Session sess
Session
    { sessionKey :: SessionId sess
sessionKey        = SessionId sess
persistentSessionKey
    , sessionAuthId :: Maybe AuthId
sessionAuthId     = (ByteStringJ -> AuthId) -> Maybe ByteStringJ -> Maybe AuthId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteStringJ -> AuthId
unB Maybe ByteStringJ
persistentSessionAuthId
    , sessionData :: Decomposed sess
sessionData       = Decomposed sess
persistentSessionSession
    , sessionCreatedAt :: UTCTime
sessionCreatedAt  = UTCTime
persistentSessionCreatedAt
    , sessionAccessedAt :: UTCTime
sessionAccessedAt = UTCTime
persistentSessionAccessedAt
    }


-- | SQL session storage backend using @persistent@.
newtype SqlStorage sess =
  SqlStorage
    { SqlStorage sess -> ConnectionPool
connPool :: P.ConnectionPool
      -- ^ Pool of DB connections.  You may use the same pool as
      -- your application.
    } deriving (Typeable)


instance forall sess.
         ( IsSessionData sess
         , P.PersistFieldSql (Decomposed sess)
         ) => Storage (SqlStorage sess) where
  type SessionData  (SqlStorage sess) = sess
  type TransactionM (SqlStorage sess) = P.SqlPersistT IO
  runTransactionM :: SqlStorage sess -> TransactionM (SqlStorage sess) a -> IO a
runTransactionM  = (ReaderT SqlBackend IO a -> ConnectionPool -> IO a)
-> ConnectionPool -> ReaderT SqlBackend IO a -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT SqlBackend IO a -> ConnectionPool -> IO a
forall backend (m :: * -> *) a.
(MonadUnliftIO m, BackendCompatible SqlBackend backend) =>
ReaderT backend m a -> Pool backend -> m a
P.runSqlPool (ConnectionPool -> ReaderT SqlBackend IO a -> IO a)
-> (SqlStorage sess -> ConnectionPool)
-> SqlStorage sess
-> ReaderT SqlBackend IO a
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlStorage sess -> ConnectionPool
forall sess. SqlStorage sess -> ConnectionPool
connPool
  getSession :: SqlStorage sess
-> SessionId (SessionData (SqlStorage sess))
-> TransactionM
     (SqlStorage sess) (Maybe (Session (SessionData (SqlStorage sess))))
getSession     SqlStorage sess
_ = (Maybe (PersistentSession sess) -> Maybe (Session sess))
-> ReaderT SqlBackend IO (Maybe (PersistentSession sess))
-> ReaderT SqlBackend IO (Maybe (Session sess))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((PersistentSession sess -> Session sess)
-> Maybe (PersistentSession sess) -> Maybe (Session sess)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PersistentSession sess -> Session sess
forall sess. PersistentSession sess -> Session sess
fromPersistentSession) (ReaderT SqlBackend IO (Maybe (PersistentSession sess))
 -> ReaderT SqlBackend IO (Maybe (Session sess)))
-> (SessionId sess
    -> ReaderT SqlBackend IO (Maybe (PersistentSession sess)))
-> SessionId sess
-> ReaderT SqlBackend IO (Maybe (Session sess))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key (PersistentSession sess)
-> ReaderT SqlBackend IO (Maybe (PersistentSession sess))
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
P.get (Key (PersistentSession sess)
 -> ReaderT SqlBackend IO (Maybe (PersistentSession sess)))
-> (SessionId sess -> Key (PersistentSession sess))
-> SessionId sess
-> ReaderT SqlBackend IO (Maybe (PersistentSession sess))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionId sess -> Key (PersistentSession sess)
forall sess. SessionId sess -> Key (PersistentSession sess)
psKey
  deleteSession :: SqlStorage sess
-> SessionId (SessionData (SqlStorage sess))
-> TransactionM (SqlStorage sess) ()
deleteSession  SqlStorage sess
_ = Key (PersistentSession sess) -> ReaderT SqlBackend IO ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m ()
P.delete (Key (PersistentSession sess) -> ReaderT SqlBackend IO ())
-> (SessionId sess -> Key (PersistentSession sess))
-> SessionId sess
-> ReaderT SqlBackend IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionId sess -> Key (PersistentSession sess)
forall sess. SessionId sess -> Key (PersistentSession sess)
psKey
  deleteAllSessionsOfAuthId :: SqlStorage sess -> AuthId -> TransactionM (SqlStorage sess) ()
deleteAllSessionsOfAuthId SqlStorage sess
_ AuthId
authId =
    [Filter (PersistentSession sess)] -> ReaderT SqlBackend IO ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
P.deleteWhere [EntityField (PersistentSession sess) (Maybe ByteStringJ)
field EntityField (PersistentSession sess) (Maybe ByteStringJ)
-> Maybe ByteStringJ -> Filter (PersistentSession sess)
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
P.==. ByteStringJ -> Maybe ByteStringJ
forall a. a -> Maybe a
Just (AuthId -> ByteStringJ
B AuthId
authId)]
    where
      field :: EntityField (PersistentSession sess) (Maybe ByteStringJ)
      field :: EntityField (PersistentSession sess) (Maybe ByteStringJ)
field = EntityField (PersistentSession sess) (Maybe ByteStringJ)
forall sess typ.
(typ ~ Maybe ByteStringJ) =>
EntityField (PersistentSession sess) typ
PersistentSessionAuthId
  insertSession :: SqlStorage sess
-> Session (SessionData (SqlStorage sess))
-> TransactionM (SqlStorage sess) ()
insertSession SqlStorage sess
s Session (SessionData (SqlStorage sess))
session = do
    Maybe (Session sess)
mold <- SqlStorage sess
-> SessionId (SessionData (SqlStorage sess))
-> TransactionM
     (SqlStorage sess) (Maybe (Session (SessionData (SqlStorage sess))))
forall sto.
Storage sto =>
sto
-> SessionId (SessionData sto)
-> TransactionM sto (Maybe (Session (SessionData sto)))
getSession SqlStorage sess
s (Session sess -> SessionId sess
forall sess. Session sess -> SessionId sess
sessionKey Session sess
Session (SessionData (SqlStorage sess))
session)
    ReaderT SqlBackend IO ()
-> (Session sess -> ReaderT SqlBackend IO ())
-> Maybe (Session sess)
-> ReaderT SqlBackend IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      (ReaderT SqlBackend IO (Key (PersistentSession sess))
-> ReaderT SqlBackend IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT SqlBackend IO (Key (PersistentSession sess))
 -> ReaderT SqlBackend IO ())
-> ReaderT SqlBackend IO (Key (PersistentSession sess))
-> ReaderT SqlBackend IO ()
forall a b. (a -> b) -> a -> b
$ PersistentSession sess
-> ReaderT SqlBackend IO (Key (PersistentSession sess))
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
P.insert (PersistentSession sess
 -> ReaderT SqlBackend IO (Key (PersistentSession sess)))
-> PersistentSession sess
-> ReaderT SqlBackend IO (Key (PersistentSession sess))
forall a b. (a -> b) -> a -> b
$ Session sess -> PersistentSession sess
forall sess. Session sess -> PersistentSession sess
toPersistentSession Session sess
Session (SessionData (SqlStorage sess))
session)
      (\Session sess
old -> StorageException (SqlStorage sess)
-> TransactionM (SqlStorage sess) ()
forall sess a.
Storage (SqlStorage sess) =>
StorageException (SqlStorage sess)
-> TransactionM (SqlStorage sess) a
throwSS (StorageException (SqlStorage sess)
 -> TransactionM (SqlStorage sess) ())
-> StorageException (SqlStorage sess)
-> TransactionM (SqlStorage sess) ()
forall a b. (a -> b) -> a -> b
$ Session (SessionData (SqlStorage sess))
-> Session (SessionData (SqlStorage sess))
-> StorageException (SqlStorage sess)
forall sto.
Session (SessionData sto)
-> Session (SessionData sto) -> StorageException sto
SessionAlreadyExists Session sess
Session (SessionData (SqlStorage sess))
old Session (SessionData (SqlStorage sess))
session)
      Maybe (Session sess)
mold
  replaceSession :: SqlStorage sess
-> Session (SessionData (SqlStorage sess))
-> TransactionM (SqlStorage sess) ()
replaceSession SqlStorage sess
_ Session (SessionData (SqlStorage sess))
session = do
    let key :: Key (PersistentSession sess)
key = SessionId sess -> Key (PersistentSession sess)
forall sess. SessionId sess -> Key (PersistentSession sess)
psKey (SessionId sess -> Key (PersistentSession sess))
-> SessionId sess -> Key (PersistentSession sess)
forall a b. (a -> b) -> a -> b
$ Session sess -> SessionId sess
forall sess. Session sess -> SessionId sess
sessionKey Session sess
Session (SessionData (SqlStorage sess))
session
    Maybe (PersistentSession sess)
mold <- Key (PersistentSession sess)
-> ReaderT SqlBackend IO (Maybe (PersistentSession sess))
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
P.get Key (PersistentSession sess)
key
    ReaderT SqlBackend IO ()
-> (PersistentSession sess -> ReaderT SqlBackend IO ())
-> Maybe (PersistentSession sess)
-> ReaderT SqlBackend IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      (StorageException (SqlStorage sess)
-> TransactionM (SqlStorage sess) ()
forall sess a.
Storage (SqlStorage sess) =>
StorageException (SqlStorage sess)
-> TransactionM (SqlStorage sess) a
throwSS (StorageException (SqlStorage sess)
 -> TransactionM (SqlStorage sess) ())
-> StorageException (SqlStorage sess)
-> TransactionM (SqlStorage sess) ()
forall a b. (a -> b) -> a -> b
$ Session (SessionData (SqlStorage sess))
-> StorageException (SqlStorage sess)
forall sto. Session (SessionData sto) -> StorageException sto
SessionDoesNotExist Session (SessionData (SqlStorage sess))
session)
      (\PersistentSession sess
_old -> ReaderT SqlBackend IO () -> ReaderT SqlBackend IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT SqlBackend IO () -> ReaderT SqlBackend IO ())
-> ReaderT SqlBackend IO () -> ReaderT SqlBackend IO ()
forall a b. (a -> b) -> a -> b
$ Key (PersistentSession sess)
-> PersistentSession sess -> ReaderT SqlBackend IO ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> record -> ReaderT backend m ()
P.replace Key (PersistentSession sess)
key (PersistentSession sess -> ReaderT SqlBackend IO ())
-> PersistentSession sess -> ReaderT SqlBackend IO ()
forall a b. (a -> b) -> a -> b
$ Session sess -> PersistentSession sess
forall sess. Session sess -> PersistentSession sess
toPersistentSession Session sess
Session (SessionData (SqlStorage sess))
session)
      Maybe (PersistentSession sess)
mold


-- | Specialization of 'E.throwIO' for 'SqlStorage'.
throwSS
  :: Storage (SqlStorage sess)
  => StorageException (SqlStorage sess)
  -> TransactionM (SqlStorage sess) a
throwSS :: StorageException (SqlStorage sess)
-> TransactionM (SqlStorage sess) a
throwSS = IO a -> ReaderT SqlBackend IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> ReaderT SqlBackend IO a)
-> (StorageException (SqlStorage sess) -> IO a)
-> StorageException (SqlStorage sess)
-> ReaderT SqlBackend IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageException (SqlStorage sess) -> IO a
forall e a. Exception e => e -> IO a
E.throwIO