{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module HOwl ( Message
            , ConcreteMessage(..)
            , BaseMessage
            , Zephyr
            , asZephyr
            , ) where

import Network.Zephyr (ZAuth(..))

import qualified Data.Map as M
import Control.Monad

type FieldValue = String
type MessageId = Integer
type MessageType = String

-- I'm not sure whether we want typed fields or not.
-- data FieldValue = S String
--                 | D DateTime
--                 | I Integer

data ConcreteMessage = MkMessage {
      mid   :: Integer
    , body  :: String
    , attrs :: M.Map String FieldValue
    }

-- withField :: (Monad m) => String -> (FieldValue -> m ()) -> m ()

class Message m where
    msgId    :: m -> MessageId
    msgBody  :: m -> String
    msgAttrs :: m -> M.Map String FieldValue

(!) :: (Message m) => m -> String -> FieldValue
(!) = (M.!) . msgAttrs

getAttr :: (Message m) => m -> String -> Maybe FieldValue
getAttr = (flip M.lookup) . msgAttrs

checkAttrs :: (Message m) => m -> [String] -> Maybe ()
checkAttrs m = mapM_ (getAttr m)

instance Message ConcreteMessage where
    msgId    = mid
    msgBody  = body
    msgAttrs = attrs

class (Message m) => BaseMessage m where
    msgType   :: m -> MessageType
    msgSender :: m -> String
    msgRecip  :: m -> String

class (BaseMessage m) => Zephyr m where
    msgRealm    :: m -> String
    msgAuth     :: m -> ZAuth
    msgClass    :: m -> String
    msgZsig     :: m -> String
    msgInstance :: m -> String

newtype ZephyrImpl m = MkZ {unZ :: m}
    deriving (Message, BaseMessage)

instance (BaseMessage m) => Zephyr (ZephyrImpl m) where
    msgRealm    = (!"realm")
    msgAuth     = str2Auth . (!"zauth")
    msgClass    = (!"class")
    msgInstance = (!"instance")
    msgZsig     = (!"zsig")

str2Auth :: String -> ZAuth
str2Auth "yes"    = Authenticated
str2Auth "no"     = Unauthenticated
str2Auth "failed" = AuthenticationFailed

auth2Str :: ZAuth  -> String
auth2Str Authenticated        = "yes"
auth2Str Unauthenticated      = "no"
auth2Str AuthenticationFailed = "failed"

asZephyr :: (Message m) => m -> Maybe (ZephyrImpl m)
asZephyr m = do checkAttrs m $ ["realm", "class", "instance", "zsig"]
                auth <- getAttr m "zauth"
                guard $ auth == "yes" || auth == "no" || auth == "failed"
                return $ MkZ m