gistfile1.hs

module Auth where

main :: IO ()
main = putStrLn $ unlines $
    [ "pretend website"
    , "Logged in as regular user, trying to see my profile"
    , if authorize regUser Read regUser 
         then profile regUser
         else "forbidden"
    , "Logged in as admin, trying to delete post"
    , if authorize adminUser Delete publishedPost
         then "deleteeeed"
         else "nope"
    ]

data User = User
    { userId :: Int
    , isAdmin :: Bool
    , profile :: String
    }

regUser = User 1 False "i like cats"
adminUser = User 2 True "such boss wow"

data Post = Post
    { authorId :: Int
    , body :: String
    , isPublished :: Bool
    }

publishedPost = Post 1 "toots" True
unpublishedPost = Post 3 "hello there" False


data ResourceType a =
    PostT a
  | ProfileT a

data Action =
    Create
  | Read
  | Update
  | Delete

class HasResource a where
    resourceFor :: a -> ResourceType a

instance HasResource Post where
    resourceFor = PostT

instance HasResource User where
    resourceFor = ProfileT

class (HasResource a) => Authorization a where
    authorize :: HasResource a => User -> Action -> a -> Bool

instance Authorization User where
    authorize _ Read _ = True
    authorize _ Create _ = True
    authorize currentUser Update prof =
          isAdmin currentUser ||
          userId currentUser == userId prof
    authorize currentUser Delete _ = isAdmin currentUser

instance Authorization Post where
    authorize _ Create _ = True
    authorize currentUser _  post
        | isAdmin currentUser = True
        | userId currentUser == authorId post = True 
        | isPublished post = True
        | otherwise = False