mateamt/src/Types/Auth.hs

161 lines
3.2 KiB
Haskell

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Types.Auth where
import GHC.Generics
import Data.Aeson
import qualified Data.Set as S
import Data.Time.Clock (UTCTime)
import qualified Data.Text as T
import Control.Concurrent.STM.TVar (TVar)
-- internal imports
data TicketRequest = TicketRequest
{ ticketRequestUser :: Int
, ticketRequestMethod :: AuthMethod
}
deriving (Show, Generic)
instance ToJSON TicketRequest where
toEncoding = genericToEncoding defaultOptions
instance FromJSON TicketRequest
data AuthInfo = AuthInfo
{ authChallenge :: Maybe T.Text
, authTicket :: AuthTicket
}
deriving (Show, Generic)
instance ToJSON AuthInfo where
toEncoding = genericToEncoding defaultOptions
instance FromJSON AuthInfo
data AuthMethod
= PrimaryPass
| SecondaryPass
| ChallengeResponse
deriving (Show, Generic, Enum, Eq, Ord)
instance ToJSON AuthMethod where
toEncoding = genericToEncoding defaultOptions
instance FromJSON AuthMethod
data AuthSubmit = AuthSubmit
{ authSubmitMethod :: AuthMethod
, authSubmitComment :: T.Text
, authSubmitPayload :: T.Text
}
deriving (Show, Generic)
instance ToJSON AuthSubmit where
toEncoding = genericToEncoding defaultOptions
instance FromJSON AuthSubmit
newtype AuthTicket = AuthTicket T.Text deriving (Show, Generic, Eq, Ord)
instance ToJSON AuthTicket where
toEncoding = genericToEncoding defaultOptions
instance FromJSON AuthTicket
newtype AuthResponse = AuthResponse T.Text deriving (Show, Generic)
instance ToJSON AuthResponse where
toEncoding = genericToEncoding defaultOptions
instance FromJSON AuthResponse
data AuthRequest = AuthRequest
{ authRequestTicket :: AuthTicket
, authRequestHash :: AuthResponse
}
deriving (Show, Generic)
instance ToJSON AuthRequest where
toEncoding = genericToEncoding defaultOptions
instance FromJSON AuthRequest
data AuthResult
= Granted
{ authToken :: AuthToken
}
| Denied
deriving (Show, Generic)
instance ToJSON AuthResult where
toEncoding = genericToEncoding defaultOptions
instance FromJSON AuthResult
newtype AuthToken = AuthToken T.Text deriving (Show, Generic)
instance ToJSON AuthToken where
toEncoding = genericToEncoding defaultOptions
instance FromJSON AuthToken
data Token = Token
{ tokenString :: T.Text
, tokenUser :: Int
, tokenExpiry :: UTCTime
, tokenMethod :: AuthMethod
}
deriving (Generic, Show)
type TicketStore = TVar (S.Set Ticket)
data Ticket = Ticket
{ ticketId :: AuthTicket
, ticketUser :: Int
, ticketExpiry :: UTCTime
, ticketMethod :: (AuthMethod, Maybe T.Text)
}
deriving (Show, Ord)
instance Eq Ticket where
(Ticket i1 _ _ _) == (Ticket i2 _ _ _) = i1 == i2
data AuthData = AuthData
{ authDataId :: Int
, authDataUser :: Int
, authDataMethod :: AuthMethod
, authDataComment :: T.Text
, authDataPayload :: T.Text
}
deriving (Show)
data AuthOverview = AuthOverview
{ authOverviewId :: Int
, authOverviewComment :: T.Text
, authOverviewMethod :: AuthMethod
}
deriving (Show, Generic)
instance ToJSON AuthOverview where
toEncoding = genericToEncoding defaultOptions
instance FromJSON AuthOverview