Rakka/Resource/CheckAuth.hs

   1 module Rakka.Resource.CheckAuth
   2     ( resCheckAuth
   3     )
   4     where
   5
   6 import           Network.HTTP.Lucu
   7 import           Rakka.Authorization
   8 import           Rakka.Environment
   9
  10
  11 resCheckAuth :: Environment -> ResourceDef
  12 resCheckAuth env
  13     = ResourceDef {
  14         resUsesNativeThread = False
  15       , resIsGreedy         = False
  16       , resGet
  17           = Just $
  18             do authM <- getAuthorization
  19                case authM of
  20                  Just (BasicAuthCredential userID password)
  21                      -> do valid <- isValidPair (envAuthDB env) userID password
  22                            if valid then
  23                                setStatus NoContent
  24                              else
  25                                setStatus Forbidden
  26                  _   -> setStatus Forbidden
  27       , resHead             = Nothing
  28       , resPost             = Nothing
  29       , resPut              = Nothing
  30       , resDelete           = Nothing
  31       }