module Network.IP.Quoter (ip) where
import Network.Socket ( HostAddress
, HostAddress6
, SockAddr( .. )
, getAddrInfo
, AddrInfo ( addrAddress, addrFlags )
, AddrInfoFlag ( AI_NUMERICHOST )
, defaultHints
)
import Language.Haskell.TH.Quote ( QuasiQuoter( .. ) )
import Language.Haskell.TH.Syntax ( Q
, Exp( .. )
, Lit( .. )
, Type ( .. )
, runIO
)
import Data.Word ( Word32 )
import System.Endian ( fromBE32, toBE32 )
ip :: QuasiQuoter
ip = QuasiQuoter
{ quotePat = \_ -> fail "Can't invoke the ip quasiquoter in a pattern context"
, quoteType = \_ -> fail "Can't invoke the ip quasiquoter in a type context"
, quoteDec = \_ ->
fail "Can't invoke the ip quasiquoter in a declaration context"
, quoteExp = parseIP
}
getIPInfo :: String -> IO SockAddr
getIPInfo s = do
best:_ <- getAddrInfo hint hostname Nothing
return $ addrAddress best
where
hint = Just $ defaultHints { addrFlags = [ AI_NUMERICHOST ] }
hostname = Just s
parseIP :: String -> Q Exp
parseIP s = (runIO $ getIPInfo s) >>= \case
SockAddrInet _ addr ->
return . SigE networkExp $ ConT ''HostAddress
where
hostW32 = fromBE32 addr
w32Lit = LitE . IntegerL $ fromIntegral hostW32
toBE32Var = VarE 'toBE32
networkExp = AppE toBE32Var w32Lit
SockAddrInet6 _ _ ( addr1, addr2, addr3, addr4 ) _ ->
return . SigE tup $ ConT ''HostAddress6
where
tup = TupE $ map (LitE . IntegerL . fromIntegral) [ addr1
, addr2
, addr3
, addr4
]
x -> fail ("Invalid address " ++ (show x) ++ " when parsing " ++ s)