1 {-# LANGUAGE TemplateHaskell, TypeFamilies, OverloadedStrings #-} 2 module Databrary.Model.Token.Types 3 ( Token(..) 4 , AccountToken(..) 5 , LoginToken(..) 6 , Session(..) 7 , Upload(..) 8 , makeUpload 9 ) where 10 11 import qualified Data.ByteString as BS 12 import Data.Int (Int64) 13 14 import Databrary.Has (Has(..)) 15 import Databrary.Model.Kind 16 import Databrary.Model.Time 17 import Databrary.Model.Id.Types 18 import Databrary.Model.Party.Types 19 import Databrary.Model.Permission.Types 20 21 type instance IdType Token = BS.ByteString 22 23 data Token = Token 24 { tokenId :: Id Token 25 , tokenExpires :: Timestamp 26 } 27 28 -- makeHasRec ''Token ['tokenId] 29 instance Has (Id Token) Token where 30 view = tokenId 31 32 data AccountToken = AccountToken 33 { accountToken :: !Token 34 , tokenAccount :: SiteAuth 35 } 36 37 -- makeHasRec ''AccountToken ['accountToken, 'tokenAccount] 38 -- instance Has Token AccountToken where 39 -- view = accountToken 40 instance Has (Id Token) AccountToken where 41 view = (view . accountToken) 42 instance Has SiteAuth AccountToken where 43 view = tokenAccount 44 instance Has Access AccountToken where 45 view = (view . tokenAccount) 46 instance Has (Id Party) AccountToken where 47 view = (view . tokenAccount) 48 -- instance Has PartyRow AccountToken where 49 -- view = (view . tokenAccount) 50 -- instance Has Party AccountToken where 51 -- view = (view . tokenAccount) 52 instance Has Account AccountToken where 53 view = (view . tokenAccount) 54 55 data LoginToken = LoginToken 56 { loginAccountToken :: !AccountToken 57 , loginPasswordToken :: Bool 58 } 59 60 -- these are signed version of Id Token 61 type instance IdType LoginToken = BS.ByteString 62 63 instance Kinded LoginToken where 64 kindOf _ = "token" 65 66 -- makeHasRec ''LoginToken ['loginAccountToken] 67 -- instance Has AccountToken LoginToken where 68 -- view = loginAccountToken 69 -- instance Has Token LoginToken where 70 -- view = (view . loginAccountToken) 71 instance Has (Id Token) LoginToken where 72 view = (view . loginAccountToken) 73 instance Has SiteAuth LoginToken where 74 view = (view . loginAccountToken) 75 -- instance Has Access LoginToken where 76 -- view = (view . loginAccountToken) 77 -- instance Has (Id Party) LoginToken where 78 -- view = (view . loginAccountToken) 79 -- instance Has PartyRow LoginToken where 80 -- view = (view . loginAccountToken) 81 -- instance Has Party LoginToken where 82 -- view = (view . loginAccountToken) 83 -- instance Has Account LoginToken where 84 -- view = (view . loginAccountToken) 85 86 data Session = Session 87 { sessionAccountToken :: !AccountToken 88 , sessionVerf :: !BS.ByteString 89 , sessionSuperuser :: Bool 90 } 91 92 -- makeHasRec ''Session ['sessionAccountToken] 93 -- instance Has AccountToken Session where 94 -- view = sessionAccountToken 95 -- instance Has Token Session where 96 -- view = (view . sessionAccountToken) 97 instance Has (Id Token) Session where 98 view = (view . sessionAccountToken) 99 -- instance Has SiteAuth Session where 100 -- view = (view . sessionAccountToken) 101 instance Has Access Session where 102 view = (view . sessionAccountToken) 103 instance Has (Id Party) Session where 104 view = (view . sessionAccountToken) 105 -- instance Has PartyRow Session where 106 -- view = (view . sessionAccountToken) 107 -- instance Has Party Session where 108 -- view = (view . sessionAccountToken) 109 instance Has Account Session where 110 view = (view . sessionAccountToken) 111 112 data Upload = Upload 113 { uploadAccountToken :: AccountToken 114 , uploadFilename :: BS.ByteString 115 , uploadSize :: Int64 116 } 117 118 -- makeHasRec ''Upload ['uploadAccountToken] 119 -- instance Has AccountToken Upload where 120 -- view = uploadAccountToken 121 -- instance Has Token Upload where 122 -- view = (view . uploadAccountToken) 123 instance Has (Id Token) Upload where 124 view = (view . uploadAccountToken) 125 -- instance Has SiteAuth Upload where 126 -- view = (view . uploadAccountToken) 127 -- instance Has Access Upload where 128 -- view = (view . uploadAccountToken) 129 -- instance Has (Id Party) Upload where 130 -- view = (view . uploadAccountToken) 131 -- instance Has PartyRow Upload where 132 -- view = (view . uploadAccountToken) 133 -- instance Has Party Upload where 134 -- view = (view . uploadAccountToken) 135 -- instance Has Account Upload where 136 -- view = (view . uploadAccountToken) 137 138 makeUpload :: Token -> BS.ByteString -> Int64 -> SiteAuth -> Upload 139 makeUpload t n z u = Upload (AccountToken t u) n z