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