moduleData.IP.AddrwhereimportControl.MonadimportData.BitsimportData.CharimportData.List(foldl')importData.StringimportData.WordimportText.Appar.StringimportText.Printf----------------------------------------------------------------{-|
A unified IP data for 'IPv4' and 'IPv6'.
To create this, use the data constructors. Or use 'read' @"192.0.2.1"@ :: 'IP', for example. Also, @"192.0.2.1"@ can be used as literal with OverloadedStrings.
-}dataIP=IPv4{ipv4::IPv4}|IPv6{ipv6::IPv6}deriving(Eq)instanceShowIPwhereshow(IPv4ip)=showipshow(IPv6ip)=showip------------------------------------------------------------------ This is host byte ordertypeIPv4Addr=Word32typeIPv6Addr=(Word32,Word32,Word32,Word32){-|
The abstract data structure to express an IPv4 address.
To create this, use 'toIPv4'. Or use 'read' @\"192.0.2.1\"@ :: 'IPv4', for example. Also, @\"192.0.2.1\"@ can be used as literal with OverloadedStrings.
-}newtypeIPv4=IP4IPv4Addrderiving(Eq,Ord){-|
The abstract data structure to express an IPv6 address.
To create this, use 'toIPv6'. Or use 'read' @\"2001:DB8::1\"@ :: 'IPv6', for example. Also, @\"2001:DB8::1\"@ can be used as literal with OverloadedStrings.
-}newtypeIPv6=IP6IPv6Addrderiving(Eq,Ord)-------------------------------------------------------------------- Show--instanceShowIPv4whereshow=showIPv4instanceShowIPv6whereshow=showIPv6showIPv4::IPv4->StringshowIPv4(IP4a)=show4awhereremQuox=(x`mod`256,x`div`256)show4q=let(a4,q4)=remQuoq(a3,q3)=remQuoq4(a2,q2)=remQuoq3(a1,_)=remQuoq2inprintf"%d.%d.%d.%d"a1a2a3a4showIPv6::IPv6->StringshowIPv6(IP6(a1,a2,a3,a4))=show6a1++":"++show6a2++":"++show6a3++":"++show6a4whereremQuox=(x`mod`65536,x`div`65536)show6q=let(r2,q2)=remQuoq(r1,_)=remQuoq2inprintf"%02x:%02x"r1r2-------------------------------------------------------------------- IntToIP--{-|
The 'toIPv4' function takes a list of 'Int' and returns 'IPv4'.
For example, 'toIPv4' @[192,0,2,1]@.
-}toIPv4::[Int]->IPv4toIPv4=IP4.toWord32wheretoWord32[a1,a2,a3,a4]=fromIntegral$shifta124+shifta216+shifta38+a4toWord32_=error"toWord32"{-|
The 'toIPv6' function takes a list of 'Int' and returns 'IPv6'.
For example, 'toIPv6' @[0x2001,0xDB8,0,0,0,0,0,1]@.
-}toIPv6::[Int]->IPv6toIPv6ad=let[x1,x2,x3,x4]=maptoWord32$split2adinIP6(x1,x2,x3,x4)wheresplit2[]=[]split2x=take2x:split2(drop2x)toWord32[a1,a2]=fromIntegral$shifta116+a2toWord32_=error"toWord32"-------------------------------------------------------------------- Read--instanceReadIPwherereadsPrec_=parseIPinstanceReadIPv4wherereadsPrec_=parseIPv4instanceReadIPv6wherereadsPrec_=parseIPv6parseIP::String->[(IP,String)]parseIPcs=caserunParserip4csof(Justip,rest)->[(IPv4ip,rest)](Nothing,_)->caserunParserip6csof(Justip,rest)->[(IPv6ip,rest)](Nothing,_)->error$"parseIP"++csparseIPv4::String->[(IPv4,String)]parseIPv4cs=caserunParserip4csof(Nothing,_)->error$"parseIPv4 "++cs(Justa4,rest)->[(a4,rest)]parseIPv6::String->[(IPv6,String)]parseIPv6cs=caserunParserip6csof(Nothing,_)->error$"parseIPv6 "++cs(Justa6,rest)->[(a6,rest)]-------------------------------------------------------------------- IsString--instanceIsStringIPwherefromString=readinstanceIsStringIPv4wherefromString=readinstanceIsStringIPv6wherefromString=read-------------------------------------------------------------------- IPv4 Parser--dig::ParserIntdig=0<$char'0'<|>toInt<$>oneOf['1'..'9']<*>manydigitwheretoIntnns=foldl'(\xy->x*10+y)0.mapdigitToInt$n:nsip4::ParserIPv4ip4=doas<-dig`sepBy1`char'.'checkasreturn$toIPv4aswheretesterrmsgadr=when(adr<0||255<adr)(failerrmsg)checkas=doleterrmsg="IPv4 adddress"when(lengthas/=4)(failerrmsg)mapM_(testerrmsg)as-------------------------------------------------------------------- IPv6 Parser (RFC 4291)--hex::ParserInthex=dons<-somehexDigitchecknsletms=mapdigitToIntnsval=foldl'(\xy->x*16+y)0msreturnvalwherecheckns=when(lengthns>4)(fail"IPv6 address -- more than 4 hex")ip6::ParserIPv6ip6=toIPv6<$>ip6'ip6'::Parser[Int]ip6'=docolon2bs<-option[]hexcolonformat[]bs<|>try(dors<-hexcoloncheckrsreturnrs)<|>dobs1<-hexcolon2bs2<-option[]hexcolonformatbs1bs2wherecolon2=string"::"hexcolon=hex`sepBy1`char':'hexcolon2=manyTill(hex<*char':')(char':')formatbs1bs2=doletlen1=lengthbs1len2=lengthbs2when(len1>7)(fail"IPv6 address1")when(len2>7)(fail"IPv6 address2")letlen=8-len1-len2when(len<=0)(fail"IPv6 address3")letspring=replicatelen0return$bs1++spring++bs2checkbs=when(lengthbs/=8)(fail"IPv6 address4")