module Gamgee.Token
( TokenType (..)
, TokenLabel (..)
, TokenSecret (..)
, TokenIssuer (..)
, TokenAlgorithm (..)
, TokenDigits (..)
, TokenPeriod (..)
, TokenSpec (..)
, TokenIdentifier (..)
, Tokens
, Config(..)
, getIdentifier
, currentConfigVersion
, initialConfig
) where
import qualified Data.Aeson as Aeson
import qualified Data.Text as Text
import Relude
data TokenType = TOTP
deriving stock Show
instance Aeson.FromJSON TokenType where
parseJSON (Aeson.String "totp") = return TOTP
parseJSON invalid = fail $ "Invalid token type: " ++ show invalid
instance Aeson.ToJSON TokenType where
toJSON TOTP = Aeson.String "totp"
newtype TokenLabel = TokenLabel {
unTokenLabel :: Text
}
deriving newtype (Show, IsString, Aeson.FromJSON, Aeson.ToJSON)
data TokenSecret = TokenSecretPlainText Text
| TokenSecretAES256 {
tokenSecretAES256IV :: Text
, tokenSecretAES256Data :: Text
}
deriving stock (Show, Generic)
deriving anyclass (Aeson.FromJSON, Aeson.ToJSON)
newtype TokenIssuer = TokenIssuer {
unTokenIssuer :: Text
}
deriving newtype (Show, IsString, Aeson.FromJSON, Aeson.ToJSON)
data TokenAlgorithm = AlgorithmSHA1
| AlgorithmSHA256
| AlgorithmSHA512
deriving stock (Show, Generic)
deriving anyclass (Aeson.FromJSON, Aeson.ToJSON)
data TokenDigits = Digits6
| Digits8
deriving stock Show
instance Aeson.FromJSON TokenDigits where
parseJSON (Aeson.Number 6) = return Digits6
parseJSON (Aeson.Number 8) = return Digits8
parseJSON invalid = fail $ "Invalid number of digits: " ++ show invalid ++ ". Must be 6 or 8."
instance Aeson.ToJSON TokenDigits where
toJSON Digits6 = Aeson.Number 6
toJSON Digits8 = Aeson.Number 8
newtype TokenPeriod = TokenPeriod {
unTokenPeriod :: Word16
}
deriving newtype (Eq, Ord, Enum, Num, Real, Integral, Show, Aeson.FromJSON, Aeson.ToJSON)
data TokenSpec = TokenSpec {
tokenType :: TokenType
, tokenLabel :: TokenLabel
, tokenSecret :: TokenSecret
, tokenIssuer :: TokenIssuer
, tokenAlgorithm :: TokenAlgorithm
, tokenDigits :: TokenDigits
, tokenPeriod :: TokenPeriod
}
deriving stock (Generic, Show)
deriving anyclass (Aeson.FromJSON, Aeson.ToJSON)
newtype TokenIdentifier = TokenIdentifier {
unTokenIdentifier :: Text
}
deriving newtype (Eq, Show, Hashable, IsString, Semigroup, ToString
, Aeson.FromJSON, Aeson.ToJSON
, Aeson.FromJSONKey, Aeson.ToJSONKey)
getIdentifier :: TokenSpec -> TokenIdentifier
getIdentifier spec =
let
TokenLabel label = tokenLabel spec
TokenIssuer issuer = tokenIssuer spec
in
TokenIdentifier $ if | Text.null issuer -> label
| Text.isPrefixOf (issuer <> ":") label -> label
| otherwise -> issuer <> ":" <> label
type Tokens = HashMap TokenIdentifier TokenSpec
data Config = Config {
configVersion :: Word32
, configTokens :: Tokens
}
deriving stock (Generic)
deriving anyclass (Aeson.FromJSON, Aeson.ToJSON)
currentConfigVersion :: Word32
currentConfigVersion = 1
initialConfig :: Config
initialConfig = Config {
configVersion = currentConfigVersion
, configTokens = fromList []
}