authorize ::
     Database -> (AuthCookie, Cookies) -> W.Request -> IO (Maybe W.Request)
authorize db (authCookie, otherCookies) req = do
  let user = acUser authCookie
      domain = decodeUtf8 . fromJust $ requestDomain req
      email = getEmail user
      emailUtf8 = getEmailUtf8 user
      familyUtf8 = getFamilyNameUtf8 user
      givenUtf8 = getGivenNameUtf8 user
      method = decodeUtf8 $ W.requestMethod req
      path = decodeUtf8 $ W.rawPathInfo req
  grps <- userGroups db email domain path method
  if null grps
    then return Nothing
    else do
      ip <-
        pack . fromJust . fst <$>
        getNameInfo [NI_NUMERICHOST] True False (W.remoteHost req)
      return . Just $
        req
          { W.requestHeaders =
              HM.toList $
              HM.insert "From" emailUtf8 $
              HM.insert "X-Groups" (BS.intercalate "," $ encodeUtf8 <$> grps) $
              HM.insert "X-Given-Name" givenUtf8 $
              HM.insert "X-Family-Name" familyUtf8 $
              HM.insert "X-Forwarded-Proto" "https" $
              HM.insertWith (flip combine) "X-Forwarded-For" ip $
              setCookies otherCookies $
              HM.fromListWith combine $ W.requestHeaders req
          }
  where
    combine a b = a <> "," <> b
    setCookies [] = HM.delete hCookie
    setCookies cs = HM.insert hCookie (toByteString . renderCookies $ cs)
authorize ::
     Database -> (AuthCookie, Cookies) -> W.Request -> IO (Maybe W.Request)
authorize db (authCookie, otherCookies) req = do
  let user = acUser authCookie
      domain = decodeUtf8 . fromJust $ requestDomain req
      email = getEmail user
      emailUtf8 = getEmailUtf8 user
      familyUtf8 = getFamilyNameUtf8 user
      givenUtf8 = getGivenNameUtf8 user
      method = decodeUtf8 $ W.requestMethod req
      path = decodeUtf8 $ W.rawPathInfo req
  grps <- userGroups db email domain path method
  if null grps
    then return Nothing
    else do
      ip <-
        pack . fromJust . fst <$>
        getNameInfo [NI_NUMERICHOST] True False (W.remoteHost req)
      return . Just $
        req
          { W.requestHeaders =
              HM.toList $
              HM.insert "From" emailUtf8 $
              HM.insert "X-Groups" (BS.intercalate "," $ encodeUtf8 <$> grps) $
              HM.insert "X-Given-Name" givenUtf8 $
              HM.insert "X-Family-Name" familyUtf8 $
              HM.insert "X-Forwarded-Proto" "https" $
              HM.insertWith (flip combine) "X-Forwarded-For" ip $
              setCookies otherCookies $
              HM.fromListWith combine $ W.requestHeaders req
          }
  where
    combine a b = a <> "," <> b
    setCookies [] = HM.delete hCookie
    setCookies cs = HM.insert hCookie (toByteString . renderCookies $ cs)
authorize db (authCookie, otherCookies) req = do
  let user = acUser authCookie
      domain = decodeUtf8 . fromJust $ requestDomain req
      email = getEmail user
      emailUtf8 = getEmailUtf8 user
      familyUtf8 = getFamilyNameUtf8 user
      givenUtf8 = getGivenNameUtf8 user
      method = decodeUtf8 $ W.requestMethod req
      path = decodeUtf8 $ W.rawPathInfo req
  grps <- userGroups db email domain path method
  if null grps
    then return Nothing
    else do
      ip <-
        pack . fromJust . fst <$>
        getNameInfo [NI_NUMERICHOST] True False (W.remoteHost req)
      return . Just $
        req
          { W.requestHeaders =
              HM.toList $
              HM.insert "From" emailUtf8 $
              HM.insert "X-Groups" (BS.intercalate "," $ encodeUtf8 <$> grps) $
              HM.insert "X-Given-Name" givenUtf8 $
              HM.insert "X-Family-Name" familyUtf8 $
              HM.insert "X-Forwarded-Proto" "https" $
              HM.insertWith (flip combine) "X-Forwarded-For" ip $
              setCookies otherCookies $
              HM.fromListWith combine $ W.requestHeaders req
          }
  where
    combine a b = a <> "," <> b
    setCookies [] = HM.delete hCookie
    setCookies cs = HM.insert hCookie (toByteString . renderCookies $ cs)