Created
September 1, 2015 09:51
-
-
Save lunaris/a239c234c4700136dd14 to your computer and use it in GitHub Desktop.
Authentication in Servant: Design space exploration
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
-- The idea: generalise authentication to session information which can be | |
-- extracted from (e.g.) the current request and a suitable monad 'm'. This | |
-- is currently problematic as no 'm' is exposed through the type class | |
-- head. | |
instance (HasServer sublayout) | |
=> HasServer (WithSession st :> sublayout) where | |
type ServerT (WithSession st :> sublayout) m | |
= MonadSessionWith st m => ServerT sublayout m | |
route Proxy subserver request respond | |
= route (Proxy :: Proxy sublayout) subserver request respond | |
class Monad m => MonadWithSession st m where | |
fromSession_ :: Request -> m st | |
-- Example desired use case (equally vapourware): | |
newtype SessionId | |
= SessionId Text | |
deriving (Eq, Ord, Show) | |
deriving instance FromJSON SessionId | |
deriving instance ToJSON SessionId | |
type API | |
= WithSession SessionId :> "/session" :> Get '[JSON] SessionId | |
getSessionId :: MonadSessionWith SessionId m => ServerT API m | |
getSessionId | |
= fromSession | |
-- Here, 'fromSession' calls 'fromSession_' with the current request, | |
-- which it somehow gets access to. Perhaps the reflection library might | |
-- be of some use here? The idea being that the 'route' function in the | |
-- 'WithSession' instance sets up some temporary type class instance | |
-- which exposes the desired state in a parameterless manner? |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment