161 lines
3.2 KiB
Haskell
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
|